graphics: sprite: Use dynamic geometry type.

2 files changed, 86 insertions, 198 deletions

diff --git a/chickadee/graphics/sprite.scm b/chickadee/graphics/sprite.scm
index 7c36623..4f0d809 100644
--- a/chickadee/graphics/sprite.scm
+++ b/chickadee/graphics/sprite.scm
@@ -1,5 +1,5 @@
 ;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2019, 2020 David Thompson <davet@gnu.org>
 ;;;
 ;;; Chickadee is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published
@@ -93,40 +93,15 @@ void main (void) {
 }
 ")))
 
+(define-geometry-type <sprite-vertex>
+  sprite-vertex-ref
+  sprite-vertex-set!
+  sprite-vertex-append!
+  (position vec2)
+  (texture vec2))
+
 (define draw-sprite*
-  (let* ((stride 16)            ; 4 f32s, 2 for vertex, 2 for texcoord
-         (buffer (delay
-                   (make-buffer #f
-                                #:name "unbatched sprite buffer"
-                                #:length (* stride 4)
-                                #:stride stride
-                                #:usage 'stream)))
-         (pos (delay
-                (make-buffer-view #:name "unbatched sprite vertices"
-                                  #:buffer (force buffer)
-                                  #:type 'vec2
-                                  #:component-type 'float
-                                  #:length 4)))
-         (tex (delay
-                (make-buffer-view #:name "unbatched sprite texcoords"
-                                  #:buffer (force buffer)
-                                  #:type 'vec2
-                                  #:component-type 'float
-                                  #:length 4
-                                  #:offset 8)))
-         (indices
-          (delay
-            (make-buffer-view #:name "unbatched sprite indices"
-                              #:type 'scalar
-                              #:component-type 'unsigned-int
-                              #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
-                                                    #:target 'index))))
-         (vertex-array
-          (delay
-            (make-vertex-array #:indices (force indices)
-                               #:attributes
-                               `((0 . ,(force pos))
-                                 (1 . ,(force tex))))))
+  (let* ((geometry (delay (make-geometry <sprite-vertex> 4 #:index-capacity 6)))
          (mvp (make-null-matrix4)))
     (lambda* (texture
               rect
@@ -135,44 +110,35 @@ void main (void) {
               (tint white)
               (blend-mode 'alpha)
               (texcoords (texture-gl-tex-rect texture)))
-      (with-mapped-buffer-view (force pos)
-        (let* ((x1 (rect-x rect))
-               (y1 (rect-y rect))
-               (x2 (+ x1 (rect-width rect)))
-               (y2 (+ y1 (rect-height rect)))
-               (s1 (rect-x texcoords))
-               (t1 (rect-y texcoords))
-               (s2 (+ (rect-x texcoords) (rect-width texcoords)))
-               (t2 (+ (rect-y texcoords) (rect-height texcoords)))
-               (bv (buffer-view-data (force pos))))
-          ;; Texture origin is at the top-left, so we need to flip the Y
-          ;; coordinate relative to the vertices.
-          (f32vector-set! bv 0 x1)
-          (f32vector-set! bv 1 y1)
-          (f32vector-set! bv 2 s1)
-          (f32vector-set! bv 3 t2)
-          (f32vector-set! bv 4 x2)
-          (f32vector-set! bv 5 y1)
-          (f32vector-set! bv 6 s2)
-          (f32vector-set! bv 7 t2)
-          (f32vector-set! bv 8 x2)
-          (f32vector-set! bv 9 y2)
-          (f32vector-set! bv 10 s2)
-          (f32vector-set! bv 11 t1)
-          (f32vector-set! bv 12 x1)
-          (f32vector-set! bv 13 y2)
-          (f32vector-set! bv 14 s1)
-          (f32vector-set! bv 15 t1)))
-      (with-blend-mode blend-mode
-        (with-texture 0 texture
-          (gpu-apply (force unbatched-sprite-shader) (force vertex-array)
-                     #:tint tint
-                     #:mvp (if matrix
-                               (begin
-                                 (matrix4-mult! mvp matrix
-                                                (current-projection))
-                                 mvp)
-                               (current-projection))))))))
+      (let ((geometry (force geometry)))
+        (with-geometry geometry
+          (let* ((x1 (rect-x rect))
+                 (y1 (rect-y rect))
+                 (x2 (+ x1 (rect-width rect)))
+                 (y2 (+ y1 (rect-height rect)))
+                 (s1 (rect-x texcoords))
+                 (t1 (rect-y texcoords))
+                 (s2 (+ (rect-x texcoords) (rect-width texcoords)))
+                 (t2 (+ (rect-y texcoords) (rect-height texcoords))))
+            ;; Texture origin is at the top-left, so we need to flip the Y
+            ;; coordinate relative to the vertices.
+            (sprite-vertex-append! geometry
+                                   (x1 y1 s1 t2)
+                                   (x2 y1 s2 t2)
+                                   (x2 y2 s2 t1)
+                                   (x1 y2 s1 t1))
+            (geometry-index-append! geometry 0 3 2 0 2 1)))
+        (with-blend-mode blend-mode
+          (with-texture 0 texture
+            (gpu-apply (force unbatched-sprite-shader)
+                       (geometry-vertex-array geometry)
+                       #:tint tint
+                       #:mvp (if matrix
+                                 (begin
+                                   (matrix4-mult! mvp matrix
+                                                  (current-projection))
+                                   mvp)
+                                 (current-projection)))))))))
 
 (define %null-vec2 (vec2 0.0 0.0))
 (define %default-scale (vec2 1.0 1.0))
@@ -214,94 +180,37 @@ BLEND-MODE."
 ;;; Sprite Batches
 ;;;
 
+(define-geometry-type <batched-sprite-vertex>
+  batched-sprite-ref
+  batched-sprite-set!
+  batched-sprite-append!
+  (position vec2)
+  (texture vec2)
+  (tint vec4))
+
 (define-record-type <sprite-batch>
-  (%make-sprite-batch texture size capacity vertex-buffer vertex-array)
+  (%make-sprite-batch texture geometry size)
   sprite-batch?
   (texture sprite-batch-texture set-sprite-batch-texture!)
-  (size sprite-batch-size set-sprite-batch-size!)
-  (capacity sprite-batch-capacity set-sprite-batch-capacity!)
-  (vertex-buffer sprite-batch-vertex-buffer set-sprite-batch-vertex-buffer!)
-  (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))
-
-(define (init-sprite-batch batch capacity)
-  (let* ((index-data (let ((bv (make-u32vector (* capacity 6))))
-                       (let loop ((i 0))
-                         (when (< i capacity)
-                               (let ((index-offset (* i 6))
-                                     (vertex-offset (* i 4)))
-                                 (u32vector-set! bv index-offset vertex-offset)
-                                 (u32vector-set! bv (+ index-offset 1) (+ vertex-offset 3))
-                                 (u32vector-set! bv (+ index-offset 2) (+ vertex-offset 2))
-                                 (u32vector-set! bv (+ index-offset 3) vertex-offset)
-                                 (u32vector-set! bv (+ index-offset 4) (+ vertex-offset 2))
-                                 (u32vector-set! bv (+ index-offset 5) (+ vertex-offset 1))
-                                 (loop (+ i 1)))))
-                       bv))
-         (index-buffer (make-buffer index-data
-                                    #:name "indices"
-                                    #:target 'index))
-         (indices (make-buffer-view #:name "indices"
-                                    #:buffer index-buffer
-                                    #:type 'scalar
-                                    #:component-type 'unsigned-int))
-         (stride 32) ; 8 f32s, 2 for vertex, 2 for texcoord, 4 for tint color
-         (buffer (make-buffer #f
-                              #:name "sprite batch buffer"
-                              #:length (* capacity stride 4)
-                              #:stride stride
-                              #:usage 'stream))
-         (pos (make-buffer-view #:name "sprite batch vertices"
-                                #:buffer buffer
-                                #:type 'vec2
-                                #:component-type 'float
-                                #:length (* capacity 4)))
-         (tex (make-buffer-view #:name "sprite batch texture coordinates"
-                                #:buffer buffer
-                                #:type 'vec2
-                                #:component-type 'float
-                                #:length (* capacity 4)
-                                #:offset 8))
-         (tint (make-buffer-view #:name "sprite batch tint colors"
-                                 #:buffer buffer
-                                 #:type 'vec4
-                                 #:component-type 'float
-                                 #:length (* capacity 4)
-                                 #:offset 16))
-         (va (make-vertex-array #:indices indices
-                                #:attributes `((0 . ,pos)
-                                               (1 . ,tex)
-                                               (2 . ,tint)))))
-    (set-sprite-batch-capacity! batch capacity)
-    (set-sprite-batch-vertex-buffer! batch buffer)
-    (set-sprite-batch-vertex-array! batch va)))
+  (geometry sprite-batch-geometry)
+  (size sprite-batch-size set-sprite-batch-size!))
 
 (define* (make-sprite-batch texture #:key (capacity 256))
-  "Make a sprite batch that can hold CAPACITY sprites."
-  (let ((batch (%make-sprite-batch texture 0 0 #f #f)))
-    (init-sprite-batch batch capacity)
-    batch))
-
-(define (sprite-batch-full? batch)
-  (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
-
-(define (double-sprite-batch-size! batch)
-  (let* ((old-verts (sprite-batch-vertex-buffer batch))
-         (old-vertex-data (buffer-data old-verts)))
-    (unmap-buffer! old-verts)
-    (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
-    (let ((new-verts (sprite-batch-vertex-buffer batch)))
-      (map-buffer! new-verts 'write-only)
-      (bytevector-copy! old-vertex-data 0
-                        (buffer-data new-verts) 0
-                        (bytevector-length old-vertex-data)))))
+  "Make a sprite batch that can hold CAPACITY sprites before needing
+to resize."
+  (%make-sprite-batch texture
+                      (make-geometry <batched-sprite-vertex> (* capacity 4)
+                                     #:index-capacity (* capacity 6))
+                      0))
 
 (define (sprite-batch-clear! batch)
   "Reset BATCH to size 0."
-  (set-sprite-batch-size! batch 0))
+  (set-sprite-batch-size! batch 0)
+  (geometry-begin! (sprite-batch-geometry batch)))
 
 (define (sprite-batch-flush! batch)
   "Submit the contents of BATCH to the GPU."
-  (unmap-buffer! (sprite-batch-vertex-buffer batch)))
+  (geometry-end! (sprite-batch-geometry batch)))
 
 (define* (sprite-batch-add* batch rect matrix
                             #:key
@@ -310,13 +219,8 @@ BLEND-MODE."
   "Add RECT, transformed by MATRIX, to BATCH.  To render a subsection
 of the batch's texture, a texture object whose parent is the batch
 texture may be specified via the TEXTURE-REGION argument."
-  ;; Expand the buffers when necessary.
-  (when (sprite-batch-full? batch)
-        (double-sprite-batch-size! batch))
-  (map-buffer! (sprite-batch-vertex-buffer batch) 'write-only)
-  (let* ((size (sprite-batch-size batch))
-         (vertices (buffer-data (sprite-batch-vertex-buffer batch)))
-         (offset (* size 32)) ; each sprite is 32 floats in size
+  (let* ((geometry (sprite-batch-geometry batch))
+         (vertex-offset (geometry-vertex-count geometry <batched-sprite-vertex>))
          (minx (rect-x rect))
          (miny (rect-y rect))
          (maxx (+ minx (rect-width rect)))
@@ -335,41 +239,24 @@ texture may be specified via the TEXTURE-REGION argument."
          (s1 (rect-x texcoords))
          (t1 (rect-y texcoords))
          (s2 (+ (rect-x texcoords) (rect-width texcoords)))
-         (t2 (+ (rect-y texcoords) (rect-height texcoords))))
-    ;; Add vertices.
-    ;; Bottom-left
-    (f32vector-set! vertices offset x1)
-    (f32vector-set! vertices (+ offset 1) y1)
-    ;; Bottom-right
-    (f32vector-set! vertices (+ offset 8) x2)
-    (f32vector-set! vertices (+ offset 9) y2)
-    ;; Top-right
-    (f32vector-set! vertices (+ offset 16) x3)
-    (f32vector-set! vertices (+ offset 17) y3)
-    ;; Top-left
-    (f32vector-set! vertices (+ offset 24) x4)
-    (f32vector-set! vertices (+ offset 25) y4)
-    ;; Add texture coordinates.
-    ;; Bottom-left
-    (f32vector-set! vertices (+ offset 2) s1)
-    (f32vector-set! vertices (+ offset 3) t2)
-    ;; Bottom-right
-    (f32vector-set! vertices (+ offset 10) s2)
-    (f32vector-set! vertices (+ offset 11) t2)
-    ;; Top-right
-    (f32vector-set! vertices (+ offset 18) s2)
-    (f32vector-set! vertices (+ offset 19) t1)
-    ;; Top-left
-    (f32vector-set! vertices (+ offset 26) s1)
-    (f32vector-set! vertices (+ offset 27) t1)
-    ;; Add tint.
-    (let ((bv ((@@ (chickadee graphics color) unwrap-color) tint))
-          (byte-offset (* offset 4)))
-      (bytevector-copy! bv 0 vertices (+ byte-offset 16) 16)
-      (bytevector-copy! bv 0 vertices (+ byte-offset 48) 16)
-      (bytevector-copy! bv 0 vertices (+ byte-offset 80) 16)
-      (bytevector-copy! bv 0 vertices (+ byte-offset 112) 16))
-    (set-sprite-batch-size! batch (1+ size))))
+         (t2 (+ (rect-y texcoords) (rect-height texcoords)))
+         (r (color-r tint))
+         (g (color-g tint))
+         (b (color-b tint))
+         (a (color-a tint)))
+    (batched-sprite-append! geometry
+                            (x1 y1 s1 t2 r g b a)
+                            (x2 y2 s2 t2 r g b a)
+                            (x3 y3 s2 t1 r g b a)
+                            (x4 y4 s1 t1 r g b a))
+    (geometry-index-append! geometry
+                            vertex-offset
+                            (+ vertex-offset 3)
+                            (+ vertex-offset 2)
+                            vertex-offset
+                            (+ vertex-offset 2)
+                            (+ vertex-offset 1))
+    (set-sprite-batch-size! batch (+ (sprite-batch-size batch) 1))))
 
 (define sprite-batch-add!
   (let ((matrix (make-null-matrix4)))
@@ -458,11 +345,12 @@ void main (void) {
       (matrix4-mult! mvp matrix (current-projection))
       (with-blend-mode blend-mode
         (with-texture 0 (sprite-batch-texture batch)
-          (gpu-apply* (force batched-sprite-shader)
-                      (sprite-batch-vertex-array batch)
-                      0
-                      (* (sprite-batch-size batch) 6)
-                      #:mvp mvp))))))
+          (let ((geometry (sprite-batch-geometry batch)))
+            (gpu-apply* (force batched-sprite-shader)
+                        (geometry-vertex-array geometry)
+                        0
+                        (geometry-index-count geometry)
+                        #:mvp mvp)))))))
 
 (define draw-sprite-batch
   (let ((matrix (make-null-matrix4)))
diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm
index 30d8167..4b8d433 100644
--- a/examples/sprite-batch.scm
+++ b/examples/sprite-batch.scm
@@ -38,11 +38,11 @@
 (define (load)
   (set! *random-state* (random-state-from-platform))
   (set! texture (load-image "images/shot.png"))
-  (set! batch (make-sprite-batch texture #:capacity 8000))
+  (set! batch (make-sprite-batch texture #:capacity num-sprites))
   (script
    (forever
     (sleep 60)
-    (set! stats-text (stats-message)))))
+    (set! stats-text (pk 'stats (stats-message))))))
 
 (define stats-text-pos (vec2 4.0 464.0))
 (define (draw alpha)