From bb2b65d81d898860635eb64a5a81d0307f4dce17 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 1 Jan 2016 16:38:56 -0500
Subject: render: mesh: Add support for streaming vertex buffers.

* sly/render/mesh.scm (<vertex-buffer>)[length]: New field.
(vertex-buffer-length): Now return the length in bytes.
(vertex-buffer-element-length, make-streaming-vertex-buffer)
(map-vertex-buffer!, unmap-vertex-buffer!): New procedures.
(init-vertex-buffer-data!): Delete.
(bytevector->vertex-buffer): Move body of 'init-vertex-buffer-data!'
within.
(make-mesh): Use 'vertex-buffer-element-length'.
---
 sly/render/mesh.scm | 69 +++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 56 insertions(+), 13 deletions(-)

diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm
index 04a8ab2..acf9a0f 100644
--- a/sly/render/mesh.scm
+++ b/sly/render/mesh.scm
@@ -25,18 +25,21 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-43)
   #:use-module (system foreign)
   #:use-module (gl)
   #:use-module (gl low-level)
+  #:use-module (gl enums)
   #:use-module (sly utils)
   #:use-module (sly wrappers gl)
   #:use-module (sly math vector)
   #:use-module (sly render color)
   #:use-module (sly render shader)
-  #:export (make-vertex-buffer
+  #:export (make-streaming-vertex-buffer
+            make-vertex-buffer
             bytevector->vertex-buffer
             vector->vertex-buffer
             vertex-buffer?
@@ -46,8 +49,11 @@
             vertex-buffer-usage
             vertex-buffer-data
             vertex-buffer-length
+            vertex-buffer-element-length
             vertex-buffer-attribute-size
             apply-vertex-buffer
+            map-vertex-buffer!
+            unmap-vertex-buffer!
 
             generate-vertex-array
             vertex-attrib-pointer
@@ -68,17 +74,18 @@
 ;;;
 
 (define-record-type <vertex-buffer>
-  (%make-vertex-buffer id type usage data)
+  (%make-vertex-buffer id type usage length data)
   vertex-buffer?
   (id vertex-buffer-id)
   (type vertex-buffer-type)
   (usage vertex-buffer-usage)
-  (data vertex-buffer-data))
+  (length vertex-buffer-length)
+  (data vertex-buffer-data set-vertex-buffer-data!))
 
 (set-record-type-printer! <vertex-buffer>
   (lambda (vbo port)
     (format port
-            "#<vertex-buffer id: ~d type: ~a usage: ~a"
+            "#<vertex-buffer id: ~d type: ~a usage: ~a>"
             (vertex-buffer-id vbo)
             (vertex-buffer-type vbo)
             (vertex-buffer-usage vbo))))
@@ -173,7 +180,7 @@
       (arb-vertex-buffer-object element-array-buffer-arb)
       (arb-vertex-buffer-object array-buffer-arb)))
 
-(define (vertex-buffer-length vbo)
+(define (vertex-buffer-element-length vbo)
   (/ (bytevector-length (vertex-buffer-data vbo))
      (* (vertex-buffer-attribute-size vbo) 4)))
 
@@ -184,13 +191,22 @@
     ('stream
      (arb-vertex-buffer-object stream-draw-arb))))
 
-(define (init-vertex-buffer-data! vbo)
-  (let ((data (vertex-buffer-data vbo)))
+(define (make-streaming-vertex-buffer type length)
+  "Return a new vertex buffer of LENGTH elements suitable for
+streaming data to the GPU every frame.  TYPE is a symbol specifying
+the element type, either 'float', 'index', 'vec2', 'vec3', or 'vec4'."
+  (let ((vbo (%make-vertex-buffer (generate-vertex-buffer)
+                                  type
+                                  'stream
+                                  ;; All numbers are 32 bits e.g. 4 bytes
+                                  (* (type-size type) length 4)
+                                  #f)))
     (with-vertex-buffer vbo
       (glBufferData (vertex-buffer-target vbo)
-                    (bytevector-length data)
-                    (bytevector->pointer data)
-                    (vertex-buffer-usage-gl vbo)))))
+                    length
+                    %null-pointer
+                    (vertex-buffer-usage-gl vbo)))
+    vbo))
 
 (define (make-vertex-buffer type usage length)
   (let ((data (if (eq? type 'index)
@@ -199,8 +215,16 @@
     (bytevector->vertex-buffer type usage data)))
 
 (define (bytevector->vertex-buffer type usage bv)
-  (let ((vbo (%make-vertex-buffer (generate-vertex-buffer) type usage bv)))
-    (init-vertex-buffer-data! vbo)
+  (let ((vbo (%make-vertex-buffer (generate-vertex-buffer)
+                                  type
+                                  usage
+                                  (bytevector-length bv)
+                                  bv)))
+    (with-vertex-buffer vbo
+      (glBufferData (vertex-buffer-target vbo)
+                    (bytevector-length bv)
+                    (bytevector->pointer bv)
+                    (vertex-buffer-usage-gl vbo)))
     vbo))
 
 (define* (vector->vertex-buffer vertices #:optional (index? #f) (usage 'static))
@@ -210,6 +234,25 @@
                   (attribute-type (vector-ref vertices 0)))))
     (bytevector->vertex-buffer type usage data)))
 
+(define (map-vertex-buffer! vbo)
+  "Map the memory space for VBO from GPU to the CPU, which is then
+accessible via the vertex-buffer-data procedure.  This technique
+allows vertex buffers to be updated with new vertex data."
+  (let ((target (vertex-buffer-target vbo))
+        (length (vertex-buffer-length vbo))
+        (usage (vertex-buffer-usage-gl vbo)))
+    (with-vertex-buffer vbo
+      ;; Orphan the buffer to avoid implicit synchronization.
+      ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
+      (glBufferData target length %null-pointer usage)
+      (let ((ptr (glMapBuffer target (version-1-5 read-write))))
+        (set-vertex-buffer-data! vbo (pointer->bytevector ptr length))))))
+
+(define (unmap-vertex-buffer! vbo)
+  "Return the mapped vertex data for VBO to the GPU."
+  (with-vertex-buffer vbo
+    (glUnmapBuffer (vertex-buffer-target vbo))))
+
 ;;;
 ;;; Mesh
 ;;;
@@ -258,7 +301,7 @@
 
 (define (make-mesh index-buffer position-buffer texture-buffer)
   (let ((mesh (%make-mesh (generate-vertex-array)
-                          (vertex-buffer-length index-buffer)
+                          (vertex-buffer-element-length index-buffer)
                           `((index . ,index-buffer)
                             (position . ,position-buffer)
                             (texture . ,texture-buffer)))))
-- 
cgit v1.2.3