gl: Add gl:display, gl:cull-face, gl:color-material, gl:scale...

gl:scaled should have been gl:scale.

diff --git a/src/gl/gl.cdecl b/src/gl/gl.cdecl
index 5794d2b17c7e3ba926c58b1d0bbf49afc7db1824..946cefca72d01ee4673aacda7d5b9e01cec34ef1 100644 (file)
--- a/src/gl/gl.cdecl
+++ b/src/gl/gl.cdecl
@@ -41,19 +41,31 @@ USA.
 (extern void glClearDepth (depth GLdouble))
 
 (extern void glEnable (cap GLenum))
+(extern void glDisable (cap GLenum))
 
 (enum (GL_DEPTH_TEST))
+(enum (GL_COLOR_MATERIAL))
 
 (extern void glDepthFunc (func GLenum))
 
 (enum (GL_LEQUAL))
 
+(extern void glCullFace (mode GLenum))
+
+(enum (GL_FRONT)
+      (GL_FRONT_AND_BACK)
+      (GL_BACK))
+
 (extern void glHint (target GLenum) (mode GLenum))
 
 (enum (GL_PERSPECTIVE_CORRECTION_HINT))
 
 (enum (GL_NICEST))
 
+(extern void glColorMaterial (face GLenum) (mode GLenum))
+
+(enum (GL_DIFFUSE))
+
 (extern void glClear (mask GLbitfield))
 
 (enum (GL_COLOR_BUFFER_BIT)
@@ -92,6 +104,7 @@ USA.
 (extern void gl_material (face GLenum) (pname GLenum) (params SCM))
 
 (extern void glMatrixMode (mode GLenum))
+(enum (GL_PROJECTION) (GL_MODELVIEW))
 
 (extern void glNewList (list GLuint) (mode GLenum))
 
@@ -120,10 +133,7 @@ USA.
       (GL_BACK_RIGHT)
       (GL_BACK_LEFT)
       (GL_POSITION)
-      (GL_FRONT)
       (GL_AMBIENT_AND_DIFFUSE)
-      (GL_PROJECTION)
-      (GL_MODELVIEW)
       (GL_COMPILE)
       (GL_FLAT))
 \f

diff --git a/src/gl/gl.pkg b/src/gl/gl.pkg
index 80bf1b3abcb0878e8c472bdf98a564e414a405df..4dc0e189a8d0bc0e242d08144077ad7ff5f75ab0 100644 (file)
--- a/src/gl/gl.pkg
+++ b/src/gl/gl.pkg
@@ -39,12 +39,15 @@ USA.
          gl:clear-color
          gl:clear-depth
          gl:enable
+         gl:disable
          gl:depth-func
+         gl:cull-face
          gl:hint
+         gl:color-material
          gl:clear
          gl:load-identity
          glu:look-at
-         gl:scaled
+         gl:scale
          gl:begin
          gl:color
          gl:vertex
