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 enums)
  28   #:use-module ((figl gl low-level) #:renamer (symbol-prefix-proc '%)))
  29
  30 ;; Notice there is no #:export clause.  Exports are done inline to
  31 ;; facilitate re-exporting low-level bindings (and changing that
  32 ;; choice), and identifying gaps in the API.
  33 ;;
  34 ;; There are two sets of exports for each section.  The first is for
  35 ;; bindings defined in the specification, exported in order.  The
  36 ;; second is for additional procedures not defined by the spec. but
  37 ;; relevant to the section, for example with-gl-begin.
  38 ;;
  39 ;; At least keep this format until the bindings are fairly complete.
  40
  41 (module-use! (module-public-interface (current-module))
  42              (resolve-interface '(figl gl enums)))
  43
  44 ;;;
  45 ;;; 2.6 Begin/End Paradigm
  46 ;;;
  47
  48 ;; emacs: (put! 'gl-begin 'scheme-indent-function 1)
  49 (define-syntax gl-begin
  50   (syntax-rules ()
  51     ((_ mode body1 body2 ...)
  52      (call-with-values
  53          (lambda ()
  54            (%glBegin mode)
  55            body1 body2 ...)
  56        (lambda vals
  57          (%glEnd)
  58          (apply values vals))))))
  59
  60 (define (gl-edge-flag flag)
  61   (%glEdgeFlag (if flag (boolean true) (boolean false))))
  62
  63 (export-syntax gl-begin)
  64
  65 (export gl-edge-flag)
  66
  67 ;;;
  68 ;;; 2.7 Vertex Specification
  69 ;;;
  70
  71 ;; Note that these are float variants only.  This has implications for
  72 ;; some functions whose integer variants normalize their arguments.
  73 ;; The corresponding float variants expect normalized input, usually
  74 ;; in the range [0, 1].  Refer to the OpenGL specification for
  75 ;; details.
  76 ;;
  77 ;; For access to non-float variants please use the appropriate
  78 ;; low-level binding.
  79
  80 ;; TODO: Maybe re-export packaged variants here.  Unpacked byte
  81 ;; variants?
  82
  83 (define* (gl-vertex x y #:optional (z 0.0) (w 1.0))
  84   (%glVertex4f x y z w))
  85
  86 (define* (gl-tex-coord s #:optional (t 0.0) (r 0.0) (q 1.0))
  87   (%glTexCoord4f s t r q))
  88
  89 (define* (gl-multi-tex-coord texture s #:optional (t 0.0) (r 0.0) (q 1.0))
  90   (%glMultiTexCoord4f texture s t r q))
  91
  92 (define* (gl-color red green blue #:optional (alpha 1.0))
  93   (%glColor4f red green blue alpha))
  94
  95 (define* (gl-vertex-attrib index x #:optional (y 0.0) (z 0.0) (w 1.0))
  96   (%glVertexAttrib4f index x y z w))
  97
  98 (export gl-vertex
  99         gl-tex-coord
 100         gl-multi-tex-coord
 101         gl-color)
 102
 103 (re-export (%glNormal3f . gl-normal)
 104            (%glFogCoordf . gl-fog-coord)
 105            (%glSecondaryColor3f . gl-secondary-color)
 106            (%glIndexi . gl-index))
 107
 108 ;;;
 109 ;;; 2.10 Rectangles
 110 ;;;
 111
 112 (re-export (%glRectf . gl-rectangle))
 113
 114 \f
 115 ;;;
 116 ;;; 2.11 Coordinate Transformation
 117 ;;;
 118
 119 ;;;
 120 ;;; 2.11.1 Controlling the Viewport
 121 ;;;
 122
 123 (re-export (%glDepthRange . gl-depth-range)
 124            (%glViewport . gl-viewport))
 125
 126 ;;;
 127 ;;; 2.11.2 Matrices
 128 ;;;
 129
 130 ;; OpengGL matrices are stored in column-major order.  This is
 131 ;; different to the usual row-major order used in 2-dimensional
 132 ;; arrays, which will have to be transposed as they loaded.
 133
 134 (define* (gl-load-matrix m #:key (transpose #f))
 135   ((if transpose
 136        %glLoadTransposeMatrixf
 137        %glLoadMatrixf)
 138    (array-contents m)))
 139
 140 (define* (gl-multiply-matrix m #:key (transpose #f))
 141   ((if transpose
 142        %glMultTransposeMatrixf
 143        %glMultMatrixf)
 144    (array-contents m)))
 145
 146 (export gl-load-matrix
 147         gl-multiply-matrix)
 148
 149 (re-export (%glMatrixMode . gl-matrix-mode)
 150            (%glLoadIdentity . gl-load-identity)
 151            (%glRotatef . gl-rotate)
 152            (%glTranslatef . gl-translate)
 153            (%glScalef . gl-scale)
 154            (%glFrustum . gl-frustum)
 155            (%glOrtho . gl-ortho)
 156            (%glActiveTexture . set-gl-active-texture)
 157            (%glPushMatrix . gl-push-matrix)
 158            (%glPopMatrix . gl-pop-matrix))
 159
 160 (define-syntax with-gl-push-matrix
 161   (syntax-rules ()
 162     ((_ body ...)
 163      (begin
 164        (%glPushMatrix)
 165        body ...
 166        (%glPopMatrix)))))
 167
 168 (export-syntax with-gl-push-matrix)
 169
 170 ;;;
 171 ;;; 2.11.3 Normal Transformations
 172 ;;;
 173
 174 (re-export (%glEnable . gl-enable)
 175            (%glDisable . gl-disable))