fix the resolver mess, and add glut to the build
authorAndy Wingo <wingo@pobox.com>
Tue, 5 Feb 2013 09:30:41 +0000 (10:30 +0100)
committerAndy Wingo <wingo@pobox.com>
Tue, 5 Feb 2013 10:14:46 +0000 (11:14 +0100)
* maint/update-low-level-bindings (write-scm): Update to use
  module-specific runtimes, and to generate define-FOO-procedure forms.
  This way modules can control how their symbols are loaded.

* figl/runtime.scm: Remove the default resolver; instead have
  define-foreign-procedure take a resolver form.

* figl/gl/runtime.scm:
* figl/glu/runtime.scm:
* figl/glut/runtime.scm:
* figl/glx/runtime.scm: New support modules.

* figl/gl/low-level.scm:
* figl/glu/low-level.scm:
* figl/glx/low-level.scm: Regenerate.

* figl/glut/low-level.scm: Change to use define-glut-procedure, and to
  delegate all the resolver business to the runtime module.

* Makefile.am: Add new files, and add glut to the build.

12 files changed:
Makefile.am
figl/gl/low-level.scm
figl/gl/runtime.scm [new file with mode: 0644]
figl/glu/low-level.scm
figl/glu/runtime.scm [new file with mode: 0644]
figl/glut/low-level.scm
figl/glut/runtime.scm [new file with mode: 0644]
figl/glx.scm
figl/glx/low-level.scm
figl/glx/runtime.scm [new file with mode: 0644]
figl/runtime.scm
maint/update-low-level-bindings

index debe5b4..dabc46f 100644 (file)
@@ -8,14 +8,24 @@ SOURCES = \
        figl/config.scm \
        figl/parse.scm \
        figl/runtime.scm \
+       \
        figl/gl/types.scm \
+       figl/gl/runtime.scm \
        figl/gl/low-level.scm \
        figl/gl.scm \
+       \
        figl/glu/types.scm \
+       figl/glu/runtime.scm \
        figl/glu/low-level.scm \
+       \
        figl/glx/types.scm \
+       figl/glx/runtime.scm \
        figl/glx/low-level.scm \
-       figl/glx.scm
+       figl/glx.scm \
+       \
+       figl/glut/runtime.scm \
+       figl/glut/low-level.scm \
+       figl/glut.scm
 
 update: figl/parse.go
        $(top_builddir)/env $(GUILE) $(top_srcdir)/maint/update-low-level-bindings
index 08d980d..5211970 100644 (file)
@@ -43,7 +43,7 @@
 (define-module
   (figl gl low-level)
   #:use-module
-  (figl runtime)
+  (figl gl runtime)
   #:use-module
   (figl gl types)
   #:export
     glWindowPos3i
     glWindowPos3f))
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glAccum (op GLenum) (value GLfloat) -> void))
   "Operate on the accumulation buffer.
 
@@ -428,7 +428,7 @@ enabled.
 `GL_INVALID_OPERATION' is generated if `glAccum' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glActiveTexture (texture GLenum) -> void))
   "Select active texture unit.
 
@@ -451,7 +451,7 @@ Vertex arrays are client-side GL resources, which are selected by the
 where i ranges from 0 to the larger of (`GL_MAX_TEXTURE_COORDS' - 1) and
 (`GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS' - 1).")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glAlphaFunc
      (func GLenum)
      (ref GLclampf)
@@ -524,7 +524,7 @@ affect screen clear operations.
 `GL_INVALID_OPERATION' is generated if `glAlphaFunc' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glAreTexturesResident
      (n GLsizei)
      (textures const-GLuint-*)
@@ -574,7 +574,7 @@ the contents of RESIDENCES is indeterminate.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glArrayElement (i GLint) -> void))
   "Render a vertex using the specified vertex array element.
 
@@ -608,7 +608,7 @@ to array data may access original data.
 bound to an enabled array and the buffer object's data store is
 currently mapped.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glAttachShader
      (program GLuint)
      (shader GLuint)
@@ -657,7 +657,7 @@ PROGRAM.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBeginQuery
      (target GLenum)
      (id GLuint)
@@ -707,7 +707,7 @@ active query object.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBegin (mode GLenum) -> void) (glEnd -> void))
   "Delimit the vertices of a primitive or a group of like primitives.
 
@@ -823,7 +823,7 @@ Execution of `glEnableClientState', `glDisableClientState',
 `glBegin' and before the corresponding call to `glEnd', but an error may
 or may not be generated.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBindAttribLocation
      (program GLuint)
      (index GLuint)
@@ -897,7 +897,7 @@ OpenGL.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBindBuffer
      (target GLenum)
      (buffer GLuint)
@@ -1000,7 +1000,7 @@ values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBindTexture
      (target GLenum)
      (texture GLuint)
@@ -1074,7 +1074,7 @@ with a target that doesn't match that of TARGET.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBitmap
      (width GLsizei)
      (height GLsizei)
@@ -1169,7 +1169,7 @@ would exceed the data store size.
 `GL_INVALID_OPERATION' is generated if `glBitmap' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBlendColor
      (red GLclampf)
      (green GLclampf)
@@ -1198,7 +1198,7 @@ blending operations. Initially the `GL_BLEND_COLOR' is set to (0, 0, 0,
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBlendEquationSeparate
      (modeRGB GLenum)
      (modeAlpha GLenum)
@@ -1278,7 +1278,7 @@ of `GL_FUNC_ADD', `GL_FUNC_SUBTRACT', `GL_FUNC_REVERSE_SUBTRACT',
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBlendEquation (mode GLenum) -> void))
   "Specify the equation used for both the RGB blend equation and the Alpha
 blend equation.
@@ -1346,7 +1346,7 @@ set to `GL_FUNC_ADD'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBlendFuncSeparate
      (srcRGB GLenum)
      (dstRGB GLenum)
@@ -1494,7 +1494,7 @@ accepted value.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBlendFunc
      (sfactor GLenum)
      (dfactor GLenum)
@@ -1628,7 +1628,7 @@ accepted value.
 `GL_INVALID_OPERATION' is generated if `glBlendFunc' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBufferData
      (target GLenum)
      (size GLsizeiptr)
@@ -1719,7 +1719,7 @@ store with the specified SIZE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glBufferSubData
      (target GLenum)
      (offset GLintptr)
@@ -1770,7 +1770,7 @@ is mapped.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCallLists
      (n GLsizei)
      (type GLenum)
@@ -1875,7 +1875,7 @@ remain after execution is completed. Use `glPushAttrib', `glPopAttrib',
 `GL_UNSIGNED_BYTE', `GL_SHORT', `GL_UNSIGNED_SHORT', `GL_INT',
 `GL_UNSIGNED_INT', `GL_FLOAT', `GL_2_BYTES', `GL_3_BYTES', `GL_4_BYTES'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCallList (list GLuint) -> void))
   "Execute a display list.
 
@@ -1899,7 +1899,7 @@ after execution of the display list is completed. Use `glPushAttrib',
 `glPopAttrib', `glPushMatrix', and `glPopMatrix' to preserve GL state
 across `glCallList' calls.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClearAccum
      (red GLfloat)
      (green GLfloat)
@@ -1928,7 +1928,7 @@ Values specified by `glClearAccum' are clamped to the range [-1,1] .
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClearColor
      (red GLclampf)
      (green GLclampf)
@@ -1956,7 +1956,7 @@ are clamped to the range [0,1] .
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClearDepth (depth GLclampd) -> void))
   "Specify the clear value for the depth buffer.
 
@@ -1972,7 +1972,7 @@ range [0,1] .
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClearIndex (c GLfloat) -> void))
   "Specify the clear value for the color index buffers.
 
@@ -1990,7 +1990,7 @@ number of bits in a color index stored in the frame buffer.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClearStencil (s GLint) -> void))
   "Specify the clear value for the stencil buffer.
 
@@ -2006,7 +2006,7 @@ in the stencil buffer.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClear (mask GLbitfield) -> void))
   "Clear buffers to preset values.
 
@@ -2053,7 +2053,7 @@ bits is set in MASK.
 `GL_INVALID_OPERATION' is generated if `glClear' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClientActiveTexture (texture GLenum) -> void))
   "Select active texture unit.
 
@@ -2072,7 +2072,7 @@ called with a parameter of `GL_TEXTURE_COORD_ARRAY'.
 `GL_INVALID_ENUM' is generated if TEXTURE is not one of `GL_TEXTURE'I ,
 where i ranges from 0 to the value of `GL_MAX_TEXTURE_COORDS' - 1.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glClipPlane
      (plane GLenum)
      (equation const-GLdouble-*)
@@ -2119,7 +2119,7 @@ coordinates and are disabled.
 `GL_INVALID_OPERATION' is generated if `glClipPlane' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColorMask
      (red GLboolean)
      (green GLboolean)
@@ -2151,7 +2151,7 @@ changes are either enabled or disabled for entire color components.
 `GL_INVALID_OPERATION' is generated if `glColorMask' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColorMaterial
      (face GLenum)
      (mode GLenum)
@@ -2186,7 +2186,7 @@ initially disabled.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColorPointer
      (size GLint)
      (type GLenum)
@@ -2245,7 +2245,7 @@ the color array is used when `glDrawArrays', `glMultiDrawArrays',
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColorSubTable
      (target GLenum)
      (start GLsizei)
@@ -2330,7 +2330,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColorTable
      (target GLenum)
      (internalformat GLenum)
@@ -2582,7 +2582,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glColor3i
      (red GLint)
      (green GLint)
@@ -2662,7 +2662,7 @@ range [0,1] before the current color is updated. However, color
 components are clamped to this range before they are interpolated or
 written into a color buffer.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompileShader (shader GLuint) -> void))
   "Compiles a shader object.
 
@@ -2693,7 +2693,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexImage1D
      (target GLenum)
      (level GLint)
@@ -2794,7 +2794,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexImage2D
      (target GLenum)
      (level GLint)
@@ -2910,7 +2910,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexImage3D
      (target GLenum)
      (level GLint)
@@ -3027,7 +3027,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexSubImage1D
      (target GLenum)
      (level GLint)
@@ -3121,7 +3121,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexSubImage2D
      (target GLenum)
      (level GLint)
@@ -3231,7 +3231,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCompressedTexSubImage3D
      (target GLenum)
      (level GLint)
@@ -3340,7 +3340,7 @@ Undefined results, including abnormal program termination, are generated
 if DATA is not encoded in a manner consistent with the extension
 specification defining the internal compression format.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glConvolutionFilter1D
      (target GLenum)
      (internalformat GLenum)
@@ -3503,7 +3503,7 @@ indicated by TYPE.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glConvolutionFilter2D
      (target GLenum)
      (internalformat GLenum)
@@ -3677,7 +3677,7 @@ indicated by TYPE.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glConvolutionParameterf
      (target GLenum)
      (pname GLenum)
@@ -3758,7 +3758,7 @@ and PARAMS is not one of `GL_REDUCE', `GL_CONSTANT_BORDER', or
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyColorSubTable
      (target GLenum)
      (start GLsizei)
@@ -3806,7 +3806,7 @@ values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyColorTable
      (target GLenum)
      (internalformat GLenum)
