2 ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com>
3 ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com>
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.
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.
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/>.
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))
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.
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.
41 ;; At least keep this format until the bindings are fairly complete.
43 (module-use! (module-public-interface (current-module))
44 (resolve-interface '(figl gl enums)))
47 ;;; 2.6 Begin/End Paradigm
50 ;; emacs: (put 'gl-begin 'scheme-indent-function 1)
51 (define-syntax gl-begin
53 ((_ mode body1 body2 ...)
60 (apply values vals))))))
62 (define (gl-edge-flag flag)
63 (%glEdgeFlag (if flag (boolean true) (boolean false))))
65 (export-syntax gl-begin)
70 ;;; 2.7 Vertex Specification
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
79 ;; For access to non-float variants please use the appropriate
82 ;; TODO: Maybe re-export packaged variants here. Unpacked byte
85 (define* (gl-vertex x y #:optional (z 0.0) (w 1.0))
86 (%glVertex4f x y z w))
88 (define* (gl-texture-coordinate s #:optional (t 0.0) (r 0.0) (q 1.0))
89 (%glTexCoord4f s t r q))
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))
94 (define* (gl-color red green blue #:optional (alpha 1.0))
95 (%glColor4f red green blue alpha))
97 (define* (gl-vertex-attribute index x #:optional (y 0.0) (z 0.0) (w 1.0))
98 (%glVertexAttrib4f index x y z w))
101 gl-texture-coordinate
102 gl-multi-texture-coordinate
106 (re-export (%glNormal3f . gl-normal)
107 (%glFogCoordf . gl-fog-coordinate)
108 (%glSecondaryColor3f . gl-secondary-color)
109 (%glIndexi . gl-index))
115 (re-export (%glRectf . gl-rectangle))
119 ;;; 2.11 Coordinate Transformation
123 ;;; 2.11.1 Controlling the Viewport
126 (re-export (%glDepthRange . gl-depth-range)
127 (%glViewport . gl-viewport))
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.
137 (define* (gl-load-matrix m #:key (transpose #f))
139 %glLoadTransposeMatrixf
143 (define* (gl-multiply-matrix m #:key (transpose #f))
145 %glMultTransposeMatrixf
149 (export gl-load-matrix
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 (%glPushMatrix . gl-push-matrix)
161 (%glPopMatrix . gl-pop-matrix))
163 ;; emacs: (put 'with-gl-push-matrix 'scheme-indent-function 0)
164 (define-syntax with-gl-push-matrix
172 (export-syntax with-gl-push-matrix)
175 ;;; 2.11.3 Normal Transformations
178 (re-export (%glEnable . gl-enable)
179 (%glDisable . gl-disable))
182 ;;; 2.14 Colors and Coloring
185 (re-export (%glShadeModel . set-gl-shade-model))
189 ;;; 4.1 Per-Fragment Operations
192 (define* (set-gl-stencil-function stencil-function k #:key
193 (mask #xFFFFFFFF) ; 32-bit mask
196 (%glStencilFuncSeparate face stencil-function k mask)
197 (%glStencilFunc stencil-function k mask)))
199 (define* (set-gl-stencil-operation stencil-fail depth-fail depth-pass #:key
202 (%glStencilOpSeparate face stencil-fail depth-fail depth-pass)
203 (%glStencilOp stencil-fail depth-fail depth-pass)))
205 ;; TODO: 4.1.7 Occlusion Queries
207 (define* (set-gl-blend-equation mode-rgb #:optional (mode-alpha mode-rgb))
208 (%glBlendEquationSeparate mode-rgb mode-alpha))
210 (define* (set-gl-blend-function src-rgb dest-rgb #:optional
212 (dest-alpha dest-rgb))
213 (%glBlendFuncSeparate src-rgb dest-rgb src-alpha dest-alpha))
215 (export set-gl-stencil-function
216 set-gl-stencil-operation
217 set-gl-blend-equation
218 set-gl-blend-function
221 (re-export (%glScissor . set-gl-scissor)
222 (%glSampleCoverage . set-gl-sample-coverage)
223 (%glAlphaFunc . set-gl-alpha-function)
224 (%glDepthFunc . set-gl-depth-function)
225 (%glBlendColor . set-gl-blend-color)
226 (%glLogicOp . set-gl-logic-operation)
230 ;;; 4.2 Whole Framebuffer Operations
233 (define (set-gl-draw-buffers buffers)
234 (let* ((n (length buffers))
235 (buffers (make-c-struct (make-list n (GLenum))
237 (%glDrawBuffers n buffers)))
239 (define* (set-gl-stencil-mask mask #:key face)
241 (%glStencilMaskSeparate face mask)
242 (%glStencilMask mask)))
244 (export set-gl-draw-buffers
247 (re-export (%glDrawBuffer . set-gl-draw-buffer)
248 (%glIndexMask . set-gl-index-mask)
249 (%glColorMask . set-gl-color-mask)
250 (%glDepthMask . set-gl-depth-mask)
251 (%glClear . gl-clear)
252 (%glClearColor . set-gl-clear-color)
253 (%glClearIndex . set-gl-clear-index)
254 (%glClearDepth . set-gl-clear-depth)
255 (%glClearStencil . set-gl-clear-stencil-value)
256 (%glClearAccum . set-gl-clear-accumulation-color)
257 (%glAccum . set-gl-accumulation-buffer-operation))
260 ;;; 4.3 Drawing, Reading, and Copying Pixels
265 (re-export (%glReadBuffer . set-gl-read-buffer)
266 (%glCopyPixels . gl-copy-pixels))
269 ;;; 6.1 Querying GL State
272 ;; emacs: (put 'with-gl-push-attrib 'scheme-indent-function 1)
273 (define-syntax-rule (with-gl-push-attrib bits body ...)
280 (export with-gl-push-attrib)