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 . set-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
 161 ;; emacs: (put 'with-gl-push-matrix 'scheme-indent-function 0)
 162 (define-syntax with-gl-push-matrix
 163   (syntax-rules ()
 164     ((_ body ...)
 165      (begin
 166        (%glPushMatrix)
 167        body ...
 168        (%glPopMatrix)))))
 169
 170 (export-syntax with-gl-push-matrix)
 171
 172 ;;;
 173 ;;; 2.11.3 Normal Transformations
 174 ;;;
 175
 176 (re-export (%glEnable . gl-enable)
 177            (%glDisable . gl-disable))
 178
 179 ;;;
 180 ;;; 2.14 Colors and Coloring
 181 ;;;
 182
 183 (re-export (%glShadeModel . set-gl-shade-model))
 184
 185 \f
 186 ;;;
 187 ;;; 4.1 Per-Fragment Operations
 188 ;;;
 189
 190 (define* (set-gl-stencil-function stencil-function k #:key
 191                                   (mask #xFFFFFFFF) ; 32-bit mask
 192                                   face)
 193   (if face
 194       (%glStencilFuncSeparate face stencil-function k mask)
 195       (%glStencilFunc stencil-function k mask)))
 196
 197 (define* (set-gl-stencil-operation stencil-fail depth-fail depth-pass #:key
 198                                    face)
 199   (if face
 200       (%glStencilOpSeparate face stencil-fail depth-fail depth-pass)
 201       (%glStencilOp stencil-fail depth-fail depth-pass)))
 202
 203 ;; TODO: 4.1.7 Occlusion Queries
 204
 205 (define* (set-gl-blend-equation mode-rgb #:optional (mode-alpha mode-rgb))
 206   (%glBlendEquationSeparate mode-rgb mode-alpha))
 207
 208 (define* (set-gl-blend-function src-rgb dest-rgb #:optional
 209                                 (src-alpha src-rgb)
 210                                 (dest-alpha dest-rgb))
 211   (%glBlendFuncSeparate src-rgb dest-rgb src-alpha dest-alpha))
 212
 213 (export set-gl-stencil-function
 214         set-gl-stencil-operation
 215         set-gl-blend-equation
 216         set-gl-blend-function
 217         )
 218
 219 (re-export (%glScissor . set-gl-scissor)
 220            (%glSampleCoverage . set-gl-sample-coverage)
 221            (%glAlphaFunc . set-gl-alpha-function)
 222            (%glDepthFunc . set-gl-depth-function)
 223            (%glBlendColor . set-gl-blend-color)
 224            (%glLogicOp . set-gl-logic-operation)
 225            )
 226
 227 ;;;
 228 ;;; 4.2 Whole Framebuffer Operations
 229 ;;;
 230
 231 (define (set-gl-draw-buffers buffers)
 232   (let* ((n (length buffers))
 233          (buffers (make-c-struct (make-list n (GLenum))
 234                                  buffers)))
 235     (%glDrawBuffers n buffers)))
 236
 237 (define* (set-gl-stencil-mask mask #:key face)
 238   (if face
 239       (%glStencilMaskSeparate face mask)
 240       (%glStencilMask mask)))
 241
 242 (export set-gl-draw-buffers
 243         set-gl-stencil-mask)
 244
 245 (re-export (%glDrawBuffer . set-gl-draw-buffer)
 246            (%glIndexMask . set-gl-index-mask)
 247            (%glColorMask . set-gl-color-mask)
 248            (%glDepthMask . set-gl-depth-mask)
 249            (%glClear . gl-clear)
 250            (%glClearColor . set-gl-clear-color)
 251            (%glClearIndex . set-gl-clear-index)
 252            (%glClearDepth . set-gl-clear-depth)
 253            (%glClearStencil . set-gl-clear-stencil-value)
 254            (%glClearAccum . set-gl-clear-accumulation-color)
 255            (%glAccum . set-gl-accumulation-buffer-operation))
 256
 257 ;;;
 258 ;;; 4.3 Drawing, Reading, and Copying Pixels
 259 ;;;
 260
 261 ;; TODO: read-pixels
 262
 263 (re-export (%glReadBuffer . set-gl-read-buffer)
 264            (%glCopyPixels . gl-copy-pixels))
 265
 266 ;;;
 267 ;;; 6.1 Querying GL State
 268 ;;;
 269
 270 ;; emacs: (put 'with-gl-push-attrib 'scheme-indent-function 1)
 271 (define-syntax-rule (with-gl-push-attrib bits body ...)
 272   (begin
 273     (%glPushAttrib bits)
 274     body
 275     ...
 276     (%glPopAttrib)))
 277
 278 (export with-gl-push-attrib)