@@ -3916,7 +3916,7 @@ large to be supported by the implementation.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyConvolutionFilter1D
      (target GLenum)
      (internalformat GLenum)
@@ -4031,7 +4031,7 @@ than the maximum supported value. This value may be queried with
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyConvolutionFilter2D
      (target GLenum)
      (internalformat GLenum)
@@ -4157,7 +4157,7 @@ than the maximum supported value. This value may be queried with
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyPixels
      (x GLint)
      (y GLint)
@@ -4317,7 +4317,7 @@ no stencil buffer.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyTexImage1D
      (target GLenum)
      (level GLint)
@@ -4430,7 +4430,7 @@ between the execution of `glBegin' and the corresponding execution of
 `GL_DEPTH_COMPONENT', `GL_DEPTH_COMPONENT16', `GL_DEPTH_COMPONENT24', or
 `GL_DEPTH_COMPONENT32' and there is no depth buffer.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyTexImage2D
      (target GLenum)
      (level GLint)
@@ -4550,7 +4550,7 @@ between the execution of `glBegin' and the corresponding execution of
 `GL_DEPTH_COMPONENT', `GL_DEPTH_COMPONENT16', `GL_DEPTH_COMPONENT24', or
 `GL_DEPTH_COMPONENT32' and there is no depth buffer.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyTexSubImage1D
      (target GLenum)
      (level GLint)
@@ -4622,7 +4622,7 @@ the returned value of `GL_MAX_TEXTURE_SIZE'.
 `GL_TEXTURE_BORDER' of the texture image being modified. Note that W
 includes twice the border width.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyTexSubImage2D
      (target GLenum)
      (level GLint)
@@ -4721,7 +4721,7 @@ H include twice the border width.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCopyTexSubImage3D
      (target GLenum)
      (level GLint)
@@ -4819,7 +4819,7 @@ the returned value of `GL_MAX_3D_TEXTURE_SIZE'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCreateProgram -> GLuint))
   "Creates a program object.
 
@@ -4848,7 +4848,7 @@ This function returns 0 if an error occurs creating the program object.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCreateShader (shaderType GLenum) -> GLuint))
   "Creates a shader object.
 
@@ -4878,7 +4878,7 @@ This function returns 0 if an error occurs creating the shader object.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glCullFace (mode GLenum) -> void))
   "Specify whether front- or back-facing facets can be culled.
 
@@ -4901,7 +4901,7 @@ facets are front-facing and back-facing. See `glFrontFace'.
 `GL_INVALID_OPERATION' is generated if `glCullFace' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteBuffers
      (n GLsizei)
      (buffers const-GLuint-*)
@@ -4930,7 +4930,7 @@ to existing buffer objects.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteLists
      (list GLuint)
      (range GLsizei)
@@ -4960,7 +4960,7 @@ ignored. If RANGE is 0, nothing happens.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteProgram (program GLuint) -> void))
   "Deletes a program object.
 
@@ -4989,7 +4989,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteQueries
      (n GLsizei)
      (ids const-GLuint-*)
@@ -5016,7 +5016,7 @@ to existing query objects.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteShader (shader GLuint) -> void))
   "Deletes a shader object.
 
@@ -5043,7 +5043,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDeleteTextures
      (n GLsizei)
      (textures const-GLuint-*)
@@ -5072,7 +5072,7 @@ to existing textures.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDepthFunc (func GLenum) -> void))
   "Specify the value used for depth buffer comparisons.
 
@@ -5129,7 +5129,7 @@ is as if the depth test always passes.
 `GL_INVALID_OPERATION' is generated if `glDepthFunc' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDepthMask (flag GLboolean) -> void))
   "Enable or disable writing into the depth buffer.
 
@@ -5145,7 +5145,7 @@ is enabled. Initially, depth buffer writing is enabled.
 `GL_INVALID_OPERATION' is generated if `glDepthMask' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDepthRange
      (nearVal GLclampd)
      (farVal GLclampd)
@@ -5178,7 +5178,7 @@ With this mapping, the depth buffer range is fully utilized.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDetachShader
      (program GLuint)
      (shader GLuint)
@@ -5215,7 +5215,7 @@ PROGRAM.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawArrays
      (mode GLenum)
      (first GLint)
@@ -5266,7 +5266,7 @@ currently mapped.
 `GL_INVALID_OPERATION' is generated if `glDrawArrays' is executed
 between the execution of `glBegin' and the corresponding `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawBuffers
      (n GLsizei)
      (bufs const-GLenum-*)
@@ -5344,7 +5344,7 @@ current GL context.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawBuffer (mode GLenum) -> void))
   "Specify which color buffers are to be drawn into.
 
@@ -5427,7 +5427,7 @@ MODE exists.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawElements
      (mode GLenum)
      (count GLsizei)
@@ -5484,7 +5484,7 @@ data store is currently mapped.
 `GL_INVALID_OPERATION' is generated if `glDrawElements' is executed
 between the execution of `glBegin' and the corresponding `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawPixels
      (width GLsizei)
      (height GLsizei)
@@ -5893,7 +5893,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glDrawRangeElements
      (mode GLenum)
      (start GLuint)
@@ -5972,7 +5972,7 @@ data store is currently mapped.
 `GL_INVALID_OPERATION' is generated if `glDrawRangeElements' is executed
 between the execution of `glBegin' and the corresponding `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEdgeFlagPointer
      (stride GLsizei)
      (pointer const-GLvoid-*)
@@ -6013,7 +6013,7 @@ enabled, the edge flag array is used when `glDrawArrays',
 
 `GL_INVALID_ENUM' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEdgeFlag (flag GLboolean) -> void))
   "Flag edges as either boundary or nonboundary.
 
@@ -6036,7 +6036,7 @@ Boundary and nonboundary edge flags on vertices are significant only if
 `GL_POLYGON_MODE' is set to `GL_POINT' or `GL_LINE'. See
 `glPolygonMode'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEnableClientState (cap GLenum) -> void)
    (glDisableClientState (cap GLenum) -> void))
   "Enable or disable client-side capability.
@@ -6107,7 +6107,7 @@ of the following values:
 and the corresponding `glEnd', but an error may or may not be generated.
 If no error is generated, the behavior is undefined.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEnableVertexAttribArray
      (index GLuint)
      ->
@@ -6139,7 +6139,7 @@ array commands such as `glDrawArrays', `glDrawElements',
 ' or `glDisableVertexAttribArray ' is executed between the execution of
 `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEnable (cap GLenum) -> void)
    (glDisable (cap GLenum) -> void))
   "Enable or disable server-side GL capabilities.
@@ -6606,7 +6606,7 @@ previously.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEvalCoord1f (u GLfloat) -> void)
    (glEvalCoord2f (u GLfloat) (v GLfloat) -> void))
   "Evaluate enabled one- and two-dimensional maps.
@@ -6672,7 +6672,7 @@ If automatic normal generation is disabled, the corresponding normal map
 automatic normal generation nor a normal map is enabled, no normal is
 generated for `glEvalCoord2' commands.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEvalMesh1
      (mode GLenum)
      (i1 GLint)
@@ -6799,7 +6799,7 @@ I=N , then the value computed from I·ΔU+U_1 is exactly U_2 , and if J=M
 `GL_INVALID_OPERATION' is generated if `glEvalMesh' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glEvalPoint1 (i GLint) -> void)
    (glEvalPoint2 (i GLint) (j GLint) -> void))
   "Generate and evaluate a single point in a mesh.
@@ -6841,7 +6841,7 @@ I=N , then the value computed from I·ΔU+U_1 is exactly U_2 , and if J=M
      
       );")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFeedbackBuffer
      (size GLsizei)
      (type GLenum)
@@ -6973,7 +6973,7 @@ once.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFinish -> void))
   "Block until all GL execution is complete.
 
@@ -6985,7 +6985,7 @@ contents.
 `GL_INVALID_OPERATION' is generated if `glFinish' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFlush -> void))
   "Force execution of GL commands in finite time.
 
@@ -7005,7 +7005,7 @@ that depends on the generated image.
 `GL_INVALID_OPERATION' is generated if `glFlush' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFogCoordPointer
      (type GLenum)
      (stride GLsizei)
@@ -7057,7 +7057,7 @@ called.
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFogCoordf (coord GLfloat) -> void))
   "Set the current fog coordinates.
 
@@ -7068,7 +7068,7 @@ COORD
 vertex and the current raster position. The value specified is
 interpolated and used in computing the fog color (see `glFog').")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFogf (pname GLenum) (param GLfloat) -> void)
    (glFogi (pname GLenum) (param GLint) -> void))
   "Specify fog parameters.
@@ -7167,7 +7167,7 @@ is negative.
 `GL_INVALID_OPERATION' is generated if `glFog' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFrontFace (mode GLenum) -> void))
   "Define front- and back-facing polygons.
 
@@ -7200,7 +7200,7 @@ taken to be front-facing.
 `GL_INVALID_OPERATION' is generated if `glFrontFace' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glFrustum
      (left GLdouble)
      (right GLdouble)
@@ -7266,7 +7266,7 @@ if LEFT = RIGHT, or BOTTOM = TOP, or NEAR = FAR.
 `GL_INVALID_OPERATION' is generated if `glFrustum' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGenBuffers
      (n GLsizei)
      (buffers GLuint-*)
@@ -7299,7 +7299,7 @@ until they are first bound by calling `glBindBuffer'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGenLists (range GLsizei) -> GLuint))
   "Generate a contiguous set of empty display lists.
 
@@ -7318,7 +7318,7 @@ generated, and 0 is returned.
 `GL_INVALID_OPERATION' is generated if `glGenLists' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGenQueries (n GLsizei) (ids GLuint-*) -> void))
   "Generate query object names.
 
@@ -7347,7 +7347,7 @@ until they are first used by calling `glBeginQuery'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGenTextures
      (n GLsizei)
      (textures GLuint-*)
@@ -7379,7 +7379,7 @@ subsequent calls, unless they are first deleted with `glDeleteTextures'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetActiveAttrib
      (program GLuint)
      (index GLuint)
@@ -7486,7 +7486,7 @@ between the execution of `glBegin' and the corresponding execution of
 
 `GL_INVALID_VALUE' is generated if BUFSIZE is less than 0.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetActiveUniform
      (program GLuint)
      (index GLuint)
@@ -7617,7 +7617,7 @@ between the execution of `glBegin' and the corresponding execution of
 
 `GL_INVALID_VALUE' is generated if BUFSIZE is less than 0.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetAttachedShaders
      (program GLuint)
      (maxCount GLsizei)
@@ -7666,7 +7666,7 @@ OpenGL.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetAttribLocation
      (program GLuint)
      (name const-GLchar-*)
@@ -7714,7 +7714,7 @@ linked.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetBufferSubData
      (target GLenum)
      (offset GLintptr)
@@ -7766,7 +7766,7 @@ is mapped.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetClipPlane
      (plane GLenum)
      (equation GLdouble-*)
@@ -7795,7 +7795,7 @@ equation for PLANE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetColorTable
      (target GLenum)
      (format GLenum)
@@ -7905,7 +7905,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetCompressedTexImage
      (target GLenum)
      (lod GLint)
@@ -7973,7 +7973,7 @@ the data store size.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetConvolutionFilter
      (target GLenum)
      (format GLenum)
