From c71b65337d869fb69b805fb56c74437705275dd6 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 15 Feb 2013 22:05:57 +0100
Subject: [PATCH] client array example uses vertex array instead of quad array

* figl/contrib/packed-struct.scm (packed-struct-offset): New export.

* examples/particle-system/client-arrays.scm: Rewrite using a vertex
  array instead of a quad array.  It's the same thing, only a bit
  cleaner.
---
 examples/particle-system/client-arrays.scm | 69 ++++++++--------------
 figl/contrib/packed-struct.scm             |  9 +++
 2 files changed, 34 insertions(+), 44 deletions(-)

diff --git a/examples/particle-system/client-arrays.scm b/examples/particle-system/client-arrays.scm
index d05d637..bccf2af 100644
--- a/examples/particle-system/client-arrays.scm
+++ b/examples/particle-system/client-arrays.scm
@@ -8,38 +8,14 @@
              (ice-9 format)
              (figl contrib packed-struct))
 
-(define-packed-struct color-quad
-  (x-- float)
-  (y-- float)
-  (z-- float)
-
-  (r-- float)
-  (g-- float)
-  (b-- float)
-
-  (x+- float)
-  (y+- float)
-  (z+- float)
-
-  (r+- float)
-  (g+- float)
-  (b+- float)
-
-  (x++ float)
-  (y++ float)
-  (z++ float)
-
-  (r++ float)
-  (g++ float)
-  (b++ float)
-
-  (x-+ float)
-  (y-+ float)
-  (z-+ float)
+(define-packed-struct color-vertex
+  (x float)
+  (y float)
+  (z float)
 
-  (r-+ float)
-  (g-+ float)
-  (b-+ float))
+  (r float)
+  (g float)
+  (b float))
 
 (define-packed-struct particle
   (x float)
@@ -49,21 +25,22 @@
   (vy float)
   (vz float))
 
-(define *quads* (make-packed-array color-quad 0))
+(define *vertices* (make-packed-array color-vertex 0))
 (define *particles* (make-packed-array particle 0))
 
 (define (draw-particles)
   (gl-enable-client-state (enable-cap vertex-array))
   (gl-enable-client-state (enable-cap color-array))
   (set-gl-vertex-array (vertex-pointer-type float)
-                       *quads*
-                       #:stride (/ (packed-struct-size color-quad) 4))
+                       *vertices*
+                       #:stride (packed-struct-size color-vertex)
+                       #:offset (packed-struct-offset color-vertex x))
   (set-gl-color-array (color-pointer-type float)
-                      *quads*
-                      #:stride (/ (packed-struct-size color-quad) 4)
-                      #:offset (/ (packed-struct-size color-quad) 8))
+                      *vertices*
+                      #:stride (packed-struct-size color-vertex)
+                      #:offset (packed-struct-offset color-vertex r))
   (gl-draw-arrays (begin-mode quads) 0
-                  (* 4 (packed-array-length *quads* color-quad)))
+                  (packed-array-length *vertices* color-vertex))
   (gl-disable-client-state (enable-cap color-array))
   (gl-disable-client-state (enable-cap vertex-array)))
 
@@ -78,14 +55,18 @@
            (x- (- x 0.5))
            (y- (- y 0.5))
            (x+ (+ x 0.5))
-           (y+ (+ y 0.5)))
-       (pack *quads* n color-quad
+           (y+ (+ y 0.5))
+           (base (* n 4)))
+       (pack *vertices* base color-vertex
              x- y- z
-             r g b
+             r g b)
+       (pack *vertices* (+ base 1) color-vertex
              x+ y- z
-             r g b
+             r g b)
+       (pack *vertices* (+ base 2) color-vertex
              x+ y+ z
-             r g b
+             r g b)
+       (pack *vertices* (+ base 3) color-vertex
              x- y+ z
              r g b)))))
 
@@ -110,7 +91,7 @@
 
 (define (prepare-particles n)
   (set! *particles* (make-packed-array particle n))
-  (set! *quads* (make-packed-array color-quad n))
+  (set! *vertices* (make-packed-array color-vertex (* n 4)))
   (pack-each
    *particles*
    particle
diff --git a/figl/contrib/packed-struct.scm b/figl/contrib/packed-struct.scm
index d962de1..19f43b4 100644
--- a/figl/contrib/packed-struct.scm
+++ b/figl/contrib/packed-struct.scm
@@ -27,6 +27,7 @@
   #:export (
             define-packed-struct
             packed-struct-size
+            packed-struct-offset
             pack pack* unpack unpack*
 
             make-packed-array
@@ -100,6 +101,11 @@
              #`(define-inlinable (name method field)
                  (case method
                    ((size) byte-size)
+                   ((offset)
+                    (case field
+                      ((field-name) field-offset)
+                      ...
+                      (else (error "unknown field" field))))
                    ((unpacker)
                     (lambda (bv offset k)
                       (k (field-ref bv (+ offset field-offset))
@@ -126,6 +132,9 @@
 (define-syntax-rule (packed-struct-size type)
   (type 'size #f))
 
+(define-syntax-rule (packed-struct-offset type field)
+  (type 'offset 'field))
+
 (define-syntax-rule (packed-struct-getter type field)
   (type 'getter 'field))
 
-- 
2.20.1