From 56b450c2268f2f18fc678c6943ee10a867b42dcd Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 5 Dec 2020 15:40:25 -0500
Subject: graphics: path: Use dynamic geometry type.

---
 chickadee/graphics/path.scm | 367 +++++++++++++++-----------------------------
 1 file changed, 122 insertions(+), 245 deletions(-)

diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
index ca1b0be..34e7f3c 100644
--- a/chickadee/graphics/path.scm
+++ b/chickadee/graphics/path.scm
@@ -755,80 +755,30 @@
 ;;; Stroked path
 ;;;
 
+(define-geometry-type <stroke-vertex>
+  stroke-vertex-ref
+  stroke-vertex-set!
+  stroke-vertex-append!
+  (position vec2)
+  (texture vec2)
+  (length float))
+
 ;; TODO: Allow for multiple path styles to be rendered in a single
 ;; draw call.  This will probably involve abusing textures to store
 ;; the per-path style info.  We can cross that bridge if we ever need
 ;; the extra performance.
 (define-record-type <stroked-path>
-  (%make-stroked-path vertex-count index-count
-                      vertex-capacity index-capacity
-                      vertex-buffer index-buffer vertex-array)
+  (%make-stroked-path geometry)
   stroked-path?
   (blend-mode stroked-path-blend-mode set-stroked-path-blend-mode!)
   (color stroked-path-color set-stroked-path-color!)
   (width stroked-path-width set-stroked-path-width!)
   (feather stroked-path-feather set-stroked-path-feather!)
   (cap stroked-path-cap set-stroked-path-cap!)
-  (vertex-count stroked-path-vertex-count set-stroked-path-vertex-count!)
-  (index-count stroked-path-index-count set-stroked-path-index-count!)
-  (vertex-capacity stroked-path-vertex-capacity set-stroked-path-vertex-capacity!)
-  (index-capacity stroked-path-index-capacity set-stroked-path-index-capacity!)
-  (vertex-buffer stroked-path-vertex-buffer)
-  (index-buffer stroked-path-index-buffer)
-  (vertex-array stroked-path-vertex-array))
-
-(define (resize-stroked-path-vertex-buffer! stroked-path capacity)
-  (resize-buffer! (stroked-path-vertex-buffer stroked-path)
-                  (* capacity (* 5 4))) ; 5 floats per vertex
-  (set-stroked-path-vertex-capacity! stroked-path capacity))
-
-(define (resize-stroked-path-index-buffer! stroked-path capacity)
-  (resize-buffer! (stroked-path-index-buffer stroked-path)
-                  (* capacity 4)) ; 4 bytes per index
-  (set-stroked-path-index-capacity! stroked-path capacity))
+  (geometry stroked-path-geometry))
 
 (define (make-stroked-path)
-  (let* ((vertex-buffer (make-buffer #f
-                                     #:name "stroke vertex buffer"
-                                     ;; Vertex layout:
-                                     ;; - x, y
-                                     ;; - u, v
-                                     ;; - length of current path
-                                     #:stride (* 5 4) ; 5 f32s
-                                     #:usage 'stream))
-         (index-buffer (make-buffer #f
-                                    #:name "stroke index buffer"
-                                    #:target 'index
-                                    #:usage 'stream))
-         (verts (make-buffer-view #:name "stroke vertices"
-                                  #:buffer vertex-buffer
-                                  #:type 'vec2
-                                  #:component-type 'float))
-         (tex (make-buffer-view #:name "stroke texcoords"
-                                #:buffer vertex-buffer
-                                #:type 'vec2
-                                #:component-type 'float
-                                #:offset 8))
-         (lengths (make-buffer-view #:name "stroke lengths"
-                                    #:buffer vertex-buffer
-                                    #:type 'scalar
-                                    #:component-type 'float
-                                    #:offset 16))
-         (index (make-buffer-view #:name "stroke index"
-                                  #:buffer index-buffer
-                                  #:type 'scalar
-                                  #:component-type 'unsigned-int))
-         (vertex-array (make-vertex-array #:indices index
-                                          #:attributes `((0 . ,verts)
-                                                         (1 . ,tex)
-                                                         (2 . ,lengths))))
-         (stroked-path (%make-stroked-path 0 0 0 0
-                                           vertex-buffer
-                                           index-buffer
-                                           vertex-array)))
-    (resize-stroked-path-vertex-buffer! stroked-path 128)
-    (resize-stroked-path-index-buffer! stroked-path 128)
-    stroked-path))
+  (%make-stroked-path (make-geometry <stroke-vertex> 32)))
 
 ;; Tesselation of stroked paths involves building rectangles composed
 ;; of 2 triangles for each line segment in the path.  This
@@ -843,70 +793,41 @@
   (set-stroked-path-width! stroked-path width)
   (set-stroked-path-feather! stroked-path feather)
   (set-stroked-path-cap! stroked-path cap)
-  ;; Initialize counts.
-  (set-stroked-path-vertex-count! stroked-path 0)
-  (set-stroked-path-index-count! stroked-path 0)
   ;; Tesselate.
-  (with-mapped-buffer (stroked-path-vertex-buffer stroked-path)
-    (with-mapped-buffer (stroked-path-index-buffer stroked-path)
-      (let ((points (compiled-path-points compiled-path))
-            (offsets (compiled-path-offsets compiled-path))
-            (counts (compiled-path-counts compiled-path))
-            (path-count (compiled-path-count compiled-path))
-            (padding (/ (ceiling (+ width (* feather 2.5))) 2.0)))
-        (define (add-points first? lx ly rx ry distance)
-          ;; Resize buffers, if necessary.
-          (let ((vert-count (stroked-path-vertex-count stroked-path))
-                (vert-capacity (stroked-path-vertex-capacity stroked-path))
-                (index-count (stroked-path-index-count stroked-path))
-                (index-capacity (stroked-path-index-capacity stroked-path)))
-            (when (> (+ vert-count 2) vert-capacity)
-              (resize-stroked-path-vertex-buffer! stroked-path
-                                                  (* vert-capacity 2))
-              (map-buffer! (stroked-path-vertex-buffer stroked-path)))
-            (when (> (+ index-count 6) index-capacity)
-              (resize-stroked-path-index-buffer! stroked-path
-                                                 (* index-capacity 2))
-              (map-buffer! (stroked-path-index-buffer stroked-path)))
-            (let ((verts (buffer-data
-                          (stroked-path-vertex-buffer stroked-path)))
-                  (voffset (* vert-count 5))) ; 5 floats per vertex
-              ;; Left:
-              ;; Position
-              (f32vector-set! verts voffset lx)
-              (f32vector-set! verts (+ voffset 1) ly)
-              ;; Distance from starting point
-              (f32vector-set! verts (+ voffset 2) distance)
-              ;; Distance from true line segment (used for antialising)
-              (f32vector-set! verts (+ voffset 3) padding)
-              ;; Right:
-              ;; Position
-              (f32vector-set! verts (+ voffset 5) rx)
-              (f32vector-set! verts (+ voffset 6) ry)
-              ;; Distance from starting point
-              (f32vector-set! verts (+ voffset 7) distance)
-              ;; Distance from true line segment
-              (f32vector-set! verts (+ voffset 8) (- padding)))
-            (set-stroked-path-vertex-count! stroked-path (+ vert-count 2))
-            ;; On the first iteration we only have 2 points which is
-            ;; not enough to create line segment geometry which
-            ;; requires looking at the newest 2 points + the 2
-            ;; previous points.
-            (unless first?
-              (let ((index (buffer-data
-                            (stroked-path-index-buffer stroked-path))))
-                (u32vector-set! index index-count (- vert-count 1))
-                (u32vector-set! index (+ index-count 1) (- vert-count 2))
-                (u32vector-set! index (+ index-count 2) vert-count)
-                (u32vector-set! index (+ index-count 3) (- vert-count 1))
-                (u32vector-set! index (+ index-count 4) vert-count)
-                (u32vector-set! index (+ index-count 5) (+ vert-count 1))
-                (set-stroked-path-index-count! stroked-path (+ index-count 6))))))
-      (define (set-length i length)
-        (let ((verts (buffer-data (stroked-path-vertex-buffer stroked-path)))
-              (voffset (* i 5 2)))
-          (f32vector-set! verts (+ voffset 4) length)
-          (f32vector-set! verts (+ voffset 9) length)))
+  (let ((points (compiled-path-points compiled-path))
+        (offsets (compiled-path-offsets compiled-path))
+        (counts (compiled-path-counts compiled-path))
+        (path-count (compiled-path-count compiled-path))
+        (padding (/ (ceiling (+ width (* feather 2.5))) 2.0))
+        (geometry (stroked-path-geometry stroked-path)))
+    (define (add-points first? lx ly rx ry distance)
+      (let ((vert-count (geometry-vertex-count geometry <stroke-vertex>)))
+        ;; Each vertex has the following data:
+        ;; - x
+        ;; - y
+        ;; - distance from starting point
+        ;; - distance from true line segment (used for antialising)
+        ;;
+        ;; First vertex is the left hand side, second is the right.
+        (stroke-vertex-append! geometry
+                               (lx ly distance padding 0.0)
+                               (rx ry distance (- padding) 0.0))
+        ;; On the first iteration we only have 2 points which is
+        ;; not enough to create line segment geometry which
+        ;; requires looking at the newest 2 points + the 2
+        ;; previous points.
+        (unless first?
+          (geometry-index-append! geometry
+                                  (- vert-count 1)
+                                  (- vert-count 2)
+                                  vert-count
+                                  (- vert-count 1)
+                                  vert-count
+                                  (+ vert-count 1)))))
+    (define (set-length i length)
+      (stroke-vertex-set! geometry length (* i 2) length)
+      (stroke-vertex-set! geometry length (+ (* i 2) 1) length))
+    (with-geometry geometry
       (let path-loop ((i 0))
         (when (< i path-count)
           (let* ((count (u32vector-ref counts i))
@@ -1059,70 +980,37 @@
                   (when (<= k last)
                     (set-length k distance)
                     (length-loop (+ k 1)))))))
-          (path-loop (+ i 1))))))))
+          (path-loop (+ i 1)))))))
 
 
 ;;;
 ;;; Filled path
 ;;;
 
+(define-geometry-type <fill-vertex>
+  fill-vertex-ref
+  fill-vertex-set!
+  fill-vertex-append!
+  (position vec2))
+
 (define-record-type <filled-path>
-  (%make-filled-path count stencil-vertex-count stencil-vertex-capacity
-                     stencil-vertex-buffer stencil-vertex-array
-                     quad-vertex-buffer quad-vertex-array)
+  (%make-filled-path count quad-geometry stencil-geometry)
   filled-path?
   (blend-mode filled-path-blend-mode set-filled-path-blend-mode!)
   (color filled-path-color set-filled-path-color!)
   (counts filled-path-counts set-filled-path-counts!)
   (offsets filled-path-offsets set-filled-path-offsets!)
   (count filled-path-count set-filled-path-count!)
-  (stencil-vertex-count filled-path-stencil-vertex-count
-                        set-filled-path-stencil-vertex-count!)
-  (stencil-vertex-capacity filled-path-stencil-vertex-capacity
-                           set-filled-path-stencil-vertex-capacity!)
-  (stencil-vertex-buffer filled-path-stencil-vertex-buffer)
-  (stencil-vertex-array filled-path-stencil-vertex-array)
-  (quad-vertex-buffer filled-path-quad-vertex-buffer)
-  (quad-vertex-array filled-path-quad-vertex-array))
-
-(define (resize-filled-path-stencil-vertex-buffer! filled-path capacity)
-  (resize-buffer! (filled-path-stencil-vertex-buffer filled-path)
-                  (* capacity 8)) ; 2 f32s per vertex: x y
-  (set-filled-path-stencil-vertex-capacity! filled-path capacity))
+  (stencil-geometry filled-path-stencil-geometry)
+  (quad-geometry filled-path-quad-geometry))
 
 (define (make-filled-path)
-  (let* ((quad-vertex-buffer (make-buffer #f
-                                          #:length (* 8 4) ; 8 f32s
-                                          #:name "fill quad vertices"
-                                          #:usage 'stream))
-         (quad-verts (make-buffer-view #:name "fill quad vertices"
-                                       #:buffer quad-vertex-buffer
-                                       #:type 'vec2
-                                       #:component-type 'float))
-         (quad-index (make-buffer-view #:name "fill quad index"
-                                       #:type 'scalar
-                                       #:component-type 'unsigned-int
-                                       #:buffer (make-buffer (u32vector 0 2 3 0 1 2)
-                                                             #:name "fill quad index"
-                                                             #:target 'index)))
-         (quad-vertex-array (make-vertex-array #:indices quad-index
-                                               #:attributes `((0 . ,quad-verts))))
-         (stencil-vertex-buffer (make-buffer #f
-                                             #:name "fill stencil vertices"
-                                             #:usage 'stream))
-         (stencil-verts (make-buffer-view #:name "fill stencil vertices"
-                                          #:buffer stencil-vertex-buffer
-                                          #:type 'vec2
-                                          #:component-type 'float))
-         (stencil-vertex-array (make-vertex-array #:attributes `((0 . ,stencil-verts))
-                                                  #:mode 'triangle-fan))
-         (filled-path (%make-filled-path 0 0 0
-                                         stencil-vertex-buffer
-                                         stencil-vertex-array
-                                         quad-vertex-buffer
-                                         quad-vertex-array)))
-    (resize-filled-path-stencil-vertex-buffer! filled-path 128)
-    filled-path))
+  (let* ((quad-geometry (make-geometry <fill-vertex> 4
+                                       #:index-capacity 6))
+         (stencil-geometry (make-geometry <fill-vertex> 32
+                                          #:index? #f
+                                          #:mode 'triangle-fan)))
+    (%make-filled-path 0 quad-geometry stencil-geometry)))
 
 (define* (fill-path filled-path compiled-path #:key blend-mode color)
   (let* ((points (compiled-path-points compiled-path))
@@ -1138,14 +1026,16 @@
          ;; GPU, though, and the center of the bounding box seems like
          ;; a sensible location.
          (ref-x (rect-center-x bbox))
-         (ref-y (rect-center-y bbox)))
+         (ref-y (rect-center-y bbox))
+         (quad-geometry (filled-path-quad-geometry filled-path))
+         (stencil-geometry (filled-path-stencil-geometry filled-path)))
     ;; Setup style.
     (set-filled-path-color! filled-path color)
     (set-filled-path-blend-mode! filled-path blend-mode)
     ;; Setup counts and offsets.
     (set-filled-path-count! filled-path 0)
-    (set-filled-path-stencil-vertex-count! filled-path 0)
     (set-filled-path-count! filled-path path-count)
+    ;; TODO: Don't allocate each time.
     (let ((bv (make-u32vector path-count)))
       (let loop ((i 0))
         (when (< i path-count)
@@ -1159,59 +1049,43 @@
           (loop (+ i 1))))
       (set-filled-path-offsets! filled-path bv))
     ;; Create geometry for the stencil buffer.
-    (with-mapped-buffer (filled-path-stencil-vertex-buffer filled-path)
-      (let loop ((i 0))
-       (when (< i path-count)
-         (let* ((count (u32vector-ref counts i))
-                (first (u32vector-ref offsets i))
-                (last (+ first count -1))
-                (n (filled-path-stencil-vertex-count filled-path)))
-           ;; Resize buffer, if necessary.
-           (let ((capacity (filled-path-stencil-vertex-capacity filled-path)))
-             (when (>= (+ n count 1) capacity)
-               (let ((new-capacity (let cloop ((c (* capacity 2)))
-                                     (if (> c (+ n count 1))
-                                         c
-                                         (cloop (* c 2))))))
-                 (resize-filled-path-stencil-vertex-buffer! filled-path
-                                                            new-capacity)
-                 (map-buffer! (filled-path-stencil-vertex-buffer filled-path)))))
-           (let ((verts (buffer-data (filled-path-stencil-vertex-buffer filled-path)))
-                 (offset (* n 2)))
-             ;; Build the triangle fan for the path.  This geometry
-             ;; will be used for a GPU-based implementation of the
-             ;; non-zero rule:
-             ;;
-             ;; See: https://en.wikipedia.org/wiki/Nonzero-rule
-             ;;
-             ;; Add reference point as the basis for each triangle in
-             ;; the fan.
-             (f32vector-set! verts offset ref-x)
-             (f32vector-set! verts (+ offset 1) ref-y)
-             ;; Now simply copy all the points in the path into the
-             ;; buffer.  Each point is stored as 2 f32s, so 8 bytes per
-             ;; point.
-             (bytevector-copy! points (* first 8) verts (* (+ n 1) 8) (* count 8))
-             (set-filled-path-stencil-vertex-count! filled-path (+ n count 1))))
-         (loop (+ i 1)))))
+    (geometry-begin! stencil-geometry)
+    (let loop ((i 0))
+      (when (< i path-count)
+        (let* ((count (u32vector-ref counts i))
+               (first (u32vector-ref offsets i))
+               (last (+ first count -1)))
+          ;; Build the triangle fan for the path.  This geometry
+          ;; will be used for a GPU-based implementation of the
+          ;; non-zero rule:
+          ;;
+          ;; See: https://en.wikipedia.org/wiki/Nonzero-rule
+          ;;
+          ;; Add reference point as the basis for each triangle in
+          ;; the fan.
+          (fill-vertex-append! stencil-geometry (ref-x ref-y))
+          ;; Now simply copy all the points in the path into the
+          ;; buffer.
+          (let inner ((i first))
+            (when (<= i last)
+              (fill-vertex-append! stencil-geometry
+                                   ((f32vector-ref points (* i 2))
+                                    (f32vector-ref points (+ (* i 2) 1))))
+              (inner (+ i 1)))))
+        (loop (+ i 1))))
+    (geometry-end! stencil-geometry)
     ;; Create simple quad covering the bounding box to be used for the
     ;; final render pass with stencil applied.
     ;;
     ;; TODO: A convex hull would result in less fragments to process.
-    (with-mapped-buffer (filled-path-quad-vertex-buffer filled-path)
-      (let ((verts (buffer-data (filled-path-quad-vertex-buffer filled-path)))
-           (x1 (rect-x bbox))
-           (y1 (rect-y bbox))
-           (x2 (rect-right bbox))
-           (y2 (rect-top bbox)))
-       (f32vector-set! verts 0 x1)
-       (f32vector-set! verts 1 y1)
-       (f32vector-set! verts 2 x2)
-       (f32vector-set! verts 3 y1)
-       (f32vector-set! verts 4 x2)
-       (f32vector-set! verts 5 y2)
-       (f32vector-set! verts 6 x1)
-       (f32vector-set! verts 7 y2)))))
+    (geometry-begin! quad-geometry)
+    (let ((x1 (rect-x bbox))
+          (y1 (rect-y bbox))
+          (x2 (rect-right bbox))
+          (y2 (rect-top bbox)))
+      (fill-vertex-append! quad-geometry (x1 y1) (x2 y1) (x2 y2) (x1 y2))
+      (geometry-index-append! quad-geometry 0 2 3 0 1 2))
+    (geometry-end! quad-geometry)))
 
 
 ;;;
@@ -1237,7 +1111,9 @@
 (define* (draw-filled-path filled-path matrix)
   (let ((counts (filled-path-counts filled-path))
         (offsets (filled-path-offsets filled-path))
-        (n (filled-path-count filled-path)))
+        (n (filled-path-count filled-path))
+        (quad-geometry (filled-path-quad-geometry filled-path))
+        (stencil-geometry (filled-path-stencil-geometry filled-path)))
     (matrix4-mult! *mvp* matrix (current-projection))
     ;; Wireframe debug mode.
     (when *debug?*
@@ -1245,7 +1121,7 @@
         (let loop ((i 0))
           (when (< i n)
             (gpu-apply* (force path-shader)
-                        (filled-path-stencil-vertex-array filled-path)
+                        (geometry-vertex-array stencil-geometry)
                         (u32vector-ref offsets i)
                         (u32vector-ref counts i)
                         #:mvp (current-projection)
@@ -1269,7 +1145,7 @@
           (let loop ((i 0))
             (when (< i n)
               (gpu-apply* (force path-shader)
-                          (filled-path-stencil-vertex-array filled-path)
+                          (geometry-vertex-array stencil-geometry)
                           (u32vector-ref offsets i)
                           (u32vector-ref counts i)
                           #:mvp *mvp*
@@ -1281,7 +1157,7 @@
       (with-stencil-test stencil-cover-and-clear
         (with-blend-mode (filled-path-blend-mode filled-path)
           (gpu-apply (force path-shader)
-                     (filled-path-quad-vertex-array filled-path)
+                     (geometry-vertex-array quad-geometry)
                      #:mvp *mvp*
                      #:mode 0
                      #:color (filled-path-color filled-path)))))))
@@ -1291,23 +1167,24 @@
 (define* (draw-stroked-path stroked-path matrix)
   (matrix4-mult! *mvp* matrix (current-projection))
   (with-blend-mode (stroked-path-blend-mode stroked-path)
-    (gpu-apply* (force path-shader)
-                (stroked-path-vertex-array stroked-path)
-                0
-                (stroked-path-index-count stroked-path)
-                #:mvp *mvp*
-                #:color (stroked-path-color stroked-path)
-                #:mode 1
-                #:feather (stroked-path-feather stroked-path)
-                #:stroke-cap (match (stroked-path-cap stroked-path)
-                               (#f 0) ; no cap
-                               ('butt 1)
-                               ('square 2)
-                               ('round 3)
-                               ('triangle-out 4)
-                               ('triangle-in 5)
-                               (x (error "unsupported line cap style" x)))
-                #:stroke-width (stroked-path-width stroked-path))))
+    (let ((geometry (stroked-path-geometry stroked-path)))
+      (gpu-apply* (force path-shader)
+                  (geometry-vertex-array geometry)
+                  0
+                  (geometry-index-count geometry)
+                  #:mvp *mvp*
+                  #:color (stroked-path-color stroked-path)
+                  #:mode 1
+                  #:feather (stroked-path-feather stroked-path)
+                  #:stroke-cap (match (stroked-path-cap stroked-path)
+                                 (#f 0) ; no cap
+                                 ('butt 1)
+                                 ('square 2)
+                                 ('round 3)
+                                 ('triangle-out 4)
+                                 ('triangle-in 5)
+                                 (x (error "unsupported line cap style" x)))
+                  #:stroke-width (stroked-path-width stroked-path)))))
 
 
 ;;;
-- 
cgit v1.2.3