@@ -8083,7 +8083,7 @@ indicated by TYPE.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetError -> GLenum))
   "Return error information.
 
@@ -8153,7 +8153,7 @@ returns 0. If `glGetError' itself generates an error, it returns 0.
 the execution of `glBegin' and the corresponding execution of `glEnd'.
 In this case, `glGetError' returns 0.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetHistogram
      (target GLenum)
      (reset GLboolean)
@@ -8264,7 +8264,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetMinmax
      (target GLenum)
      (reset GLboolean)
@@ -8383,7 +8383,7 @@ indicated by TYPE.
 `GL_INVALID_OPERATION' is generated if `glGetMinmax' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetPolygonStipple (pattern GLubyte-*) -> void))
   "Return the polygon stipple pattern.
 
@@ -8416,7 +8416,7 @@ the data store size.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetProgramInfoLog
      (program GLuint)
      (maxLength GLsizei)
@@ -8473,7 +8473,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetSeparableFilter
      (target GLenum)
      (format GLenum)
@@ -8593,7 +8593,7 @@ datum indicated by TYPE.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetShaderInfoLog
      (shader GLuint)
      (maxLength GLsizei)
@@ -8647,7 +8647,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetShaderSource
      (shader GLuint)
      (bufSize GLsizei)
@@ -8697,7 +8697,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetString (name GLenum) -> const-GLubyte*))
   "Return a string describing the current GL connection.
 
@@ -8766,7 +8766,7 @@ All strings are null-terminated.
 `GL_INVALID_OPERATION' is generated if `glGetString' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetTexImage
      (target GLenum)
      (level GLint)
@@ -8890,7 +8890,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glGetUniformLocation
      (program GLuint)
      (name const-GLchar-*)
@@ -8947,7 +8947,7 @@ linked.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glHint (target GLenum) (mode GLenum) -> void))
   "Specify implementation-specific hints.
 
@@ -9057,7 +9057,7 @@ accepted value.
 `GL_INVALID_OPERATION' is generated if `glHint' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glHistogram
      (target GLenum)
      (width GLsizei)
@@ -9138,7 +9138,7 @@ histogram table specified is too large for the implementation.
 `GL_INVALID_OPERATION' is generated if `glHistogram' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIndexMask (mask GLuint) -> void))
   "Control the writing of individual bits in the color index buffers.
 
@@ -9161,7 +9161,7 @@ all bits are enabled for writing.
 `GL_INVALID_OPERATION' is generated if `glIndexMask' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIndexPointer
      (type GLenum)
      (stride GLsizei)
@@ -9211,7 +9211,7 @@ enabled, the color index array is used when `glDrawArrays',
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIndexi (c GLint) -> void)
    (glIndexf (c GLfloat) -> void)
    (glIndexub (c GLubyte) -> void))
@@ -9235,7 +9235,7 @@ written to the frame buffer, it is converted to fixed-point format. Any
 bits in the integer portion of the resulting fixed-point value that do
 not correspond to bits in the frame buffer are masked out.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glInitNames -> void))
   "Initialize the name stack.
 
@@ -9251,7 +9251,7 @@ ignored.
 `GL_INVALID_OPERATION' is generated if `glInitNames' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glInterleavedArrays
      (format GLenum)
      (stride GLsizei)
@@ -9295,7 +9295,7 @@ located at the first possible floating-point aligned address.
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsBuffer (buffer GLuint) -> GLboolean))
   "Determine if a name corresponds to a buffer object.
 
@@ -9313,7 +9313,7 @@ object by calling `glBindBuffer', is not the name of a buffer object.
 `GL_INVALID_OPERATION' is generated if `glIsBuffer' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsEnabled (cap GLenum) -> GLboolean))
   "Test whether a capability is enabled.
 
@@ -9557,7 +9557,7 @@ The following capabilities are accepted for CAP:
 `GL_INVALID_OPERATION' is generated if `glIsEnabled' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsList (list GLuint) -> GLboolean))
   "Determine if a name corresponds to a display list.
 
@@ -9573,7 +9573,7 @@ list by calling `glNewList', is not the name of a display list.
 `GL_INVALID_OPERATION' is generated if `glIsList' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsProgram (program GLuint) -> GLboolean))
   "Determines if a name corresponds to a program object.
 
@@ -9589,7 +9589,7 @@ returns `GL_FALSE'.
 `GL_INVALID_OPERATION' is generated if `glIsProgram' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsQuery (id GLuint) -> GLboolean))
   "Determine if a name corresponds to a query object.
 
@@ -9607,7 +9607,7 @@ object by calling `glBeginQuery', is not the name of a query object.
 `GL_INVALID_OPERATION' is generated if `glIsQuery' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsShader (shader GLuint) -> GLboolean))
   "Determines if a name corresponds to a shader object.
 
@@ -9623,7 +9623,7 @@ name of a shader object, or if an error occurs, `glIsShader ' returns
 `GL_INVALID_OPERATION' is generated if `glIsShader' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glIsTexture (texture GLuint) -> GLboolean))
   "Determine if a name corresponds to a texture.
 
@@ -9641,7 +9641,7 @@ texture by calling `glBindTexture', is not the name of a texture.
 `GL_INVALID_OPERATION' is generated if `glIsTexture' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLightModelf
      (pname GLenum)
      (param GLfloat)
@@ -9754,7 +9754,7 @@ RGBA case, determine how much above ambient the resulting index is.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLightf
      (light GLenum)
      (pname GLenum)
@@ -9906,7 +9906,7 @@ attenuation factor is specified.
 `GL_INVALID_OPERATION' is generated if `glLight' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLineStipple
      (factor GLint)
      (pattern GLushort)
@@ -9956,7 +9956,7 @@ were all 1's. Initially, line stippling is disabled.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLineWidth (width GLfloat) -> void))
   "Specify the width of rasterized lines.
 
@@ -9998,7 +9998,7 @@ between supported widths within the range, call `glGet' with arguments
 `GL_INVALID_OPERATION' is generated if `glLineWidth' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLinkProgram (program GLuint) -> void))
   "Links a program object.
 
@@ -10096,7 +10096,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glListBase (base GLuint) -> void))
   "Set the display-list base for .
 
@@ -10111,7 +10111,7 @@ display lists are executed; the others are ignored.
 `GL_INVALID_OPERATION' is generated if `glListBase' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLoadIdentity -> void))
   "Replace the current matrix with the identity matrix.
 
@@ -10131,7 +10131,7 @@ but in some cases it is more efficient.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLoadMatrixf (m const-GLfloat-*) -> void))
   "Replace the current matrix with the specified matrix.
 
@@ -10163,7 +10163,7 @@ Projection and texture transformations are similarly defined.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLoadName (name GLuint) -> void))
   "Load a name onto the name stack.
 
@@ -10187,7 +10187,7 @@ name stack is empty.
 `GL_INVALID_OPERATION' is generated if `glLoadName' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLoadTransposeMatrixf
      (m const-GLfloat-*)
      ->
@@ -10225,7 +10225,7 @@ to `glLoadMatrix' with M^T , where T represents the transpose.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glLogicOp (opcode GLenum) -> void))
   "Specify a logical pixel operation for color index rendering.
 
@@ -10310,7 +10310,7 @@ source and destination indices or colors.
 `GL_INVALID_OPERATION' is generated if `glLogicOp' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMap1f
      (target GLenum)
      (u1 GLfloat)
@@ -10471,7 +10471,7 @@ execution of `glBegin' and the corresponding execution of `glEnd'.
 `GL_INVALID_OPERATION' is generated if `glMap1' is called and the value
 of `GL_ACTIVE_TEXTURE' is not `GL_TEXTURE0'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMap2f
      (target GLenum)
      (u1 GLfloat)
@@ -10670,7 +10670,7 @@ execution of `glBegin' and the corresponding execution of `glEnd'.
 `GL_INVALID_OPERATION' is generated if `glMap2' is called and the value
 of `GL_ACTIVE_TEXTURE' is not `GL_TEXTURE0'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMapBuffer
      (target GLenum)
      (access GLenum)
@@ -10748,7 +10748,7 @@ buffer object whose data store is not currently mapped.
 is executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMapGrid1f
      (un GLint)
      (u1 GLfloat)
@@ -10820,7 +10820,7 @@ The mappings specified by `glMapGrid' are used identically by
 `GL_INVALID_OPERATION' is generated if `glMapGrid' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMaterialf
      (face GLenum)
      (pname GLenum)
@@ -10928,7 +10928,7 @@ accepted value.
 `GL_INVALID_VALUE' is generated if a specular exponent outside the range
 [0,128] is specified.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMatrixMode (mode GLenum) -> void))
   "Specify which matrix is the current matrix.
 
@@ -10965,7 +10965,7 @@ value is `GL_MODELVIEW'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMinmax
      (target GLenum)
      (internalformat GLenum)
@@ -11030,7 +11030,7 @@ allowable values.
 `GL_INVALID_OPERATION' is generated if `glMinmax' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMultiDrawArrays
      (mode GLenum)
      (first GLint-*)
@@ -11088,7 +11088,7 @@ currently mapped.
 `GL_INVALID_OPERATION' is generated if `glMultiDrawArrays' is executed
 between the execution of `glBegin' and the corresponding `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMultiDrawElements
      (mode GLenum)
      (count const-GLsizei-*)
@@ -11146,7 +11146,7 @@ data store is currently mapped.
 `GL_INVALID_OPERATION' is generated if `glMultiDrawElements' is executed
 between the execution of `glBegin' and the corresponding `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMultiTexCoord1i
      (target GLenum)
      (s GLint)
@@ -11229,7 +11229,7 @@ The current texture coordinates are part of the data that is associated
 with each vertex and with the current raster position. Initially, the
 values for (S,TRQ) are (0,001) .")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMultMatrixf (m const-GLfloat-*) -> void))
   "Multiply the current matrix with the specified matrix.
 
@@ -11248,7 +11248,7 @@ or the texture matrix.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glMultTransposeMatrixf
      (m const-GLfloat-*)
      ->
@@ -11270,7 +11270,7 @@ or the texture matrix.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glNewList (list GLuint) (mode GLenum) -> void)
    (glEndList -> void))
   "Create or replace a display list.
@@ -11348,7 +11348,7 @@ is made to the previous contents of the display list, if any, and no
 other change is made to the GL state. (It is as if no attempt had been
 made to create the new display list.)")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glNormalPointer
      (type GLenum)
      (stride GLsizei)
@@ -11398,7 +11398,7 @@ the normal array is used when `glDrawArrays', `glMultiDrawArrays',
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glNormal3f
      (nx GLfloat)
      (ny GLfloat)
@@ -11441,7 +11441,7 @@ normalization, call `glEnable' and `glDisable' with either
 `GL_NORMALIZE' or `GL_RESCALE_NORMAL'. Normalization is initially
 disabled.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glOrtho
      (left GLdouble)
      (right GLdouble)
@@ -11499,7 +11499,7 @@ NEAR = FAR.
 `GL_INVALID_OPERATION' is generated if `glOrtho' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPassThrough (token GLfloat) -> void))
   "Place a marker in the feedback buffer.
 
@@ -11526,7 +11526,7 @@ respect to the specification of graphics primitives is maintained.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPixelStoref
      (pname GLenum)
      (param GLfloat)
