picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

openGl.l (10865B)

      1 # 09nov12abu
      2 # 27jul10jk
      3 # (c) Software Lab. Alexander Burger
      4 
      5 ### OpenGL library interface ###
      6 (load "@lib/math.l")
      7 
      8 (if (= *OS "Darwin")
      9    (default
     10       *GluLib "OpenGL.framework/OpenGL"
     11       *GlutLib "GLUT.framework/GLUT" )
     12    (default
     13       *GluLib "libGLU.so"
     14       *GlutLib "libglut.so" ) )
     15 
     16 # Pre-consed fixpoint arguments
     17 (setq
     18    "Flt1" (0 . -1.0)
     19    "Flt2" (0 . -1.0)
     20    "Flt3" (0 . -1.0)
     21    "Flt4" (0 . -1.0)
     22    "Dbl1" (0 . 1.0)
     23    "Dbl2" (0 . 1.0)
     24    "Dbl3" (0 . 1.0)
     25    "Dbl4" (0 . 1.0)
     26    "Dbl5" (0 . 1.0)
     27    "Dbl6" (0 . 1.0) )
     28 
     29 # Utilities
     30 (de ivect (Lst)
     31    (mapcar '((N) (- -4294967296 N)) Lst) )
     32 
     33 (de fvect (Lst)
     34    (mapcar
     35       '((N) (- -4294967296 (*/ 2147483647 N 1.0)))
     36       Lst ) )
     37 
     38 
     39 ### /usr/include/GL/gl.h ###
     40 ### Constant Definitions ###
     41 # Primitives
     42 (def 'GL_POINTS         (hex "0000"))
     43 (def 'GL_LINES          (hex "0001"))
     44 (def 'GL_LINE_LOOP      (hex "0002"))
     45 (def 'GL_LINE_STRIP     (hex "0003"))
     46 (def 'GL_TRIANGLES      (hex "0004"))
     47 (def 'GL_TRIANGLE_STRIP (hex "0005"))
     48 (def 'GL_TRIANGLE_FAN   (hex "0006"))
     49 (def 'GL_QUADS          (hex "0007"))
     50 (def 'GL_QUAD_STRIP     (hex "0008"))
     51 (def 'GL_POLYGON        (hex "0009"))
     52 
     53 # Matrix Mode
     54 (def 'GL_MATRIX_MODE    (hex "0BA0"))
     55 (def 'GL_MODELVIEW      (hex "1700"))
     56 (def 'GL_PROJECTION     (hex "1701"))
     57 (def 'GL_TEXTURE        (hex "1702"))
     58 
     59 # Points
     60 
     61 # Lines
     62 (def 'GL_LINE_SMOOTH       (hex "00000B20"))
     63 
     64 # Polygons
     65 (def 'GL_FRONT             (hex "0404"))
     66 (def 'GL_CULL_FACE         (hex "00000B44"))
     67 
     68 # Display Lists
     69 
     70 # Depth buffer
     71 (def 'GL_LESS              (hex "00000201"))
     72 (def 'GL_DEPTH_TEST        (hex "00000B71"))
     73 
     74 # Lighting
     75 (def 'GL_LIGHTING             (hex "0B50"))
     76 (def 'GL_LIGHT0               (hex "4000"))
     77 (def 'GL_SPECULAR             (hex "1202"))
     78 (def 'GL_SHININESS            (hex "1601"))
     79 (def 'GL_POSITION             (hex "1203"))
     80 (def 'GL_AMBIENT_AND_DIFFUSE  (hex "1602"))
     81 (def 'GL_FRONT_AND_BACK       (hex "0408"))
     82 (def 'GL_FLAT                 (hex "1D00"))
     83 (def 'GL_SMOOTH               (hex "1D01"))
     84 (def 'GL_COLOR_MATERIAL       (hex "0B57"))
     85 
     86 # User clipping planes
     87 
     88 # Accumulation buffer
     89 
     90 # Alpha testing
     91 
     92 # Blending
     93 (def 'GL_BLEND                (hex "0BE2"))
     94 (def 'GL_SRC_ALPHA            (hex "0302"))
     95 (def 'GL_ONE_MINUS_SRC_ALPHA  (hex "0303"))
     96 
     97 # Render Mode
     98 
     99 # Feedback
    100 
    101 # Selection
    102 
    103 # Fog
    104 
    105 # Logic Ops
    106 
    107 # Stencil
    108 
    109 # Buffers, Pixel Drawing/Reading
    110 
    111 # Implementation limits
    112 
    113 # Gets
    114 
    115 # Evaluators
    116 
    117 # Hints
    118 (def 'GL_LINE_SMOOTH_HINT     (hex "0C52"))
    119 (def 'GL_NICEST               (hex "1102"))
    120 
    121 # Scissor box
    122 
    123 # Pixel Mode / Transfer
    124 
    125 # Texture mapping
    126 
    127 # Utility
    128 
    129 # Errors
    130 
    131 # glPush/PopAttrib bits
    132 (def 'GL_CURRENT_BIT          (hex "00000001"))
    133 (def 'GL_POINT_BIT            (hex "00000002"))
    134 (def 'GL_LINE_BIT             (hex "00000004"))
    135 (def 'GL_POLYGON_BIT          (hex "00000008"))
    136 (def 'GL_POLYGON_STIPPLE_BIT  (hex "00000010"))
    137 (def 'GL_PIXEL_MODE_BIT       (hex "00000020"))
    138 (def 'GL_LIGHTING_BIT         (hex "00000040"))
    139 (def 'GL_FOG_BIT              (hex "00000080"))
    140 (def 'GL_DEPTH_BUFFER_BIT     (hex "00000100"))
    141 (def 'GL_ACCUM_BUFFER_BIT     (hex "00000200"))
    142 (def 'GL_STENCIL_BUFFER_BIT   (hex "00000400"))
    143 (def 'GL_VIEWPORT_BIT         (hex "00000800"))
    144 (def 'GL_TRANSFORM_BIT        (hex "00001000"))
    145 (def 'GL_ENABLE_BIT           (hex "00002000"))
    146 (def 'GL_COLOR_BUFFER_BIT     (hex "00004000"))
    147 (def 'GL_HINT_BIT             (hex "00008000"))
    148 (def 'GL_EVAL_BIT             (hex "00010000"))
    149 (def 'GL_LIST_BIT             (hex "00020000"))
    150 (def 'GL_TEXTURE_BIT          (hex "00040000"))
    151 (def 'GL_SCISSOR_BIT          (hex "00080000"))
    152 (def 'GL_ALL_ATTRIB_BITS      (hex "000FFFFF"))
    153 
    154 # Miscellaneous
    155 (de glClearColor (Red Green Blue Alpha)
    156    (set "Flt1" Red  "Flt2" Green  "Flt3" Blue  "Flt4" Alpha)
    157    (native `*GlutLib "glClearColor" NIL "Flt1" "Flt2" "Flt3" "Flt4") )
    158 
    159 (de glClear (Mask)
    160    (native `*GlutLib "glClear" NIL Mask) )
    161 
    162 (de glBlendFunc (SFactor DFactor)
    163    (native `*GlutLib "glBlendFunc" NIL SFactor DFactor) )
    164 
    165 (de glLineWidth (Width)
    166    (set "Flt1" Width)
    167    (native `*GlutLib "glLineWidth" NIL "Flt1") )
    168 
    169 (de glEnable (Num)
    170    (native `*GlutLib "glEnable" NIL Num) )
    171 
    172 (de glDisable (Num)
    173    (native `*GlutLib "glDisable" NIL Num) )
    174 
    175 (de glFlush ()
    176    (native `*GlutLib "glFlush") )
    177 
    178 (de glHint (Target Mode)
    179    (native `*GlutLib "glHint" NIL Target Mode) )
    180 
    181 # Depth Buffer
    182 (de glClearDepth (Depth)
    183    (set "Dbl1" Depth)
    184    (native `*GlutLib "glClearDepth" NIL "Dbl1") )
    185 
    186 (de glDepthFunc (Num)
    187    (native `*GlutLib "glDepthFunc" NIL Num) )
    188 
    189 # Accumulation Buffer
    190 
    191 # Transformation
    192 (de glMatrixMode (Mode)
    193    (native `*GlutLib "glMatrixMode" NIL Mode) )
    194 
    195 (de glOrtho (Left Right Bottom Top Near Far)
    196    (set "Dbl1" Left  "Dbl2" Right  "Dbl3" Bottom  "Dbl4" Top  "Dbl5" Near  "Dbl6" Far)
    197    (native `*GlutLib "glOrtho" NIL "Dbl1" "Dbl2" "Dbl3" "Dbl4" "Dbl5" "Dbl6") )
    198 
    199 (de glViewport (X Y Width Height)
    200    (native `*GlutLib "glViewport" NIL X Y Width Height) )
    201 
    202 (de glPushMatrix ()
    203    (native `*GlutLib "glPushMatrix") )
    204 
    205 (de glPopMatrix ()
    206    (native `*GlutLib "glPopMatrix") )
    207 
    208 (de glLoadIdentity ()
    209    (native `*GlutLib "glLoadIdentity") )
    210 
    211 (de glRotatef (A X Y Z)
    212    (set "Flt1" A  "Flt2" X  "Flt3" Y  "Flt4" Z)
    213    (native `*GlutLib "glRotatef" NIL "Flt1" "Flt2" "Flt3" "Flt4") )
    214 
    215 (de glTranslatef (X Y Z)
    216    (set "Flt1" X  "Flt2" Y  "Flt3" Z)
    217    (native `*GlutLib "glTranslatef" NIL "Flt1" "Flt2" "Flt3") )
    218 
    219 # Display Lists
    220 
    221 # Drawing Functions
    222 (de glBegin (Mode)
    223    (native `*GlutLib "glBegin" NIL Mode) )
    224 
    225 (de glEnd ()
    226    (native `*GlutLib "glEnd") )
    227 
    228 (de glVertex2f (X Y)
    229    (set "Flt1" X  "Flt2" Y)
    230    (native `*GlutLib "glVertex2f" NIL "Flt1" "Flt2") )
    231 
    232 (de glVertex3f (X Y Z)
    233    (set "Flt1" X  "Flt2" Y  "Flt3" Z)
    234    (native `*GlutLib "glVertex3f" NIL "Flt1" "Flt2" "Flt3") )
    235 
    236 (de glNormal3f (X Y Z)
    237    (set "Flt1" X  "Flt2" Y  "Flt3" Z)
    238    (native `*GlutLib "glNormal3f" NIL "Flt1" "Flt2" "Flt3") )
    239 
    240 (de glColor3f (Red Green Blue)
    241    (set "Flt1" Red  "Flt2" Green  "Flt3" Blue)
    242    (native `*GlutLib "glColor3f" NIL "Flt1" "Flt2" "Flt3") )
    243 
    244 (de glColor4f (Red Green Blue Alpha)
    245    (set "Flt1" Red  "Flt2" Green  "Flt3" Blue  "Flt4" Alpha)
    246    (native `*GlutLib "glColor4f" NIL "Flt1" "Flt2" "Flt3" "Flt4") )
    247 
    248 # Vertex Arrays
    249 
    250 # Lighting
    251 (de glShadeModel (Num)
    252    (native `*GlutLib "glShadeModel" NIL Num) )
    253 
    254 (de glLightiv (Light Pname Params)
    255    (native `*GlutLib "glLightiv" NIL Light Pname
    256       (cons NIL (16) (ivect Params)) ) )
    257 
    258 (de glMaterialf (Face Pname Param)
    259    (set "Flt1" Param)
    260    (native `*GlutLib "glMaterialf" NIL Face Pname "Flt1") )
    261 
    262 (de glMaterialfv (Face Pname Params)  # Calls 'iv' internally!
    263    (native `*GlutLib "glMaterialiv" NIL Face Pname
    264       (cons NIL (16) (fvect Params)) ) )
    265 
    266 (de glColorMaterial (Face Mode)
    267    (native `*GlutLib "glColorMaterial" NIL Face Mode) )
    268 
    269 # Raster functions
    270 
    271 # Stenciling
    272 
    273 # Texture mapping
    274 
    275 # Evaluators
    276 
    277 # Fog
    278 
    279 # Selection and Feedback
    280 
    281 
    282 
    283 ### /usr/include/GL/glu.h ###
    284 
    285 (de gluPerspective (Fovy Aspect ZNear ZFar)
    286    (set "Dbl1" Fovy  "Dbl2" Aspect  "Dbl3" ZNear  "Dbl4" ZFar)
    287    (native `*GluLib "gluPerspective" NIL "Dbl1" "Dbl2" "Dbl3" "Dbl4") )
    288 
    289 
    290 ### /usr/include/GL/freeglut_std.h ###
    291 # Special key codes
    292 (def 'GLUT_KEY_F1    1)
    293 (def 'GLUT_KEY_F2    2)
    294 (def 'GLUT_KEY_F3    3)
    295 (def 'GLUT_KEY_F4    4)
    296 (def 'GLUT_KEY_F5    5)
    297 (def 'GLUT_KEY_F6    6)
    298 (def 'GLUT_KEY_F7    7)
    299 (def 'GLUT_KEY_F8    8)
    300 (def 'GLUT_KEY_F9    9)
    301 (def 'GLUT_KEY_F10   10)
    302 (def 'GLUT_KEY_F11   11)
    303 (def 'GLUT_KEY_F12   12)
    304 (def 'GLUT_KEY_LEFT        100)
    305 (def 'GLUT_KEY_UP          101)
    306 (def 'GLUT_KEY_RIGHT       102)
    307 (def 'GLUT_KEY_DOWN        103)
    308 (def 'GLUT_KEY_PAGE_UP     104)
    309 (def 'GLUT_KEY_PAGE_DOWN   105)
    310 (def 'GLUT_KEY_HOME        106)
    311 (def 'GLUT_KEY_END         107)
    312 (def 'GLUT_KEY_INSERT      108)
    313 
    314 # Mouse state definitions
    315 (def 'GLUT_LEFT_BUTTON     0)
    316 (def 'GLUT_MIDDLE_BUTTON   1)
    317 (def 'GLUT_RIGHT_BUTTON    2)
    318 
    319 # Display mode definitions
    320 (def 'GLUT_RGB          (hex "0000"))
    321 (def 'GLUT_RGBA         (hex "0000"))
    322 (def 'GLUT_INDEX        (hex "0001"))
    323 (def 'GLUT_SINGLE       (hex "0000"))
    324 (def 'GLUT_DOUBLE       (hex "0002"))
    325 (def 'GLUT_ACCUM        (hex "0004"))
    326 (def 'GLUT_ALPHA        (hex "0008"))
    327 (def 'GLUT_DEPTH        (hex "0010"))
    328 (def 'GLUT_STENCIL      (hex "0020"))
    329 (def 'GLUT_MULTISAMPLE  (hex "0080"))
    330 (def 'GLUT_STEREO       (hex "0100"))
    331 (def 'GLUT_LUMINANCE    (hex "0200"))
    332 
    333 ### Native functions ###
    334 # Initialization functions
    335 (de glutInit ()
    336    (native `*GlutLib "glutInit" NIL '(NIL (8) . 0)) )
    337 
    338 (de glutInitWindowPosition (Width Height)
    339    (native `*GlutLib "glutInitWindowPosition" NIL Width Height) )
    340 
    341 (de glutInitWindowSize (Width Height)
    342    (native `*GlutLib "glutInitWindowSize" NIL Width Height) )
    343 
    344 (de glutInitDisplayMode (N)
    345    (native `*GlutLib "glutInitDisplayMode" NIL N) )
    346 
    347 # Process loop function
    348 (de glutMainLoop ()
    349    (native `*GlutLib "glutMainLoop") )
    350 
    351 # Window management functions
    352 (de glutCreateWindow (Name)
    353    (native `*GlutLib "glutCreateWindow" NIL Name) )
    354 
    355 # Display-connected functions
    356 (de glutPostRedisplay ()
    357    (native `*GlutLib "glutPostRedisplay") )
    358 
    359 (de glutSwapBuffers ()
    360    (native `*GlutLib "glutSwapBuffers") )
    361 
    362 # Mouse cursor functions
    363 
    364 # Overlay stuff
    365 
    366 # Menu stuff
    367 (de createMenu (Fun)
    368    (native `*GlutLib "glutCreateMenu" NIL (lisp 'createMenu Fun)) )
    369 
    370 (de glutAddMenuEntry (Name Val)
    371    (native `*GlutLib "glutAddMenuEntry" NIL Name Val) )
    372 
    373 (de glutAttachMenu (Button)
    374    (native `*GlutLib "glutAttachMenu" NIL Button) )
    375 
    376 # Global callback functions
    377 (de timerFunc (Msec Fun Val)
    378    (native `*GlutLib "glutTimerFunc" NIL Msec (lisp 'timerFunc Fun) Val) )
    379 
    380 # Window-specific callback functions
    381 (de keyboardFunc (Fun)
    382    (native `*GlutLib "glutKeyboardFunc" NIL (lisp 'keyboardFunc Fun)) )
    383 
    384 (de specialFunc (Fun)
    385    (native `*GlutLib "glutSpecialFunc" NIL (lisp 'specialFunc Fun)) )
    386 
    387 (de reshapeFunc (Fun)
    388    (native `*GlutLib "glutReshapeFunc" NIL (lisp 'reshapeFunc Fun)) )
    389 
    390 (de displayPrg Prg
    391    (native `*GlutLib "glutDisplayFunc" NIL (lisp 'displayPrg (cons NIL Prg))) )
    392 
    393 (de mouseFunc (Fun)
    394    (native `*GlutLib "glutMouseFunc" NIL (lisp 'mouseFunc Fun)) )
    395 
    396 (de motionFunc (Fun)
    397    (native `*GlutLib "glutMotionFunc" NIL (lisp 'motionFunc Fun)) )
    398 
    399 # State setting and retrieval functions
    400 
    401 # Font stuff
    402 
    403 # Geometry functions
    404 (de glutWireCube (Size)
    405    (set "Dbl1" Size)
    406    (native `*GlutLib "glutWireCube" NIL "Dbl1") )
    407 
    408 (de glutSolidCube (Size)
    409    (set "Dbl1" Size)
    410    (native `*GlutLib "glutSolidCube" NIL "Dbl1") )
    411 
    412 (de glutWireSphere (Radius Slices Stacks)
    413    (set "Dbl1" Radius)
    414    (native `*GlutLib "glutWireSphere" NIL "Dbl1" Slices Stacks) )
    415 
    416 (de glutSolidSphere (Radius Slices Stacks)
    417    (set "Dbl1" Radius)
    418    (native `*GlutLib "glutSolidSphere" NIL "Dbl1" Slices Stacks) )
    419 
    420 # Teapot rendering functions
    421 
    422 # Game mode functions
    423 
    424 # Video resize functions
    425 
    426 # Colormap functions
    427 
    428 # Misc keyboard and joystick functions
    429 
    430 # Misc functions
    431 
    432 # vi:et:ts=3:sw=3