From ea80f8019fdd4cb65200c7116246f8f906cca581 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Mon, 11 Feb 2013 12:19:04 +0800
Subject: [PATCH] add high-level gl bindings for fragment and framebuffer
 operations

* figl/gl.scm (gl-clear, set-gl-clear-color, etc.): High-level
  bindings for functions pertaining to fragment and framebuffer
  operations.  There is now enough high-level to run the fixed
  function pipeline.

* examples/glut/demo.scm: Use high-level gl bindings.
---
 examples/glut/demo.scm |  18 +++-----
 figl/gl.scm            | 100 +++++++++++++++++++++++++++++++++++++----
 2 files changed, 99 insertions(+), 19 deletions(-)

diff --git a/examples/glut/demo.scm b/examples/glut/demo.scm
index 1e62e8a..6038f90 100644
--- a/examples/glut/demo.scm
+++ b/examples/glut/demo.scm
@@ -1,21 +1,17 @@
 #!/usr/bin/env guile
 !#
 
-(use-modules (figl glut enums)
-             (figl glut low-level)
+(use-modules (figl glut low-level)
              (figl glut)
-             (figl gl enums)
-             (figl gl low-level)
+             (figl gl)
              (system foreign))
 
 (define (render-scene)
-  (glClear (clear-buffer-mask color-buffer depth-buffer))
-  (glBegin (begin-mode triangles))
-  (glVertex3f -0.5 -0.5 0.0)
-  (glVertex3f 0.5 0.0 0.0)
-  (glVertex3f 0.0 0.5 0.0)
-  (glEnd)
-
+  (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+  (gl-begin (begin-mode triangles)
+    (gl-vertex -0.5 -0.5 0.0)
+    (gl-vertex 0.5 0.0 0.0)
+    (gl-vertex 0.0 0.5 0.0))
   (glutSwapBuffers))
 
 (glutInitWindowSize 320 200)
diff --git a/figl/gl.scm b/figl/gl.scm
index 1dd853e..8fbb0b5 100644
--- a/figl/gl.scm
+++ b/figl/gl.scm
@@ -24,8 +24,10 @@
 
 (define-module (figl gl)
   #:use-module (figl runtime)
+  #:use-module (figl gl types)
   #:use-module (figl gl enums)
-  #:use-module ((figl gl low-level) #:renamer (symbol-prefix-proc '%)))
+  #:use-module ((figl gl low-level) #:renamer (symbol-prefix-proc '%))
+  #:use-module (system foreign))
 
 ;; Notice there is no #:export clause.  Exports are done inline to
 ;; facilitate re-exporting low-level bindings (and changing that
@@ -83,25 +85,26 @@
 (define* (gl-vertex x y #:optional (z 0.0) (w 1.0))
   (%glVertex4f x y z w))
 
-(define* (gl-tex-coord s #:optional (t 0.0) (r 0.0) (q 1.0))
+(define* (gl-texture-coordinate s #:optional (t 0.0) (r 0.0) (q 1.0))
   (%glTexCoord4f s t r q))
 
-(define* (gl-multi-tex-coord texture s #:optional (t 0.0) (r 0.0) (q 1.0))
+(define* (gl-multi-texture-coordinate texture s #:optional (t 0.0) (r 0.0) (q 1.0))
   (%glMultiTexCoord4f texture s t r q))
 
 (define* (gl-color red green blue #:optional (alpha 1.0))
   (%glColor4f red green blue alpha))
 
-(define* (gl-vertex-attrib index x #:optional (y 0.0) (z 0.0) (w 1.0))
+(define* (gl-vertex-attribute index x #:optional (y 0.0) (z 0.0) (w 1.0))
   (%glVertexAttrib4f index x y z w))
 
 (export gl-vertex
-        gl-tex-coord
-        gl-multi-tex-coord
-        gl-color)
+        gl-texture-coordinate
+        gl-multi-texture-coordinate
+        gl-color
+        gl-vertex-attribute)
 
 (re-export (%glNormal3f . gl-normal)
-           (%glFogCoordf . gl-fog-coord)
+           (%glFogCoordf . gl-fog-coordinate)
            (%glSecondaryColor3f . gl-secondary-color)
            (%glIndexi . gl-index))
 
@@ -173,3 +176,84 @@
 
 (re-export (%glEnable . gl-enable)
            (%glDisable . gl-disable))
+
+
+;;;
+;;; 4.1 Per-Fragment Operations
+;;;
+
+(define* (set-gl-stencil-function stencil-function k #:key
+                                  (mask #xFFFFFFFF) ; 32-bit mask
+                                  face)
+  (if face
+      (%glStencilFuncSeparate face stencil-function k mask)
+      (%glStencilFunc stencil-function k mask)))
+
+(define* (set-gl-stencil-operation stencil-fail depth-fail depth-pass #:key
+                                   face)
+  (if face
+      (%glStencilOpSeparate face stencil-fail depth-fail depth-pass)
+      (%glStencilOp stencil-fail depth-fail depth-pass)))
+
+;; TODO: 4.1.7 Occlusion Queries
+
+(define* (set-gl-blend-equation mode-rgb #:optional (mode-alpha mode-rgb))
+  (%glBlendEquationSeparate mode-rgb mode-alpha))
+
+(define* (set-gl-blend-function src-rgb dest-rgb #:optional
+                                (src-alpha src-rgb)
+                                (dest-alpha dest-rgb))
+  (%glBlendFuncSeparate src-rgb dest-rgb src-alpha dest-alpha))
+
+(export set-gl-stencil-function
+        set-gl-stencil-operation
+        set-gl-blend-equation
+        set-gl-blend-function
+        )
+
+(re-export (%glScissor . set-gl-scissor)
+           (%glSampleCoverage . set-gl-sample-coverage)
+           (%glAlphaFunc . set-gl-alpha-function)
+           (%glDepthFunc . set-gl-depth-function)
+           (%glBlendColor . set-gl-blend-color)
+           (%glLogicOp . set-gl-logic-operation)
+           )
+
+;;;
+;;; 4.2 Whole Framebuffer Operations
+;;;
+
+(define (set-gl-draw-buffers buffers)
+  (let* ((n (length buffers))
+         (buffers (make-c-struct (make-list n (GLenum))
+                                 buffers)))
+    (%glDrawBuffers n buffers)))
+
+(define* (set-gl-stencil-mask mask #:key face)
+  (if face
+      (%glStencilMaskSeparate face mask)
+      (%glStencilMask mask)))
+
+(export set-gl-draw-buffers
+        set-gl-stencil-mask)
+
+(re-export (%glDrawBuffer . set-gl-draw-buffer)
+           (%glIndexMask . set-gl-index-mask)
+           (%glColorMask . set-gl-color-mask)
+           (%glDepthMask . set-gl-depth-mask)
+           (%glClear . gl-clear)
+           (%glClearColor . set-gl-clear-color)
+           (%glClearIndex . set-gl-clear-index)
+           (%glClearDepth . set-gl-clear-depth)
+           (%glClearStencil . set-gl-clear-stencil-value)
+           (%glClearAccum . set-gl-clear-accumulation-color)
+           (%glAccum . set-gl-accumulation-buffer-operation))
+
+;;;
+;;; 4.3 Drawing, Reading, and Copying Pixels
+;;;
+
+;; TODO: read-pixels
+
+(re-export (%glReadBuffer . set-gl-read-buffer)
+           (%glCopyPixels . gl-copy-pixels))
-- 
2.20.1