@@ -11826,7 +11826,7 @@ row skip value is specified, or if alignment is specified as other than
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPixelTransferf
      (pname GLenum)
      (param GLfloat)
@@ -12112,7 +12112,7 @@ assigned to real-valued parameters.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPixelZoom
      (xfactor GLfloat)
      (yfactor GLfloat)
@@ -12144,7 +12144,7 @@ factors reflect the resulting image about the current raster position.
 `GL_INVALID_OPERATION' is generated if `glPixelZoom' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPointParameterf
      (pname GLenum)
      (param GLfloat)
@@ -12212,7 +12212,7 @@ If the value for `GL_POINT_SIZE_MIN' is greater than
 `GL_POINT_SIZE_MAX', the point size after clamping is undefined, but no
 error is generated.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPointSize (size GLfloat) -> void))
   "Specify the diameter of rasterized points.
 
@@ -12297,7 +12297,7 @@ supported ranges and granularity with `glGet' with arguments
 `GL_INVALID_OPERATION' is generated if `glPointSize' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPolygonMode
      (face GLenum)
      (mode GLenum)
@@ -12353,7 +12353,7 @@ value.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPolygonOffset
      (factor GLfloat)
      (units GLfloat)
@@ -12387,7 +12387,7 @@ edges.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPolygonStipple
      (pattern const-GLubyte-*)
      ->
@@ -12439,7 +12439,7 @@ would exceed the data store size.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPrioritizeTextures
      (n GLsizei)
      (textures const-GLuint-*)
@@ -12490,7 +12490,7 @@ bound. This is the only way to set the priority of a default texture.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPushAttrib (mask GLbitfield) -> void)
    (glPopAttrib -> void))
   "Push and pop the server attribute stack.
@@ -12995,7 +12995,7 @@ attribute stack is empty.
 is executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPushClientAttrib (mask GLbitfield) -> void)
    (glPopClientAttrib -> void))
   "Push and pop the client attribute stack.
@@ -13033,7 +13033,7 @@ the attribute stack is full.
 `GL_STACK_UNDERFLOW' is generated if `glPopClientAttrib' is called while
 the attribute stack is empty.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPushMatrix -> void) (glPopMatrix -> void))
   "Push and pop the current matrix stack.
 
@@ -13066,7 +13066,7 @@ current matrix stack contains only a single matrix.
 is executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glPushName (name GLuint) -> void)
    (glPopName -> void))
   "Push and pop the name stack.
@@ -13103,7 +13103,7 @@ name stack is empty.
 executed between a call to `glBegin' and the corresponding call to
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glRasterPos2i (x GLint) (y GLint) -> void)
    (glRasterPos2f (x GLfloat) (y GLfloat) -> void)
    (glRasterPos3i
@@ -13193,7 +13193,7 @@ raster RGBA color always maintains its initial value.
 `GL_INVALID_OPERATION' is generated if `glRasterPos' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glReadBuffer (mode GLenum) -> void))
   "Select a color buffer source for pixels.
 
@@ -13231,7 +13231,7 @@ not exist.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glReadPixels
      (x GLint)
      (y GLint)
@@ -13484,7 +13484,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glRectf
      (x1 GLfloat)
      (y1 GLfloat)
@@ -13533,7 +13533,7 @@ winding.
 `GL_INVALID_OPERATION' is generated if `glRect' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glRenderMode (mode GLenum) -> GLint))
   "Set rasterization mode.
 
@@ -13598,7 +13598,7 @@ once.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glResetHistogram (target GLenum) -> void))
   "Reset histogram table entries to zero.
 
@@ -13614,7 +13614,7 @@ table to zero.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glResetMinmax (target GLenum) -> void))
   "Reset minmax table entries to initial values.
 
@@ -13632,7 +13632,7 @@ possible component values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glRotatef
      (angle GLfloat)
      (x GLfloat)
@@ -13677,7 +13677,7 @@ and `glPopMatrix' to save and restore the unrotated coordinate system.
 `GL_INVALID_OPERATION' is generated if `glRotate' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glSampleCoverage
      (value GLclampf)
      (invert GLboolean)
@@ -13719,7 +13719,7 @@ each sample.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glScalef
      (x GLfloat)
      (y GLfloat)
@@ -13754,7 +13754,7 @@ coordinate system.
 `GL_INVALID_OPERATION' is generated if `glScale' is executed between the
 execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glScissor
      (x GLint)
      (y GLint)
@@ -13798,7 +13798,7 @@ includes the entire window.
 `GL_INVALID_OPERATION' is generated if `glScissor' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glSecondaryColorPointer
      (size GLint)
      (type GLenum)
@@ -13857,7 +13857,7 @@ called.
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glSecondaryColor3i
      (red GLint)
      (green GLint)
@@ -13920,7 +13920,7 @@ range [0,1] before the current color is updated. However, color
 components are clamped to this range before they are interpolated or
 written into a color buffer.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glSelectBuffer
      (size GLsizei)
      (buffer GLuint-*)
@@ -13987,7 +13987,7 @@ argument `GL_SELECT' before `glSelectBuffer' is called at least once.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glSeparableFilter2D
      (target GLenum)
      (internalformat GLenum)
@@ -14166,7 +14166,7 @@ datum indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glShadeModel (mode GLenum) -> void))
   "Select flat or smooth shading.
 
@@ -14227,7 +14227,7 @@ or `GL_SMOOTH'.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glShaderSource
      (shader GLuint)
      (count GLsizei)
@@ -14275,7 +14275,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilFuncSeparate
      (face GLenum)
      (func GLenum)
@@ -14375,7 +14375,7 @@ values.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilFunc
      (func GLenum)
      (ref GLint)
@@ -14469,7 +14469,7 @@ values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilMaskSeparate
      (face GLenum)
      (mask GLuint)
@@ -14504,7 +14504,7 @@ with FACE set to `GL_FRONT_AND_BACK'.
 executed between the execution of `glBegin' and the corresponding
 execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilMask (mask GLuint) -> void))
   "Control the front and back writing of individual bits in the stencil
 planes.
@@ -14530,7 +14530,7 @@ and back stencil writemasks to different values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilOpSeparate
      (face GLenum)
      (sfail GLenum)
@@ -14640,7 +14640,7 @@ other than the eight defined constant values.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glStencilOp
      (sfail GLenum)
      (dpfail GLenum)
@@ -14741,7 +14741,7 @@ other than the eight defined constant values.
 `GL_INVALID_OPERATION' is generated if `glStencilOp' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexCoordPointer
      (size GLint)
      (type GLenum)
@@ -14802,7 +14802,7 @@ called.
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexCoord1i (s GLint) -> void)
    (glTexCoord1f (s GLfloat) -> void)
    (glTexCoord2i (s GLint) (t GLint) -> void)
@@ -14855,7 +14855,7 @@ The current texture coordinates are part of the data that is associated
 with each vertex and with the current raster position. Initially, the
 values for S, T, R, and Q are (0, 0, 0, 1).")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexEnvf
      (target GLenum)
      (pname GLenum)
@@ -15209,7 +15209,7 @@ or `GL_ALPHA_SCALE' are not one of 1.0, 2.0, or 4.0.
 `GL_INVALID_OPERATION' is generated if `glTexEnv' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexGeni
      (coord GLenum)
      (pname GLenum)
@@ -15325,7 +15325,7 @@ PARAMS is `GL_SPHERE_MAP', and COORD is either `GL_R' or `GL_Q'.
 `GL_INVALID_OPERATION' is generated if `glTexGen' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexImage1D
      (target GLenum)
      (level GLint)
@@ -15647,7 +15647,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexImage2D
      (target GLenum)
      (level GLint)
@@ -15996,7 +15996,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexImage3D
      (target GLenum)
      (level GLint)
@@ -16318,7 +16318,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexParameterf
      (target GLenum)
      (pname GLenum)
@@ -16602,7 +16602,7 @@ value (based on the value of PNAME) and does not.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexSubImage1D
      (target GLenum)
      (level GLint)
@@ -16723,7 +16723,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexSubImage2D
      (target GLenum)
      (level GLint)
@@ -16861,7 +16861,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTexSubImage3D
      (target GLenum)
      (level GLint)
@@ -17004,7 +17004,7 @@ indicated by TYPE.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glTranslatef
      (x GLfloat)
      (y GLfloat)
@@ -17038,7 +17038,7 @@ untranslated coordinate system.
 `GL_INVALID_OPERATION' is generated if `glTranslate' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glUniform1f
      (location GLint)
      (v0 GLfloat)
@@ -17192,7 +17192,7 @@ command other than `glUniform1i' and `glUniform1iv'.
 `GL_INVALID_OPERATION' is generated if `glUniform' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glUseProgram (program GLuint) -> void))
   "Installs a program object as part of current rendering state.
 
@@ -17291,7 +17291,7 @@ current state.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glValidateProgram (program GLuint) -> void))
   "Validates a program object.
 
@@ -17330,7 +17330,7 @@ OpenGL.
 between the execution of `glBegin' and the corresponding execution of
 `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glVertexAttribPointer
      (index GLuint)
      (size GLint)
@@ -17408,7 +17408,7 @@ If enabled, the generic vertex attribute array is used when
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glVertexAttrib1f
      (index GLuint)
      (v0 GLfloat)
@@ -17556,7 +17556,7 @@ attributes.
 `GL_INVALID_VALUE' is generated if INDEX is greater than or equal to
 `GL_MAX_VERTEX_ATTRIBS'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glVertexPointer
      (size GLint)
      (type GLenum)
@@ -17614,7 +17614,7 @@ the vertex array is used when `glArrayElement', `glDrawArrays',
 
 `GL_INVALID_VALUE' is generated if STRIDE is negative.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glVertex2i (x GLint) (y GLint) -> void)
    (glVertex2f (x GLfloat) (y GLfloat) -> void)
    (glVertex3i
@@ -17663,7 +17663,7 @@ coordinates, and fog coordinate are associated with the vertex when
 When only X and Y are specified, Z defaults to 0 and W defaults to 1.
 When X , Y , and Z are specified, W defaults to 1.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glViewport
      (x GLint)
      (y GLint)
@@ -17704,7 +17704,7 @@ on the implementation. To query this range, call `glGet' with argument
 `GL_INVALID_OPERATION' is generated if `glViewport' is executed between
 the execution of `glBegin' and the corresponding execution of `glEnd'.")
 
