figl/gl.scm

   1 ;;; figl
   2 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
   3 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
   4 ;;;
   5 ;;; Figl is free software: you can redistribute it and/or modify it
   6 ;;; under the terms of the GNU Lesser General Public License as
   7 ;;; published by the Free Software Foundation, either version 3 of the
   8 ;;; License, or (at your option) any later version.
   9 ;;;
  10 ;;; Figl is distributed in the hope that it will be useful, but WITHOUT
  11 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  12 ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  13 ;;; Public License for more details.
  14 ;;;
  15 ;;; You should have received a copy of the GNU Lesser General Public
  16 ;;; License along with this program.  If not, see
  17 ;;; <http://www.gnu.org/licenses/>.
  18
  19 ;;; Commentary:
  20 ;;
  21 ;; OpenGL binding.
  22 ;;
  23 ;;; Code:
  24
  25 (define-module (figl gl)
  26   #:use-module (figl runtime)
  27   #:use-module (figl gl types)
  28   #:use-module (figl gl enums)
  29   #:use-module ((figl gl low-level) #:renamer (symbol-prefix-proc '%))
  30   #:use-module (system foreign))
  31
  32 ;; Notice there is no #:export clause.  Exports are done inline to
  33 ;; facilitate re-exporting low-level bindings (and changing that
  34 ;; choice), and identifying gaps in the API.
  35 ;;
  36 ;; There are two sets of exports for each section.  The first is for
  37 ;; bindings defined in the specification, exported in order.  The
  38 ;; second is for additional procedures not defined by the spec. but
  39 ;; relevant to the section, for example with-gl-begin.
  40 ;;
  41 ;; At least keep this format until the bindings are fairly complete.
  42
  43 (module-use! (module-public-interface (current-module))
  44              (resolve-interface '(figl gl enums)))
  45
  46 ;;;
  47 ;;; 2.6 Begin/End Paradigm
  48 ;;;
  49
  50 ;; emacs: (put! 'gl-begin 'scheme-indent-function 1)
  51 (define-syntax gl-begin
  52   (syntax-rules ()
  53     ((_ mode body1 body2 ...)
  54      (call-with-values
  55          (lambda ()
  56            (%glBegin mode)
  57            body1 body2 ...)
  58        (lambda vals
  59          (%glEnd)
  60          (apply values vals))))))
  61
  62 (define (gl-edge-flag flag)
  63   (%glEdgeFlag (if flag (boolean true) (boolean false))))
  64
  65 (export-syntax gl-begin)
  66
  67 (export gl-edge-flag)
  68
  69 ;;;
  70 ;;; 2.7 Vertex Specification
  71 ;;;
  72
  73 ;; Note that these are float variants only.  This has implications for
  74 ;; some functions whose integer variants normalize their arguments.
  75 ;; The corresponding float variants expect normalized input, usually
  76 ;; in the range [0, 1].  Refer to the OpenGL specification for
  77 ;; details.
  78 ;;
  79 ;; For access to non-float variants please use the appropriate
  80 ;; low-level binding.
  81
  82 ;; TODO: Maybe re-export packaged variants here.  Unpacked byte
  83 ;; variants?
  84
  85 (define* (gl-vertex x y #:optional (z 0.0) (w 1.0))
  86   (%glVertex4f x y z w))
  87
  88 (define* (gl-texture-coordinate s #:optional (t 0.0) (r 0.0) (q 1.0))
  89   (%glTexCoord4f s t r q))
  90
  91 (define* (gl-multi-texture-coordinate texture s #:optional (t 0.0) (r 0.0) (q 1.0))
  92   (%glMultiTexCoord4f texture s t r q))
  93
  94 (define* (gl-color red green blue #:optional (alpha 1.0))
  95   (%glColor4f red green blue alpha))
  96
  97 (define* (gl-vertex-attribute index x #:optional (y 0.0) (z 0.0) (w 1.0))
  98   (%glVertexAttrib4f index x y z w))
  99
 100 (export gl-vertex
 101         gl-texture-coordinate
 102         gl-multi-texture-coordinate
 103         gl-color
 104         gl-vertex-attribute)
 105
 106 (re-export (%glNormal3f . gl-normal)
 107            (%glFogCoordf . gl-fog-coordinate)
 108            (%glSecondaryColor3f . gl-secondary-color)
 109            (%glIndexi . gl-index))
 110
 111 ;;;
 112 ;;; 2.10 Rectangles
 113 ;;;
 114
 115 (re-export (%glRectf . gl-rectangle))
 116
 117 \f
 118 ;;;
 119 ;;; 2.11 Coordinate Transformation
 120 ;;;
 121
 122 ;;;
 123 ;;; 2.11.1 Controlling the Viewport
 124 ;;;
 125
 126 (re-export (%glDepthRange . gl-depth-range)
 127            (%glViewport . gl-viewport))
 128
 129 ;;;
 130 ;;; 2.11.2 Matrices
 131 ;;;
 132
 133 ;; OpengGL matrices are stored in column-major order.  This is
 134 ;; different to the usual row-major order used in 2-dimensional
 135 ;; arrays, which will have to be transposed as they loaded.
 136
 137 (define* (gl-load-matrix m #:key (transpose #f))
 138   ((if transpose
 139        %glLoadTransposeMatrixf
 140        %glLoadMatrixf)
 141    (array-contents m)))
 142
 143 (define* (gl-multiply-matrix m #:key (transpose #f))
 144   ((if transpose
 145        %glMultTransposeMatrixf
 146        %glMultMatrixf)
 147    (array-contents m)))
 148
 149 (export gl-load-matrix
 150         gl-multiply-matrix)
 151
 152 (re-export (%glMatrixMode . gl-matrix-mode)
 153            (%glLoadIdentity . gl-load-identity)
 154            (%glRotatef . gl-rotate)
 155            (%glTranslatef . gl-translate)
 156            (%glScalef . gl-scale)
 157            (%glFrustum . gl-frustum)
 158            (%glOrtho . gl-ortho)
 159            (%glActiveTexture . set-gl-active-texture)
 160            (%glPushMatrix . gl-push-matrix)
 161            (%glPopMatrix . gl-pop-matrix))
 162
 163 (define-syntax with-gl-push-matrix
 164   (syntax-rules ()
 165     ((_ body ...)
 166      (begin
 167        (%glPushMatrix)
 168        body ...
 169        (%glPopMatrix)))))
 170
 171 (export-syntax with-gl-push-matrix)
 172
 173 ;;;
 174 ;;; 2.11.3 Normal Transformations
 175 ;;;
 176
 177 (re-export (%glEnable . gl-enable)
 178            (%glDisable . gl-disable))
 179
 180 \f
 181 ;;;
 182 ;;; 4.1 Per-Fragment Operations
 183 ;;;
 184
 185 (define* (set-gl-stencil-function stencil-function k #:key
 186                                   (mask #xFFFFFFFF) ; 32-bit mask
 187                                   face)
 188   (if face
 189       (%glStencilFuncSeparate face stencil-function k mask)
 190       (%glStencilFunc stencil-function k mask)))
 191
 192 (define* (set-gl-stencil-operation stencil-fail depth-fail depth-pass #:key
 193                                    face)
 194   (if face
 195       (%glStencilOpSeparate face stencil-fail depth-fail depth-pass)
 196       (%glStencilOp stencil-fail depth-fail depth-pass)))
 197
 198 ;; TODO: 4.1.7 Occlusion Queries
 199
 200 (define* (set-gl-blend-equation mode-rgb #:optional (mode-alpha mode-rgb))
 201   (%glBlendEquationSeparate mode-rgb mode-alpha))
 202
 203 (define* (set-gl-blend-function src-rgb dest-rgb #:optional
 204                                 (src-alpha src-rgb)
 205                                 (dest-alpha dest-rgb))
 206   (%glBlendFuncSeparate src-rgb dest-rgb src-alpha dest-alpha))
 207
 208 (export set-gl-stencil-function
 209         set-gl-stencil-operation
 210         set-gl-blend-equation
 211         set-gl-blend-function
 212         )
 213
 214 (re-export (%glScissor . set-gl-scissor)
 215            (%glSampleCoverage . set-gl-sample-coverage)
 216            (%glAlphaFunc . set-gl-alpha-function)
 217            (%glDepthFunc . set-gl-depth-function)
 218            (%glBlendColor . set-gl-blend-color)
 219            (%glLogicOp . set-gl-logic-operation)
 220            )
 221
 222 ;;;
 223 ;;; 4.2 Whole Framebuffer Operations
 224 ;;;
 225
 226 (define (set-gl-draw-buffers buffers)
 227   (let* ((n (length buffers))
 228          (buffers (make-c-struct (make-list n (GLenum))
 229                                  buffers)))
 230     (%glDrawBuffers n buffers)))
 231
 232 (define* (set-gl-stencil-mask mask #:key face)
 233   (if face
 234       (%glStencilMaskSeparate face mask)
 235       (%glStencilMask mask)))
 236
 237 (export set-gl-draw-buffers
 238         set-gl-stencil-mask)
 239
 240 (re-export (%glDrawBuffer . set-gl-draw-buffer)
 241            (%glIndexMask . set-gl-index-mask)
 242            (%glColorMask . set-gl-color-mask)
 243            (%glDepthMask . set-gl-depth-mask)
 244            (%glClear . gl-clear)
 245            (%glClearColor . set-gl-clear-color)
 246            (%glClearIndex . set-gl-clear-index)
 247            (%glClearDepth . set-gl-clear-depth)
 248            (%glClearStencil . set-gl-clear-stencil-value)
 249            (%glClearAccum . set-gl-clear-accumulation-color)
 250            (%glAccum . set-gl-accumulation-buffer-operation))
 251
 252 ;;;
 253 ;;; 4.3 Drawing, Reading, and Copying Pixels
 254 ;;;
 255
 256 ;; TODO: read-pixels
 257
 258 (re-export (%glReadBuffer . set-gl-read-buffer)
 259            (%glCopyPixels . gl-copy-pixels))