From b20ac9fceaaa1ee8a329df81586fe3af9da33f73 Mon Sep 17 00:00:00 2001 From: Daniel Hartwig Date: Fri, 15 Feb 2013 08:43:41 +0800 Subject: [PATCH] add high-level bindings for array pointers * figl/gl.scm (set-gl-vertex-array, set-gl-normal-array): (set-gl-color-array, set-gl-secondary-color-array): (set-gl-index-array, set-gl-fog-coordinate-array): (set-gl-texture-coordinates-array, set-gl-vertex-attribute-array): Add procedures for setting gl array pointers from structure data. (gl-enable-client-state, gl-disable-client-state): (gl-enable-vertex-attribute-array): (gl-disable-vertex-attribute-array): (set-gl-client-active-texture): Add procedures for enabling vertex arrays. (gl-array-element, gl-draw-arrays, gl-draw-elements): Add procedures for accessing the array data. * figl/contrib/structures.scm (structure-field?): Export. --- figl/contrib/structures.scm | 29 +++++++++ figl/gl.scm | 123 ++++++++++++++++++++++++++++++++++++ 2 files changed, 152 insertions(+) diff --git a/figl/contrib/structures.scm b/figl/contrib/structures.scm index 38916f5..d163fbf 100644 --- a/figl/contrib/structures.scm +++ b/figl/contrib/structures.scm @@ -39,6 +39,7 @@ structure-descriptor-field structure-length + structure-field? structure-field-name structure-field-type structure-field-count @@ -67,6 +68,9 @@ structure-vector-field-accessor structure-vector-field-mutator structure-vector-for-each + + array-type->gl-data-type + structure-field-gl-data-type )) ;;; @@ -451,3 +455,28 @@ structure2 ...)', and may be used to update the structures in place." (* i stride)) pointers)) (lp (1+ i)))))) + +;;; +;;; Other +;;; + +;; TODO: Don't need to use enums module here once we are using symbols +;; instead of `(type foo)' construction for enums. + +(use-modules (figl gl enums)) + +(define *gl-types* + `((f32 . ,(data-type float)) + (f64 . ,(data-type double)) + (s8 . ,(data-type byte)) + (u8 . ,(data-type unsigned-byte)) + (s16 . ,(data-type short)) + (u16 . ,(data-type unsigned-short)) + (s32 . ,(data-type int)) + (u32 . ,(data-type unsigned-int)))) + +(define (array-type->gl-data-type symbol) + (assv-ref *gl-types* symbol)) + +(define (structure-field-gl-data-type field) + (array-type->gl-data-type (structure-field-type field))) diff --git a/figl/gl.scm b/figl/gl.scm index 6267585..b965482 100644 --- a/figl/gl.scm +++ b/figl/gl.scm @@ -27,6 +27,8 @@ #:use-module (figl gl types) #:use-module (figl gl enums) #:use-module ((figl gl low-level) #:renamer (symbol-prefix-proc '%)) + #:use-module (figl contrib structures) + #:use-module (ice-9 match) #:use-module (system foreign)) ;; Notice there is no #:export clause. Exports are done inline to @@ -108,6 +110,127 @@ (%glSecondaryColor3f . gl-secondary-color) (%glIndexi . gl-index)) +;;; +;;; 2.8 Vertex Arrays +;;; + +(define-syntax define-gl-array-pointer-mutator + (syntax-rules () + ((_ name binding) + (define (name . args) + (match args + (((? structure-field? field) bv) + (binding (structure-field-count field) + (structure-field-gl-data-type field) + (structure-length + (structure-field-structure-descriptor field)) + (make-pointer + (+ (structure-field-offset field) + (pointer-address + (bytevector->pointer bv)))))) + ((size type stride bv-or-pointer) + (binding size type stride bv-or-pointer))))))) + +(define-syntax define-gl-array-pointer-mutators + (syntax-rules () + ((_ (name binding) ...) + (begin + (define-gl-array-pointer-mutator name binding) + ...)))) + +(define-gl-array-pointer-mutators + (set-gl-vertex-array %glVertexPointer) + (set-gl-color-array %glColorPointer) + (set-gl-secondary-color-array %glSecondaryColorPointer) + (set-gl-texture-coordinates-array %glTexCoordPointer)) + +(define (set-gl-normal-array . args) + (match args + (((? structure-field? field) bv) + (%glNormalPointer (structure-field-gl-data-type field) + (structure-length + (structure-field-structure-descriptor field)) + (make-pointer + (+ (structure-field-offset field) + (pointer-address + (bytevector->pointer bv)))))) + ((type stride bv-or-pointer) + (%glNormalPointer type stride bv-or-pointer)))) + +(define (set-gl-fog-coordinate-array . args) + (match args + (((? structure-field? field) bv) + (%glFogCoordPointer (structure-field-gl-data-type field) + (structure-length + (structure-field-structure-descriptor field)) + (make-pointer + (+ (structure-field-offset field) + (pointer-address + (bytevector->pointer bv)))))) + ((type stride bv-or-pointer) + (%glFogCoordPointer type stride bv-or-pointer)))) + +(define (set-gl-index-array . args) + (match args + (((? structure-field? field) bv) + (%glIndexPointer (structure-field-gl-data-type field) + (structure-length + (structure-field-structure-descriptor field)) + (make-pointer + (+ (structure-field-offset field) + (pointer-address + (bytevector->pointer bv)))))) + ((type stride bv-or-pointer) + (%glIndexPointer type stride bv-or-pointer)))) + +(define (set-gl-vertex-attribute-array . args) + (match args + ((index normalized? (? structure-field? field) bv) + (%glVertexAttribPointer + index + (structure-field-count field) + (structure-field-gl-data-type field) + normalized? + (structure-length + (structure-field-structure-descriptor field)) + (make-pointer + (+ (structure-field-offset field) + (pointer-address + (bytevector->pointer bv)))))) + ((index size type normalized? stride bv-or-pointer) + (%glVertexAttribPointer + index size type normalized? stride bv-or-pointer)))) + +(export set-gl-vertex-array + set-gl-normal-array + set-gl-color-array + set-gl-secondary-color-array + set-gl-index-array + ;; set-gl-edge-flag-array + set-gl-fog-coordinate-array + set-gl-texture-coordinates-array + set-gl-vertex-attribute-array + ) + +(re-export (%glEnableClientState . gl-enable-client-state) + (%glDisableClientState . gl-disable-client-state) + (%glEnableVertexAttribArray . gl-enable-vertex-attribute-array) + (%glDisableVertexAttribArray . gl-disable-vertex-attribute-array) + (%glClientActiveTexture . set-gl-client-active-texture)) + +(re-export (%glArrayElement . gl-array-element) + (%glDrawArrays . gl-draw-arrays)) + +(define (gl-draw-elements mode count indices) + (%glDrawElements mode + count + (array-type->gl-data-type (array-type indices)) + (array-contents indices))) + +(export gl-draw-elements) + +;; TODO: Rest of 2.8 procedures (interleaved-arrays, etc.). + ;;; ;;; 2.10 Rectangles ;;; -- 2.20.1