-(define-foreign-procedures
+(define-gl-procedures
   ((glWindowPos2i (x GLint) (y GLint) -> void)
    (glWindowPos2f (x GLfloat) (y GLfloat) -> void)
    (glWindowPos3i
diff --git a/figl/gl/runtime.scm b/figl/gl/runtime.scm
new file mode 100644 (file)
index 0000000..16c966d
--- /dev/null
@@ -0,0 +1,125 @@
+;;; figl
+;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
+;;; 
+;;; Figl is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;; 
+;;; Figl is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+;;; Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; figl is the Foreign Interface to GL.
+;;
+;;; Code:
+
+(define-module (figl gl runtime)
+  #:use-module (system foreign)
+  #:use-module (figl runtime)
+  #:export (current-gl-resolver
+            current-gl-get-dynamic-object
+            define-gl-procedure
+            define-gl-procedures))
+
+(module-use! (module-public-interface (current-module))
+             (resolve-interface '(figl runtime)))
+
+;;
+;; OpenGL and loading.  What a mess.  So, in the beginning, when
+;; Microsoft added support for OpenGL to Windows, they did so via a
+;; trampoline DLL.  This DLL had a fixed number of entry points, and it
+;; was independent of the driver that the graphics card provided.  It
+;; also provided an extension interface, wglGetProcAddress, which could
+;; return additional GL procedures by name.  Microsoft was unwilling to
+;; extend their trampoline DLL for whatever reason, and so on Windows
+;; you always needed to wglGetProcAddress for almost any OpenGL
+;; function.
+;;
+;; Time passed and GLX and other GL implementations started to want
+;; extensions too.  This let application vendors ship applications that
+;; could take advantage of the capabilities of users's graphics cards
+;; without requiring that they be present.
+;;
+;; There are a couple of differences between WGL and GLX, however.
+;; Chiefly, wglGetProcAddress can only be called once you have a
+;; context, and the resulting function can only be used in that context.
+;; In practice it seems that it can be used also in other contexts that
+;; end up referring to that same driver and GPU.  GLX on the other hand
+;; is context-independent, but presence of a function does not mean that
+;; the corresponding functionality is actually available.  In theory
+;; users have to check for the presence of the GL extension or check the
+;; core GL version, depending on whether the interface is an extension
+;; or in GL core.
+;;
+;; Because of this difference between the GLX and WGL semantics, there
+;; is no core "glGetProcAddress" function.  It's terrible: each
+;; windowing system is responsible for providing their own
+;; function-loader interface.
+;;
+;; Finally, Guile needs to load up at least some interfaces using
+;; dynamic-link / dynamic-pointer in order to be able to talk to the
+;; library at all (and to open a context in the case of Windows), and it
+;; happens that these interfaces also work fine for getting some of the
+;; GL functionality!
+;;
+;; All of this mess really has very little place in the world of free
+;; software, where dynamic linking is entirely sufficient to deal with
+;; this issue, but it is how things have evolved.
+;;
+;; In light of all of this, we need to make some simplifications.
+;;
+;; One is that each low-level function will have just one foreign
+;; function wrapper.  This means that a minority of Windows
+;; configurations won't work.  Oh well.
+;;
+;; Another is that if dynamic-link returns a result, that it is assumed
+;; that glXGetProcAddress (or the equivalent) would return the same
+;; value.  So we can try dynamic-link first, and only dispatch to e.g
+;; glXGetProcAddress if that fails.
+;;
+;; Finally, we assume that all GL symbols may be resolved by
+;; dynamic-pointer by looking in one library, regardless of whether they
+;; come from the lower GL level or from the window-system-specific
+;; level.
+;;
+
+;; Parameterize this with glXGetProcAddress, eglGetProcAddress, etc.
+(define current-gl-resolver
+  (make-parameter (lambda (name) %null-pointer)))
+
+;; Parameterize this with a procedure that returns a dynamic object we
+;; can use to get libGL bindings.
+(define current-gl-get-dynamic-object
+  (make-parameter (lambda () (dynamic-link))))
+
+(define (resolve name)
+  (let ((ptr ((current-gl-resolver) (symbol->string name))))
+    (if (null-pointer? ptr)
+        (dynamic-pointer (symbol->string name)
+                         ((current-gl-get-dynamic-object)))
+        ptr)))
+
+(define-syntax define-gl-procedure
+  (syntax-rules (->)
+    ((define-gl-procedure (name (pname ptype) ... -> type)
+       docstring)
+     (define-foreign-procedure (name (pname ptype) ... -> type)
+       (resolve 'name)
+       docstring))))
+
+(define-syntax define-gl-procedures
+  (syntax-rules ()
+    ((define-gl-procedures ((name prototype ...) ...)
+       docstring)
+     (begin
+       (define-gl-procedure (name prototype ...)
+         docstring)
+       ...))))
index f63675d..2b354b9 100644 (file)
@@ -28,7 +28,7 @@
 (define-module
   (figl glu low-level)
   #:use-module
-  (figl runtime)
+  (figl glu runtime)
   #:use-module
   (figl glu types)
   #:export
@@ -92,7 +92,7 @@
     gluUnProject4
     gluUnProject))
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBeginCurve (nurb GLUnurbs*) -> void)
    (gluEndCurve (nurb GLUnurbs*) -> void))
   "Delimit a NURBS curve definition.
@@ -113,7 +113,7 @@ segments. Evaluator state is preserved during rendering with
 `glPushAttrib' reference page for details on exactly what state these
 calls preserve.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBeginPolygon (tess GLUtesselator*) -> void)
    (gluEndPolygon (tess GLUtesselator*) -> void))
   "Delimit a polygon description.
@@ -133,7 +133,7 @@ Once `gluEndPolygon' is called, the polygon is tessellated, and the
 resulting triangles are described through callbacks. See
 `gluTessCallback' for descriptions of the callback functions.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBeginSurface (nurb GLUnurbs*) -> void)
    (gluEndSurface (nurb GLUnurbs*) -> void))
   "Delimit a NURBS surface definition.
@@ -157,7 +157,7 @@ Evaluator state is preserved during rendering with
 `glPushAttrib'(`GLU_EVAL_BIT') and `glPopAttrib'. See the `glPushAttrib'
 reference page for details on exactly what state these calls preserve.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBeginTrim (nurb GLUnurbs*) -> void)
    (gluEndTrim (nurb GLUnurbs*) -> void))
   "Delimit a NURBS trimming loop definition.
@@ -212,7 +212,7 @@ self-intersecting, or intersect one another, an error results.
 If no trimming information is given for a NURBS surface, the entire
 surface is drawn.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild1DMipmapLevels
      (target GLenum)
      (internalFormat GLint)
@@ -347,7 +347,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild1DMipmaps
      (target GLenum)
      (internalFormat GLint)
@@ -470,7 +470,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild2DMipmapLevels
      (target GLenum)
      (internalFormat GLint)
@@ -611,7 +611,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild2DMipmaps
      (target GLenum)
      (internalFormat GLint)
@@ -744,7 +744,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild3DMipmapLevels
      (target GLenum)
      (internalFormat GLint)
@@ -888,7 +888,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluBuild3DMipmaps
      (target GLenum)
      (internalFormat GLint)
@@ -1023,7 +1023,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluCheckExtension
      (extName const-GLubyte-*)
      (extString const-GLubyte-*)
@@ -1045,7 +1045,7 @@ names by passing the extension strings returned by `glGetString',
 `gluGetString', `glXGetClientString', `glXQueryExtensionsString', or
 `glXQueryServerString', respectively, as EXTSTRING.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluCylinder
      (quad GLUquadric*)
      (base GLdouble)
@@ -1092,7 +1092,7 @@ coordinates are generated so that T ranges linearly from 0.0 at Z = 0 to
 +X axis, to 0.5 at the -Y axis, to 0.75 at the \\-X axis, and back to 1.0
 at the +Y axis.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluDeleteNurbsRenderer (nurb GLUnurbs*) -> void))
   "Destroy a NURBS object.
 
@@ -1103,7 +1103,7 @@ NURB
 with `gluNewNurbsRenderer') and frees any memory it uses. Once
 `gluDeleteNurbsRenderer' has been called, NURB cannot be used again.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluDeleteQuadric (quad GLUquadric*) -> void))
   "Destroy a quadrics object.
 
@@ -1114,7 +1114,7 @@ QUAD
 `gluNewQuadric') and frees any memory it uses. Once `gluDeleteQuadric'
 has been called, QUAD cannot be used again.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluDeleteTess (tess GLUtesselator*) -> void))
   "Destroy a tessellation object.
 
@@ -1124,7 +1124,7 @@ TESS
 `gluDeleteTess' destroys the indicated tessellation object (which was
 created with `gluNewTess') and frees any memory that it used.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluDisk
      (quad GLUquadric*)
      (inner GLdouble)
@@ -1167,7 +1167,7 @@ coordinates are generated linearly such that where R=OUTER , the value
 at (R, 0, 0) is (1, 0.5), at (0, R, 0) it is (0.5, 1), at (\\-R, 0, 0) it
 is (0, 0.5), and at (0, \\-R, 0) it is (0.5, 0).")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluErrorString
      (error GLenum)
      ->
@@ -1188,7 +1188,7 @@ functions can return specialized error codes through callbacks. See the
 
 `NULL' is returned if ERROR is not a valid GL or GLU error code.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluGetNurbsProperty
      (nurb GLUnurbs*)
      (property GLenum)
@@ -1216,7 +1216,7 @@ These properties affect the way that NURBS curves and surfaces are
 rendered. See the `gluNurbsProperty' reference page for information
 about what the properties are and what they do.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluGetString (name GLenum) -> const-GLubyte-*))
   "Return a string describing the GLU version or GLU extensions .
 
@@ -1248,7 +1248,7 @@ All strings are null-terminated.
 
 NULL is returned if NAME is not `GLU_VERSION' or `GLU_EXTENSIONS'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluGetTessProperty
      (tess GLUtesselator*)
      (which GLenum)
@@ -1274,7 +1274,7 @@ object. These properties affect the way that tessellation objects are
 interpreted and rendered. See the `gluTessProperty' reference page for
 information about the properties and what they do.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluLoadSamplingMatrices
      (nurb GLUnurbs*)
      (model const-GLfloat-*)
@@ -1311,7 +1311,7 @@ property turned on, there can be a performance penalty for doing so. (A
 round trip to the GL server is needed to fetch the current values of the
 modelview matrix, projection matrix, and viewport.)")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluLookAt
      (eyeX GLdouble)
      (eyeY GLdouble)
@@ -1385,7 +1385,7 @@ and `gluLookAt' is equivalent to
      glMultMatrixf(M);
      glTranslated(-eyex, -eyey, -eyez);")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNewNurbsRenderer -> GLUnurbs*))
   "Create a NURBS object.
 
@@ -1394,7 +1394,7 @@ object. This object must be referred to when calling NURBS rendering and
 control functions. A return value of 0 means that there is not enough
 memory to allocate the object.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNewQuadric -> GLUquadric*))
   "Create a quadrics object.
 
@@ -1403,7 +1403,7 @@ This object must be referred to when calling quadrics rendering and
 control functions. A return value of 0 means that there is not enough
 memory to allocate the object.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNewTess -> GLUtesselator*))
   "Create a tessellation object.
 
@@ -1412,7 +1412,7 @@ This object must be referred to when calling tessellation functions. A
 return value of 0 means that there is not enough memory to allocate the
 object.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNextContour
      (tess GLUtesselator*)
      (type GLenum)
@@ -1473,7 +1473,7 @@ This command is obsolete and is provided for backward compatibility
 only. Calls to `gluNextContour' are mapped to `gluTessEndContour'
 followed by `gluTessBeginContour'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsCallbackDataEXT
      (nurb GLUnurbs*)
      (userData GLvoid*)
@@ -1491,7 +1491,7 @@ USERDATA
 data to NURBS tessellator. A copy of this pointer will be passed by the
 tessellator in the NURBS callback functions (set by `gluNurbsCallback').")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsCallbackData
      (nurb GLUnurbs*)
      (userData GLvoid*)