@@ -82,6 +85,10 @@ USA.
   (import (gtk)
          add-gc-cleanup punt-gc-cleanup error-if-null
          gobject-alien gtk-window-new
+         gtk-widget-destroy gtk-widget-parent
+         gtk-widget-show-all
+         gtk-widget-queue-draw
+         set-gtk-widget-draw-callback!
          gtk-window-set-opacity
          gtk-window-set-title
          set-gtk-window-delete-event-callback!
@@ -89,9 +96,11 @@ USA.
          gtk-container-add
          gtk-widget-show-all
          <fix-widget>
-         fix-widget-realize-callback)
+         fix-widget-realize-callback
+         set-fix-widget-key-press-handler!)
   (export (gl)
-         make-glx-device with-glx-device glx:swap-buffers <glx-widget>))
+         make-glx-widget with-glx-widget glx:swap-buffers <glx-widget>
+         with-glx-viewport <glx-viewport>))
 
 (define-package (gl glxgears)
   (files "gl-glxgears")

diff --git a/src/gl/gl.scm b/src/gl/gl.scm
index d5fd4d72a6d4480e4cbd47c3d791c39da35b4787..abc01ca3184aad816f8927bbd8650b5f45c87f99 100644 (file)
--- a/src/gl/gl.scm
+++ b/src/gl/gl.scm
@@ -44,16 +44,23 @@ USA.
   (guarantee-gl-depth depth 'GL:CLEAR-DEPTH)
   (C-call "glClearDepth" depth))
 
+(define (->capability cap operator)
+  (case cap
+    ((DEPTH-TEST) (C-enum "GL_DEPTH_TEST"))
+    ((CULL-FACE) (C-enum "GL_CULL_FACE"))
+    ((LIGHT0) (C-enum "GL_LIGHT0"))
+    ((LIGHTING) (C-enum "GL_LIGHTING"))
+    ((NORMALIZE) (C-enum "GL_NORMALIZE"))
+    ((COLOR-MATERIAL) (C-enum "GL_COLOR_MATERIAL"))
+    (else (error:wrong-type-argument cap "a GL capability" operator))))
+
 (define (gl:enable capability)
   (guarantee-current 'GL:ENABLE)
-  (C-call "glEnable"
-         (case capability
-           ((DEPTH-TEST) (C-enum "GL_DEPTH_TEST"))
-           ((CULL-FACE) (C-enum "GL_CULL_FACE"))
-           ((LIGHT0) (C-enum "GL_LIGHT0"))
-           ((LIGHTING) (C-enum "GL_LIGHTING"))
-           ((NORMALIZE) (C-enum "GL_NORMALIZE"))
-           (else (error "Unknown glEnable capability:" capability)))))
+  (C-call "glEnable" (->capability capability 'GL:ENABLE)))
+
+(define (gl:disable capability)
+  (guarantee-current 'GL:DISABLE)
+  (C-call "glDisable" (->capability capability 'GL:DISABLE)))
 
 (define (gl:depth-func function)
   (guarantee-current 'GL:DEPTH-FUNC)
@@ -62,6 +69,15 @@ USA.
            ((LEQUAL) (C-enum "GL_LEQUAL"))
            (else (error "Unknown glDepthFunc function:" function)))))
 
+(define (gl:cull-face mode)
+  (guarantee-current 'GL:CULL-FACE)
+  (C-call "glCullFace"
+         (case mode
+           ((FRONT) (C-enum "GL_FRONT"))
+           ((BACK) (C-enum "GL_BACK"))
+           ((FRONT-AND-BACK) (C-enum "GL_FRONT_AND_BACK"))
+           (else (error "Unknown glCullFace mode:" mode)))))
+
 (define (gl:hint target mode)
   (guarantee-current 'GL:HINT)
   (C-call "glHint"
@@ -72,6 +88,15 @@ USA.
            ((NICEST) (C-enum "GL_NICEST"))
            (else (error "Unknown glHint mode:" mode)))))
 
+(define (gl:color-material face mode)
+  (C-call "glColorMaterial"
+         (case face
+           ((FRONT) (C-enum "GL_FRONT"))
+           (else (error "Unknown glColorMaterial face:" face)))
+         (case mode
+           ((DIFFUSE) (C-enum "GL_DIFFUSE"))
+           (else (error "Unknown glColorMaterial mode:" mode)))))
+
 (define (gl:clear . bits)
   (guarantee-current 'GL:CLEAR)
   (C-call "glClear"
@@ -94,11 +119,11 @@ USA.
   (guarantee-current 'GL:LOOK-AT)
   (C-call "glu_look_at" position aim up))
 
-(define (gl:scaled kx ky kz)
-  (guarantee-current 'GL:SCALED)
-  (guarantee-flonum kx 'GL:SCALED)
-  (guarantee-flonum ky 'GL:SCALED)
-  (guarantee-flonum kz 'GL:SCALED)
+(define (gl:scale kx ky kz)
+  (guarantee-current 'GL:SCALE)
+  (guarantee-flonum kx 'GL:SCALE)
+  (guarantee-flonum ky 'GL:SCALE)
+  (guarantee-flonum kz 'GL:SCALE)
   (C-call "glScaled" kx ky kz))
 
 (define (gl:begin mode)