From ab8564c1d60c1e8d52baee5d73d56ad007efe3a1 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 31 Aug 2020 09:38:23 -0400
Subject: render: buffer: Allow streaming buffers to be resized.

---
 chickadee/graphics/buffer.scm | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm
index 9e5a791..40ebce8 100644
--- a/chickadee/graphics/buffer.scm
+++ b/chickadee/graphics/buffer.scm
@@ -50,6 +50,7 @@
             apply-buffer
             map-buffer!
             unmap-buffer!
+            resize-buffer!
             with-mapped-buffer
             make-buffer-view
             make-streaming-buffer-view
@@ -89,7 +90,7 @@
   buffer?
   (id buffer-id)
   (name buffer-name)
-  (length buffer-length)
+  (length buffer-length set-buffer-length!)
   (stride buffer-stride)
   (target buffer-target)
   (usage buffer-usage)
@@ -142,7 +143,7 @@
 
 (define* (make-buffer data #:key
                       (name "anonymous")
-                      (length (bytevector-length data))
+                      (length (if data (bytevector-length data) 0))
                       (offset 0)
                       (stride 0)
                       (target 'vertex)
@@ -224,6 +225,24 @@ vertex buffer data back to the GPU."
   (gl-unmap-buffer (buffer-target-gl buffer))
   (set-buffer-data! buffer #f))
 
+(define (resize-buffer! buffer length)
+  "Resize BUFFER to LENGTH bytes, preserving all existing mapped data
+that that fits into the resized buffer.  Only streaming buffers can be
+resized."
+  (if (eq? (buffer-usage buffer) 'stream)
+      ;; Remap the buffer and copy old contents
+      (let ((old-bv (buffer-data buffer)))
+        (set-buffer-length! buffer length)
+        (when old-bv
+          (unmap-buffer! buffer)
+          ;; TODO: Set map mode in record
+          (map-buffer! buffer 'write-only)
+          (let ((new-bv (buffer-data buffer)))
+            (bytevector-copy! old-bv 0 new-bv 0
+                              (min (bytevector-length old-bv)
+                                   (bytevector-length new-bv))))))
+      (error "cannot resize static buffer")))
+
 (define-syntax-rule (with-mapped-buffer buffer body ...)
   (dynamic-wind
     (lambda ()
-- 
cgit v1.2.3