@@ -1509,7 +1509,7 @@ USERDATA
 data to NURBS tessellator. A copy of this pointer will be passed by the
 tessellator in the NURBS callback functions (set by `gluNurbsCallback').")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsCallback
      (nurb GLUnurbs*)
      (which GLenum)
@@ -1720,7 +1720,7 @@ The legal callbacks are as follows:
      
      void endData( void  *userData );")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsCurve
      (nurb GLUnurbs*)
      (knotCount GLint)
@@ -1782,7 +1782,7 @@ curve in two-dimensional homogeneous (U, V, and W) parameter space. See
 the `gluBeginTrim' reference page for more discussion about trimming
 curves.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsProperty
      (nurb GLUnurbs*)
      (property GLenum)
@@ -1924,7 +1924,7 @@ The accepted values for PROPERTY are as follows:
      from `GLU_TRUE' to `GLU_FALSE' does not affect the sampling and
      culling matrices until `gluLoadSamplingMatrices' is called.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluNurbsSurface
      (nurb GLUnurbs*)
      (sKnotCount GLint)
@@ -2011,7 +2011,7 @@ and TKNOTCOUNT knots in the V direction with orders SORDER and TORDER
 must have (SKNOTCOUNT - SORDER) TIMES (TKNOTCOUNT - TORDER) control
 points.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluOrtho2D
      (left GLdouble)
      (right GLdouble)
@@ -2036,7 +2036,7 @@ BOTTOM
 `gluOrtho2D' sets up a two-dimensional orthographic viewing region. This
 is equivalent to calling `glOrtho' with NEAR=-1 and FAR=1 .")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluPartialDisk
      (quad GLUquadric*)
      (inner GLdouble)
@@ -2093,7 +2093,7 @@ coordinates are generated linearly such that where R=OUTER , the value
 at (R, 0, 0) is (1.0, 0.5), at (0, R, 0) it is (0.5, 1.0), at (\\-R, 0,
 0) it is (0.0, 0.5), and at (0, \\-R, 0) it is (0.5, 0.0).")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluPerspective
      (fovy GLdouble)
      (aspect GLdouble)
@@ -2138,7 +2138,7 @@ F=COTANGENT\u2061(FOVY/2,) The generated matrix is
 ((F/ASPECT 0 0 0), (0 F 0 0), (0 0 ZFAR+ZNEAR,/ZNEAR-ZFAR,
 2×ZFAR×ZNEAR,/ZNEAR-ZFAR,), (0 0 -1 0),)")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluPickMatrix
      (x GLdouble)
      (y GLdouble)
@@ -2184,7 +2184,7 @@ turned off, then any NURBS surface rendered is subdivided differently
 with the pick matrix than the way it was subdivided without the pick
 matrix.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluProject
      (objX GLdouble)
      (objY GLdouble)
@@ -2244,7 +2244,7 @@ The window coordinates are then computed as follows:
 WINX=VIEW\u2061(0,)+VIEW\u2061(2,)×(V^″\u2061(0,)+1,)/2
 WINY=VIEW\u2061(1,)+VIEW\u2061(3,)×(V^″\u2061(1,)+1,)/2 WINZ=(V^″\u2061(2,)+1,)/2")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluPwlCurve
      (nurb GLUnurbs*)
      (count GLint)
@@ -2286,7 +2286,7 @@ then it describes a curve in two-dimensional homogeneous (U, V, and W)
 parameter space. See the `gluBeginTrim' reference page for more
 information about trimming curves.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluQuadricCallback
      (quad GLUquadric*)
      (which GLenum)
@@ -2318,7 +2318,7 @@ The one legal callback is `GLU_ERROR':
      that occurred. Character strings describing these errors can be
      retrieved with the `gluErrorString' call.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluQuadricDrawStyle
      (quad GLUquadric*)
      (draw GLenum)
@@ -2351,7 +2351,7 @@ with QUAD. The legal values are as follows:
 `GLU_POINT'
      Quadrics are rendered as a set of points.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluQuadricNormals
      (quad GLUquadric*)
      (normal GLenum)
@@ -2379,7 +2379,7 @@ quadrics rendered with QUAD. The legal values are as follows:
      One normal is generated for every vertex of a quadric. This is the
      initial value.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluQuadricOrientation
      (quad GLUquadric*)
      (orientation GLenum)
@@ -2407,7 +2407,7 @@ for quadrics rendered with QUAD. The ORIENTATION values are as follows:
 Note that the interpretation of OUTWARD and INWARD depends on the
 quadric being drawn.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluQuadricTexture
      (quad GLUquadric*)
      (texture GLboolean)
@@ -2430,7 +2430,7 @@ they are not. The initial value is `GLU_FALSE'.
 The manner in which texture coordinates are generated depends upon the
 specific quadric rendered.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluScaleImage
      (format GLenum)
      (wIn GLsizei)
@@ -2538,7 +2538,7 @@ is neither `GLU_RGBA' nor `GLU_BGRA'.
 `GLU_UNSIGNED_INT_10_10_10_2' or `GLU_UNSIGNED_INT_2_10_10_10_REV' and
 FORMAT is neither `GLU_RGBA' nor `GLU_BGRA'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluSphere
      (quad GLUquadric*)
      (radius GLdouble)
@@ -2577,7 +2577,7 @@ at Z=RADIUS (T increases linearly along longitudinal lines), and S
 ranges from 0.0 at the +Y axis, to 0.25 at the +X axis, to 0.5 at the
 \\-Y axis, to 0.75 at the \\-X axis, and back to 1.0 at the +Y axis.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessBeginContour
      (tess GLUtesselator*)
      ->
@@ -2596,7 +2596,7 @@ automatically linked to the first). See the `gluTessVertex' reference
 page for more details. `gluTessBeginContour' can only be called between
 `gluTessBeginPolygon' and `gluTessEndPolygon'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessBeginPolygon
      (tess GLUtesselator*)
      (data GLvoid*)
@@ -2629,7 +2629,7 @@ Once `gluTessEndPolygon' is called, the polygon is tessellated, and the
 resulting triangles are described through callbacks. See
 `gluTessCallback' for descriptions of the callback functions.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessCallback
      (tess GLUtesselator*)
      (which GLenum)
@@ -2850,7 +2850,7 @@ was called. The legal callbacks are as follows:
      
      void errorData( GLenum errno, void *polygon_data );")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessEndPolygon (tess GLUtesselator*) -> void))
   "Delimit a polygon description.
 
@@ -2871,7 +2871,7 @@ Once `gluTessEndPolygon' is called, the polygon is tessellated, and the
 resulting triangles are described through callbacks. See
 `gluTessCallback' for descriptions of the callback functions.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessNormal
      (tess GLUtesselator*)
      (valueX GLdouble)
@@ -2914,7 +2914,7 @@ input contours is nonnegative (where a CCW contour has positive area).
 The supplied normal persists until it is changed by another call to
 `gluTessNormal'.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessProperty
      (tess GLUtesselator*)
      (which GLenum)
@@ -2993,7 +2993,7 @@ interpreted and rendered. The legal values for WHICH are as follows:
      distinguish which side of the edge the vertex lies on. Two edges
      are merged only when both endpoints are identical.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluTessVertex
      (tess GLUtesselator*)
      (location GLdouble-*)
@@ -3024,7 +3024,7 @@ pointer is passed back to the user through the `GLU_TESS_VERTEX' or
 `GLU_TESS_VERTEX_DATA' callback after tessellation (see the
 `gluTessCallback' reference page).")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluUnProject4
      (winX GLdouble)
      (winY GLdouble)
@@ -3099,7 +3099,7 @@ INV denotes matrix inversion.
 `gluUnProject4' is equivalent to `gluUnProject' when CLIPW is 1, NEARVAL
 is 0, and FARVAL is 1.")
 
