picolisp-gtk-server

picoLisp gtk-server interface
git clone https://logand.com/git/picolisp-gtk-server.git/
Log | Files | Refs

gtk-gl-teapot.l (4680B)

      1 # picoLisp + gtk-server example
      2 # 26feb2009 Tomas Hlavaty
      3 # $ ~/picolisp/p gtk-gl-teapot.l -bye
      4 # requires http://logand.com/gtk/gtk.l
      5 # based on http://www.allbasic.info/forum/index.php?topic=173.0;wap2
      6 
      7 (load "gtk.l")
      8 
      9 (setq *Scl 6)
     10 
     11 # /usr/include/gtkglext-1.0/gdk/gdkglconfig.h
     12 (def 'GDK_GL_MODE_RGB 0)
     13 (def 'GDK_GL_MODE_RGBA 0)
     14 (def 'GDK_GL_MODE_INDEX 1)
     15 (def 'GDK_GL_MODE_SINGLE 0)
     16 (def 'GDK_GL_MODE_DOUBLE 2)
     17 (def 'GDK_GL_MODE_STEREO 4)
     18 (def 'GDK_GL_MODE_ALPHA 8)
     19 (def 'GDK_GL_MODE_DEPTH 16)
     20 (def 'GDK_GL_MODE_STENCIL 32)
     21 (def 'GDK_GL_MODE_ACCUM 64)
     22 (def 'GDK_GL_MODE_MULTISAMPLE 128)
     23 
     24 (def 'GDK_GL_RGBA_TYPE (hex "8014"))
     25 (def 'GDK_GL_COLOR_INDEX_TYPE (hex "0x8015"))
     26 
     27 (in "/usr/include/GL/gl.h"
     28    (until (eof)
     29       (when (match '("#" "d" "e" "f" "i" "n" "e" " " @A "0" "x" @B) (line))
     30          (let N (intern (pack (clip @A)))
     31             (def N (hex (pack @B))) ) ) ) )
     32 
     33 (de bitmap_text @
     34    #(for C (chop S)
     35    #   (glutBitmapCharacter GLUT_BITMAP_HELVETICA_18 C))
     36       )
     37 
     38 (de stroke_text (S)
     39    #(for C (chop S)
     40    #   (glutStrokeCharacter GLUT_STROKE_ROMAN C) )
     41       )
     42 
     43 (de idle ()
     44    (expose) )
     45 
     46 (de press ()
     47    # keyb = gtk_server_key()
     48    # UNTIL EVENT = win OR keyb = ESCAPE
     49    (prinl 'press) )
     50 
     51 (de expose ()
     52    # Setup the drawing area
     53    (setq GLCONTEXT (gtk_widget_get_gl_context DA))
     54    (setq GLDRAWABLE (gtk_widget_get_gl_window DA))
     55    (gdk_gl_drawable_gl_begin GLDRAWABLE GLCONTEXT)
     56    # Define clearing color
     57    (glClearColor "0.5" "1.0" "1.0" 0)
     58    # Clear screen
     59    (glClear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
     60    # Enable shading, depth and lighting
     61    (glShadeModel GL_SMOOTH)
     62    (glEnable GL_DEPTH_TEST)
     63    (glEnable GL_LIGHTING)
     64    (glEnable GL_LIGHT0)
     65    # Setup lighting
     66    (glLightfv GL_LIGHT0 GL_POSITION "AAAAQAAAAEAAAADBAAAAAA==")
     67    (glLightfv GL_LIGHT0 GL_DIFFUSE "AACAPwAAgD8AAIA/AACAPw==")
     68    (glLightfv GL_LIGHT0 GL_AMBIENT "mpkZPpqZGT6amRk+")
     69    (glLightfv GL_LIGHT0 GL_SPECULAR "AACAPwAAgD8AAIA/AACAPw==")
     70    # Setup reflected color of object
     71    (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE "zczMPTMzMz/NzMw9AAAAPw==")
     72    # Make sure we see the model
     73    (glMatrixMode GL_MODELVIEW)
     74    # Save current matrix
     75    (glPushMatrix)
     76 #(glMatrixMode GL_PROJECTION)
     77 #(glLoadIdentity)
     78    # Rotate
     79    (glRotatef ROTX 0 1.0 0)
     80    (glRotatef ROTY 1.0 0 0)
     81    # Dump rotated image
     82    (glutSolidTeapot "0.5") #SIZE)
     83    # Undo the last rotation
     84    (glLoadIdentity)
     85    # Setup reflected color of font
     86    (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE "AACAP83MzD4AAIA/AAAAAA==")
     87    # Determine position of bitmapped text
     88    (glRasterPos2f 0 -0.8)
     89    # Draw some bitmapped text
     90    (bitmap_text "OpenGL demo with Scriptbasic")
     91    # Setup reflected color of font
     92    (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE "AAAAAAAAAAAAAIA/AAAAAA==")
     93    # Determine position of STROKED text -> drawed so translate
     94    (glTranslatef -0.9 0.8 0)
     95    # Setup scaling -> stroked characters are large, make smaller
     96    (glScalef 0.0005 0.0006 0)
     97    # Draw some stroked text
     98    (stroke_text "Using GTK-server with GtkGlExt!")
     99    # Now put back the matrix
    100    (glPopMatrix)
    101    # Now swap buffers and draw
    102    (gdk_gl_drawable_swap_buffers GLDRAWABLE)
    103    (gdk_gl_drawable_gl_end GLDRAWABLE) )
    104 
    105 (de rotate ()
    106    (setq ROTX (+ ROTX 3))
    107    (setq ROTY (+ ROTY 2))
    108    (when (< 359 ROTX)
    109       (setq ROTX 0) )
    110    (when (< ROTX 0)
    111       (setq ROTX 360) )
    112    (when (< 359 ROTY)
    113       (setq ROTY 0) )
    114    (when (< ROTY 0)
    115       (setq ROTY 360) ) )
    116    
    117 (de mainLoop @
    118    (let E 0 # TODO dispatch events automatically
    119       (until (prog
    120                 (setq E (gtk_server_callback 'wait))
    121                 (or (= E 'Exit_Prog) (= E W)) )
    122         (rotate)
    123         (case E
    124            (idle (idle))
    125            (press (press))
    126            (expose (expose)) )
    127            ) )
    128    (gtk_exit 0) )
    129 
    130 # main
    131 (gtk_init 'NULL 'NULL)
    132 (gtk_gl_init 'NULL 'NULL)
    133 (glutInit 'NULL 'NULL)
    134 # Window
    135 (setq W (gtk_window_new 0))
    136 (gtk_window_set_default_size W 640 480)
    137 (gtk_window_set_title W "This is a teapot demo with picoLisp")
    138 (gtk_window_set_position W 1)
    139 # Signal every 100 msecs
    140 (gtk_server_connect W 'show 'idle)
    141 (gtk_server_timeout 75 W 'show)
    142 (gtk_server_connect W 'key-press-event 'press)
    143 # Drawing area
    144 (setq DA (gtk_drawing_area_new))
    145 (gtk_container_add W DA)
    146 (gtk_widget_set_gl_capability DA
    147    (gdk_gl_config_new_by_mode
    148       (| GDK_GL_MODE_RGB GDK_GL_MODE_DOUBLE GDK_GL_MODE_DEPTH) )
    149    'NULL 1 GDK_GL_RGBA_TYPE )
    150 (gtk_server_connect DA 'expose-event 'expose)
    151 (gtk_widget_show_all W)
    152 # Initialize variables
    153 (setq GLUT_BITMAP_HELVETICA_18 (glutBitmapHelvetica18))
    154 (setq GLUT_STROKE_ROMAN (glutStrokeRoman))
    155 (setq ROTX 0)
    156 (setq ROTY 330)
    157 (setq SIZE 0.5)
    158 # go
    159 (mainLoop)
    160 #gtk_server_exit()