-(define-foreign-procedures
+(define-glu-procedures
   ((gluUnProject
      (winX GLdouble)
      (winY GLdouble)
diff --git a/figl/glu/runtime.scm b/figl/glu/runtime.scm
new file mode 100644 (file)
index 0000000..f50884a
--- /dev/null
@@ -0,0 +1,50 @@
+;;; figl
+;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
+;;; 
+;;; Figl is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;; 
+;;; Figl is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+;;; Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; figl is the Foreign Interface to GL.
+;;
+;;; Code:
+
+(define-module (figl glu runtime)
+  #:use-module (system foreign)
+  #:use-module (figl runtime)
+  #:export (define-glu-procedure define-glu-procedures))
+
+(define libGLU
+  (delay (dynamic-link "libGLU")))
+
+(define (resolve name)
+  (dynamic-pointer (symbol->string name) (force libGLU)))
+
+(define-syntax define-glu-procedure
+  (syntax-rules (->)
+    ((define-glu-procedure (name (pname ptype) ... -> type)
+       docstring)
+     (define-foreign-procedure (name (pname ptype) ... -> type)
+       (resolve 'name)
+       docstring))))
+
+(define-syntax define-glu-procedures
+  (syntax-rules ()
+    ((define-glu-procedures ((name prototype ...) ...)
+       docstring)
+     (begin
+       (define-glu-procedure (name prototype ...)
+         docstring)
+       ...))))
index 786da99..8f87dbb 100644 (file)
@@ -27,6 +27,7 @@
 
 (define-module (figl glut low-level)
   #:use-module (figl runtime)
+  #:use-module (figl glut runtime)
   #:use-module (figl gl types)
   #:use-module ((system foreign) #:renamer (symbol-prefix-proc 'ffi:))
   #:use-module (srfi srfi-26) ; cut
             glutWireTeapot
             ))
 
-(define libglut (dynamic-link "libglut"))
-
-(define (glut-resolver name)
-  (dynamic-pointer name libglut))
-
-(current-resolver glut-resolver)
-
 (define-simple-foreign-type int ffi:int)
 (define-simple-foreign-type unsigned-int ffi:unsigned-int)
 
 ;;; 2 Initialization
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutInit (argcp int-*) (argv char-**) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutInitWindowPosition (x int) (y int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutInitWindowSize (width int) (height int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutInitDisplayMode (mode unsigned-int) -> void)
   #f)
 
 ;;; 3 Begin Event Processing
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutMainLoop -> void)
   #f)
 
 ;;; 4 Window Management
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutCreateWindow (name char-*) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutCreateSubWindow (win int)
                        (x int)
                        (y int)
                        int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetWindow (win int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutGetWindow -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDestroyWindow (win int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPostRedisplay -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSwapBuffers -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPositionWindow (x int) (y int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutReshapeWindow (width int) (height int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutFullScreen -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPopWindow -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPushWindow -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutShowWindow -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutHideWindow -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutIconifyWindow -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetWindowTitle (name char-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetIconTitle (name char-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetCursor (cursor int) -> void)
   #f)
 
 ;;; 5 Overlay Management
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutEstablishOverlay -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutUseLayer (layer GLenum) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutRemoveOverlay -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPostOverlayRedisplay -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutShowOverlay -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutHideOverlay -> void)
   #f)
 
 ;;; 6 Menu Management
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutCreateMenu (func void-*) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetMenu (menu int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutGetMenu -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDestroyMenu (menu int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutAddMenuEntry (name char-*) (value int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutAddSubMenu (name char-*) (menu int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutChangeToMenuEntry (entry int)
                          (name char-*)
                          (value int)
                          void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutChangeToSubMenu (entry int)
                        (name char-*)
                        (menu int)
                        void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutRemoveMenuItem (entry int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutAttachMenu (button int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDetachMenu (button int) -> void)
   #f)
 
 ;;; 7 Callback Registration
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDisplayFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutOverlayDisplayFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutReshapeFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutKeyboardFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutMouseFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutMotionFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutPassiveMotionFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutVisibilityFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutEntryFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSpecialFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSpaceballMotionFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSpaceballRotateFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSpaceballButtonFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutButtonBoxFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDialsFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutTabletMotionFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutTabletButtonFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutMenuStatusFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutMenuStateFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutIdleFunc (func void-*) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutTimerFunc (msecs unsigned-int)
                  (func void-*)
                  (value int)
 ;;; 8 Color Index Colormap Management
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSetColor (cell int)
                 (red GLfloat)
                 (green GLfloat)
                 void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutGetColor (cell int) (component int) -> GLfloat)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutCopyColormap (win int) -> void)
   #f)
 
 ;;; 9 State Retrieval
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutGet (state GLenum) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutLayerGet (info GLenum) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutDeviceGet (info GLenum) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutGetModifiers -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutExtensionSupported (extension char-*) -> int)
   #f)
 
 ;;; 10 Font Rendering
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutBitmapCharacter (font void-*) (character int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutBitmapWidth (font void-*) (character int) -> int)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutStrokeCharacter (font void-*) (character int) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutStrokeWidth (font void-*) (character int) -> void)
   #f)
 
 ;;; 11 Geometric Object Rendering
 ;;;
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidSphere (radius GLdouble)
                    (slices GLint)
                    (stacks GLint)
                    void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireSphere (radius GLdouble)
                   (slices GLint)
                   (stacks GLint)
                   void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidCube (size GLdouble) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireCube (size GLdouble) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidCone (base GLdouble)
                  (height GLdouble)
                  (slices GLint)
                  void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireCone (base GLdouble)
                 (height GLdouble)
                 (slices GLint)
                 void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidTorus (inner-radius GLdouble)
                   (outer-radius GLdouble)
                   (sides GLint)
                   void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireTorus (inner-radius GLdouble)
                  (outer-radius GLdouble)
                  (sides GLint)
                  void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidDodecahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireDodecahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidOctahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireOctahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidTetrahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireTetrahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidIcosahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireIcosahedron -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutSolidTeapot (size GLdouble) -> void)
   #f)
 
-(define-foreign-procedure
+(define-glut-procedure
   (glutWireTeapot (size GLdouble) -> void)
   #f)
diff --git a/figl/glut/runtime.scm b/figl/glut/runtime.scm
new file mode 100644 (file)
index 0000000..3f7d3a3
--- /dev/null
@@ -0,0 +1,56 @@
+;;; figl
+;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
+;;; 
+;;; Figl is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;; 
+;;; Figl is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+;;; Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; figl is the Foreign Interface to GL.
+;;
+;;; Code:
+
+(define-module (figl glut runtime)
+  #:use-module (system foreign)
+  #:use-module (figl runtime)
+  #:use-module (figl gl runtime)
+  #:export (define-glut-procedure define-glut-procedures))
+
+(define libglut
+  (delay (dynamic-link "libglut")))
+
+(define (get-libglut)
+  (force libglut))
+
+(current-gl-get-dynamic-object get-libglut)
+
+(define (resolve name)
+  (dynamic-pointer (symbol->string name) (get-libglut)))
+
+(define-syntax define-glut-procedure
+  (syntax-rules (->)
+    ((define-glut-procedure (name (pname ptype) ... -> type)
+       docstring)
+     (define-foreign-procedure (name (pname ptype) ... -> type)
+       (resolve 'name)
+       docstring))))
+
+(define-syntax define-glut-procedures
+  (syntax-rules ()
+    ((define-glut-procedures ((name prototype ...) ...)
+       docstring)
+     (begin
+       (define-glut-procedure (name prototype ...)
+         docstring)
+       ...))))
index 81504dc..bc45cad 100644 (file)
   #:use-module (figl runtime)
   #:use-module (figl glx low-level))
 
-(define libGL
-  (delay (dynamic-link "libGL")))
-
-(define glXGetProcAddress
-  (delay (pointer->procedure
-          '*
-          (dynamic-pointer "glXGetProcAddress" (force libGL))
-          '(*))))
-
-(define (glx-resolver name)
-  ((force glXGetProcAddress) (string->pointer name)))
-
-(current-resolver glx-resolver)
index 85f54fb..50517ab 100644 (file)
@@ -28,7 +28,7 @@
 (define-module
   (figl glx low-level)
   #:use-module
-  (figl runtime)
+  (figl glx runtime)
   #:use-module
   (figl glx types)
   #:export
@@ -76,7 +76,7 @@
     glXWaitGL
     glXWaitX))
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXChooseFBConfig
      (dpy Display-*)
      (screen int)
@@ -421,7 +421,7 @@ lower numbered rule are sorted by the higher numbered rule):
 ATTRIB_LIST, if SCREEN is invalid, or if DPY does not support the GLX
 extension.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXChooseVisual
      (dpy Display-*)
      (screen int)
@@ -558,7 +558,7 @@ The interpretations of the various GLX visual attributes are as follows:
 `NULL' is returned if an undefined GLX attribute is encountered in
 ATTRIBLIST.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCopyContext
      (dpy Display-*)
      (src GLXContext)
@@ -614,7 +614,7 @@ current drawable is a window that is no longer valid.
 `GLXBadContext' is generated if either SRC or DST is not a valid GLX
 context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreateContext
      (dpy Display-*)
      (vis XVisualInfo-*)
@@ -685,7 +685,7 @@ not `NULL'.
 `BadAlloc' is generated if the server does not have enough resources to
 allocate the new context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreateGLXPixmap
      (dpy Display-*)
      (vis XVisualInfo-*)
@@ -733,7 +733,7 @@ visual).
 
 `BadAlloc' is generated if the server cannot allocate the GLX pixmap.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreateNewContext
      (dpy Display-*)
      (config GLXFBConfig)
@@ -810,7 +810,7 @@ allocate the new context.
 `BadValue' is generated if CONFIG is not a valid visual (for example, if
 a particular GLX implementation does not support it).")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreatePbuffer
      (dpy Display-*)
      (config GLXFBConfig)
@@ -878,7 +878,7 @@ the requested GLXPbuffer.
 `BadMatch' is generated if CONFIG does not support rendering to pixel
 buffers (e.g., `GLX_DRAWABLE_TYPE' does not contain `GLX_PBUFFER_BIT').")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreatePixmap
      (dpy Display-*)
      (config GLXFBConfig)
@@ -921,7 +921,7 @@ window.
 
 `GLXBadFBConfig' is generated if CONFIG is not a valid GLXFBConfig.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXCreateWindow
      (dpy Display-*)
      (config GLXFBConfig)
@@ -968,7 +968,7 @@ window.
 
 `GLXBadFBConfig' is generated if CONFIG is not a valid GLXFBConfig.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXDestroyContext
      (dpy Display-*)
      (ctx GLXContext)
@@ -989,7 +989,7 @@ ID referenced by CTX is freed immediately.
 
 `GLXBadContext' is generated if CTX is not a valid GLX context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXDestroyGLXPixmap
      (dpy Display-*)
      (pix GLXPixmap)
@@ -1010,7 +1010,7 @@ resource ID is freed immediately.
 
 `GLXBadPixmap' is generated if PIX is not a valid GLX pixmap.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXDestroyPbuffer
      (dpy Display-*)
      (pbuf GLXPbuffer)
@@ -1028,7 +1028,7 @@ PBUF
 
 `GLXBadPbuffer' is generated if PBUF is not a valid GLXPbuffer.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXDestroyPixmap
      (dpy Display-*)
      (pixmap GLXPixmap)
@@ -1046,7 +1046,7 @@ PIXMAP
 
 `GLXBadPixmap' is generated if PIXMAP is not a valid GLXPixmap.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXDestroyWindow
      (dpy Display-*)
      (win GLXWindow)
@@ -1064,7 +1064,7 @@ WIN
 
 `GLXBadWindow' is generated if WIN is not a valid GLXPixmap.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXFreeContextEXT
      (dpy Display-*)
      (ctx GLXContext)
@@ -1091,7 +1091,7 @@ supported.
 
 `GLXBadContext' is generated if CTX does not refer to a valid context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetClientString
      (dpy Display-*)
      (name int)
@@ -1124,7 +1124,7 @@ Both the major and minor portions of the version number are of arbitrary
 length. The vendor-specific information is optional. However, if it is
 present, the format and contents are implementation specific.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetConfig
      (dpy Display-*)
      (vis XVisualInfo-*)
@@ -1259,7 +1259,7 @@ a screen.
 `GLX_BAD_VISUAL' is returned if VIS doesn't support GLX and an attribute
 other than `GLX_USE_GL' is requested.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetContextIDEXT
      (ctx const-GLXContext)
      ->
@@ -1282,7 +1282,7 @@ supported.
 
 `GLXBadContext' is generated if CTX does not refer to a valid context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetCurrentContext -> GLXContext))
   "Return the current context.
 
@@ -1292,7 +1292,7 @@ supported.
 `glXGetCurrentContext' returns client-side information. It does not make
 a round trip to the server.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetCurrentDisplay -> Display-*))
   "Get display for current context.
 
@@ -1303,7 +1303,7 @@ no context is current, `NULL' is returned.
 a round-trip to the server, and therefore does not flush any pending
 events.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetCurrentDrawable -> GLXDrawable))
   "Return the current drawable.
 
@@ -1313,7 +1313,7 @@ events.")
 `glXGetCurrentDrawable' returns client-side information. It does not
 make a round trip to the server.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetCurrentReadDrawable -> GLXDrawable))
   "Return the current drawable.
 
@@ -1324,7 +1324,7 @@ current drawable, `None' is returned.
 `glXGetCurrentReadDrawable' returns client-side information. It does not
 make a round-trip to the server.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetFBConfigAttrib
      (dpy Display-*)
      (config GLXFBConfig)
@@ -1573,7 +1573,7 @@ performance as well as poor resource allocation.
 extension. `GLX_BAD_ATTRIBUTE' is returned if ATTRIBUTE is not a valid
 GLX attribute.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetFBConfigs
      (dpy Display-*)
      (screen int)
@@ -1595,7 +1595,7 @@ NELEMENTS
 screen specified by SCREEN. Use `glXGetFBConfigAttrib' to obtain
 attribute values from a specific GLXFBConfig.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetProcAddress
      (procName const-GLubyte-*)
      ->
@@ -1610,7 +1610,7 @@ PROCNAME
 PROCNAME. This is necessary in environments where the OpenGL link
 library exports a different set of functions than the runtime library.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetSelectedEvent
      (dpy Display-*)
      (draw GLXDrawable)
@@ -1634,7 +1634,7 @@ DRAW.
 `GLXBadDrawable' is generated if DRAW is not a valid window or a valid
 GLX pixel buffer.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXGetVisualFromFBConfig
      (dpy Display-*)
      (config GLXFBConfig)
@@ -1655,7 +1655,7 @@ returned.
 
 Returns `NULL' if CONFIG is not a valid GLXFBConfig.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXImportContextEXT
      (dpy Display-*)
      (contextID GLXContextID)
@@ -1698,7 +1698,7 @@ supported.
 `GLXBadContext' is generated if CONTEXTID does not refer to a valid
 context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXIsDirect
      (dpy Display-*)
      (ctx GLXContext)
@@ -1720,7 +1720,7 @@ rendering commands to the X server.
 
 `GLXBadContext' is generated if CTX is not a valid GLX context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXMakeContextCurrent
      (display Display-*)
      (draw GLXDrawable)
@@ -1810,7 +1810,7 @@ or GLXPbuffer.
 DRAW or READ is a GLXWindow or GLXPbuffer and CTX was previously bound
 to a GLXPixmap.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXMakeCurrent
      (dpy Display-*)
      (drawable GLXDrawable)
@@ -1880,7 +1880,7 @@ longer valid.
 ancillary buffers until `glXMakeCurrent' is called, only to find that it
 has insufficient resources to complete the allocation.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryContextInfoEXT
      (dpy Display-*)
      (ctx GLXContext)
@@ -1935,7 +1935,7 @@ attribute.
 
 fred `GLX_BAD_CONTEXT' is returned if ATTRIBUTE is not a valid context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryContext
      (dpy Display-*)
      (ctx GLXContext)
@@ -1977,7 +1977,7 @@ This call may cause a round-trip to the server.
 
 `GLXBadContext' is generated if CTX does not refer to a valid context.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryDrawable
      (dpy Display-*)
      (draw GLXDrawable)
@@ -2035,7 +2035,7 @@ above, the contents of VALUE are unedfined.
 
 A `GLXBadDrawable' is generated if DRAW is not a valid GLXDrawable.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryExtensionsString
      (dpy Display-*)
      (screen int)
@@ -2055,7 +2055,7 @@ null-terminated and contains a space-separated list of extension names.
 (The extension names themselves never contain spaces.) If there are no
 extensions to GLX, then the empty string is returned.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryExtension
      (dpy Display-*)
      (errorBase int-*)
@@ -2083,7 +2083,7 @@ ERRORBASE and EVENTBASE are unchanged.
 ERRORBASE and EVENTBASE do not return values if they are specified as
 `NULL'.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryServerString
      (dpy Display-*)
      (screen int)
@@ -2108,7 +2108,7 @@ possible values for NAME and the format of the strings is the same as
 for `glXGetClientString'. If NAME is not set to a recognized value,
 `NULL' is returned.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXQueryVersion
      (dpy Display-*)
      (major int-*)
@@ -2138,7 +2138,7 @@ MAJOR and MINOR do not return values if they are specified as `NULL'.
 
 MAJOR and MINOR are not updated when `False' is returned.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXSelectEvent
      (dpy Display-*)
      (draw GLXDrawable)
@@ -2270,7 +2270,7 @@ portions of those buffers\\(emwere affected.
 `GLXBadDrawable' is generated if DRAW is not a valid window or a valid
 GLX pixel buffer.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXSwapBuffers
      (dpy Display-*)
      (drawable GLXDrawable)
@@ -2305,7 +2305,7 @@ the display and drawable associated with the current context of the
 calling thread, and DRAWABLE identifies a window that is no longer
 valid.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXUseXFont
      (font Font)
      (first int)
@@ -2355,7 +2355,7 @@ display-list construction mode.
 current context of the calling thread is a window, and that window is no
 longer valid.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXWaitGL -> void))
   "Complete GL execution prior to subsequent X calls.
 
@@ -2371,7 +2371,7 @@ in cases where client and server are on separate machines.
 current context of the calling thread is a window, and that window is no
 longer valid.")
 
-(define-foreign-procedures
+(define-glx-procedures
   ((glXWaitX -> void))
   "Complete X execution prior to subsequent GL calls.
 
diff --git a/figl/glx/runtime.scm b/figl/glx/runtime.scm
new file mode 100644 (file)
index 0000000..342688f
--- /dev/null
@@ -0,0 +1,68 @@
+;;; figl
+;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
+;;; 
+;;; Figl is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;; 
+;;; Figl is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
+;;; Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; figl is the Foreign Interface to GL.
+;;
+;;; Code:
+
+(define-module (figl glx runtime)
+  #:use-module (system foreign)
+  #:use-module (figl gl types)
+  #:use-module (figl gl runtime)
+  #:use-module (figl runtime)
+  #:export (define-glx-procedure define-glx-procedures))
+
+(define libGL
+  (delay (dynamic-link "libGL")))
+
+(define (get-libGL)
+  (force libGL))
+
+(define (dladdr-resolve name)
+  (dynamic-pointer (symbol->string name) (get-libGL)))
+
+(define-foreign-procedure (glx-resolve (name const-GLchar-*) -> void-*)
+  (dladdr-resolve 'glXGetProcAddress)
+  "The GLX resolver.")
+
+(current-gl-resolver glx-resolve)
+(current-gl-get-dynamic-object get-libGL)
+
+(define (resolve name)
+  (let ((ptr (glx-resolve (symbol->string name))))
+    (if (null-pointer? ptr)
+        (dladdr-resolve name)
+        ptr)))
+
+(define-syntax define-glx-procedure
+  (syntax-rules (->)
+    ((define-glx-procedure (name (pname ptype) ... -> type)
+       docstring)
+     (define-foreign-procedure (name (pname ptype) ... -> type)
+       (resolve 'name)
+       docstring))))
+
+(define-syntax define-glx-procedures
+  (syntax-rules ()
+    ((define-glx-procedures ((name prototype ...) ...)
+       docstring)
+     (begin
+       (define-glx-procedure (name prototype ...)
+         docstring)
+       ...))))
index 86022d5..fbb0c09 100644 (file)
 
 (define-module (figl runtime)
   #:use-module (system foreign)
-  #:export (current-resolver
-            define-foreign-procedure
+  #:export (define-foreign-procedure
             define-foreign-procedures
             define-foreign-type
             define-simple-foreign-type))
 
-;;
-;; OpenGL and loading.  What a mess.  So, in the beginning, when
-;; Microsoft added support for OpenGL to Windows, they did so via a
-;; trampoline DLL.  This DLL had a fixed number of entry points, and it
-;; was independent of the driver that the graphics card provided.  It
-;; also provided an extension interface, wglGetProcAddress, which could
-;; return additional GL procedures by name.  Microsoft was unwilling to
-;; extend their trampoline DLL for whatever reason, and so on Windows
-;; you always needed to wglGetProcAddress for almost any OpenGL
-;; function.
-;;
-;; Time passed and GLX and other GL implementations started to want
-;; extensions too.  This let application vendors ship applications that
-;; could take advantage of the capabilities of users's graphics cards
-;; without requiring that they be present.
-;;
-;; There are a couple of differences between WGL and GLX, however.
-;; Chiefly, wglGetProcAddress can only be called once you have a
-;; context, and the resulting function can only be used in that context.
-;; In practice it seems that it can be used also in other contexts that
-;; end up referring to that same driver and GPU.  GLX on the other hand
-;; is context-independent, but presence of a function does not mean that
-;; the corresponding functionality is actually available.  In theory
-;; users have to check for the presence of the GL extension or check the
-;; core GL version, depending on whether the interface is an extension
-;; or in GL core.
-;;
-;; Because of this difference between the GLX and WGL semantics, there
-;; is no core "glGetProcAddress" function.  It's terrible: each
-;; windowing system is responsible for providing their own
-;; function-loader interface.
-;;
-;; Finally, Guile needs to load up at least some interfaces using
-;; dynamic-link / dynamic-pointer in order to be able to talk to the
-;; library at all (and to open a context in the case of Windows), and it
-;; happens that these interfaces also work fine for getting some of the
-;; GL functionality!
-;;
-;; All of this mess really has very little place in the world of free
-;; software, where dynamic linking is entirely sufficient to deal with
-;; this issue, but it is how things have evolved.
-;;
-;; In light of all of this, we need to make some simplifications.
-;;
-;; One is that each low-level function will have just one foreign
-;; function wrapper.  This means that a minority of Windows
-;; configurations won't work.  Oh well.
-;;
-;; Another is that if dynamic-link returns a result, that it is assumed
-;; that glXGetProcAddress (or the equivalent) would return the same
-;; value.  So we can try dynamic-link first, and only dispatch to e.g
-;; glXGetProcAddress if that fails.
-;;
-;; Finally, we assume that all GL symbols may be resolved by
-;; dynamic-pointer by looking in one library, regardless of whether they
-;; come from the lower GL level or from the window-system-specific
-;; level.
-;;
-
-;; FIXME: adapt implementation to match!
-(define (default-resolver name)
-  (dynamic-pointer name (dynamic-link)))
-
-(define current-resolver
-  (make-parameter default-resolver))
-
-(define (resolve name)
-  ((current-resolver) name))
-
 (define-syntax foreign-trampoline
-  (lambda (stx)
-    (syntax-case stx (->)
-      ((_ trampoline
-          name (pname ptype) ... -> type)
-       (with-syntax ((sname (symbol->string (syntax->datum #'name))))
-         #'(lambda (pname ...)
-             (let ((ptr (resolve sname)))
-               (set! trampoline
-                     (pointer->procedure (type)
-                                         ptr
-                                         (list (ptype) ...)))
-               (trampoline pname ...))))))))
+  (syntax-rules (->)
+    ((_ trampoline resolve-name (pname ptype) ... -> type)
+     (lambda (pname ...)
+       (set! trampoline
+             (pointer->procedure (type)
+                                 resolve-name
+                                 (list (ptype) ...)))
+       (trampoline pname ...)))))
 
 (define-syntax define-foreign-procedure
   (syntax-rules (->)
     ((define-foreign-procedure (name (pname ptype) ... -> type)
+       resolve-name
        docstring)
      (define name
        (letrec ((trampoline
-                 (foreign-trampoline trampoline
-                                     name (pname ptype) ... -> type))
+                 (foreign-trampoline trampoline resolve-name
+                                     (pname ptype) ... -> type))
                 (name (lambda (pname ...)
                         docstring
                         (let ((pname (ptype #:unwrap pname))
 (define-syntax define-foreign-procedures
   (syntax-rules ()
     ((define-foreign-procedures ((name prototype ...) ...)
+       resolve-name
        docstring)
      (begin
        (define-foreign-procedure (name prototype ...)
+         resolve-name
          docstring)
        ...))))
 
index d3fbe99..5764bc2 100755 (executable)
@@ -84,7 +84,7 @@
   (newline port)
   (pretty-print
    `(define-module (figl ,mod-name low-level)
-      #:use-module (figl runtime)
+      #:use-module (figl ,mod-name runtime)
       #:use-module (figl ,mod-name types)
       #:export ,(append-map (lambda (def)
                               (map car (gl-definition-prototypes def)))
   (for-each
    (lambda (def)
      (pretty-print
-      `(define-foreign-procedures ,(gl-definition-prototypes def)
-         ,(string-trim-both
-           (stexi->plain-text
-            (gl-definition-documentation def))))
+      `(,(symbol-append 'define- mod-name '-procedures)
+        ,(gl-definition-prototypes def)
+        ,(string-trim-both
+          (stexi->plain-text
+           (gl-definition-documentation def))))
       port)
      (newline port))
    defs))