render: mesh: Rewrite constructors and expose vertex buffers.

* sly/rener/mesh.scm (vertex-buffer-attribute-size): Reimplement.
  (type-size): New procedure.
  (with-vertex-buffer): Unbind buffer when done.
  (init-vertex-buffer-data!): New procedure.
  (make-vertex-buffer*): Remove.
  (bytevector->vertex-buffer, vector->vertex-buffer): New procedures.
  (make-vertex-buffer): Implement in terms of
  'bytevector->vertex-buffer'.
  (make-mesh): Change to accept pre-built vertex buffers.
  (build-mesh, mesh-ref): New procedures.
  (mesh-guadian): Destructure vertex buffer alist.
* sly/render/shape.scm (make-cube): Use 'build-mesh'.
* sly/render/sprite.scm (make-sprite): Likewise.
* sly/render/tile-map.scm (compile-tile-layer): Likewise.

4 files changed, 143 insertions, 116 deletions

diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm
index 569803e..9eea8ed 100644
--- a/sly/render/mesh.scm
+++ b/sly/render/mesh.scm
@@ -34,9 +34,14 @@
   #:use-module (sly math vector)
   #:use-module (sly render color)
   #:use-module (sly render shader)
-  #:export (make-mesh
+  #:export (make-vertex-buffer
+            bytevector->vertex-buffer vector->vertex-buffer
+            vertex-buffer? index-buffer?
+            vertex-buffer-id vertex-buffer-type vertex-buffer-usage
+            vertex-buffer-data vertex-buffer-length
+            make-mesh build-mesh null-mesh
             mesh?
-            mesh-id mesh-length
+            mesh-id mesh-length mesh-ref
             apply-mesh with-mesh))
 
 ;;;
@@ -61,9 +66,10 @@
                 (vertex-buffer-id vbo)))
 
 (define-syntax-rule (with-vertex-buffer vbo body ...)
-  (begin
-    (bind-vertex-buffer vbo)
-    body ...))
+  (let ((target (vertex-buffer-target vbo)))
+    (glBindBuffer target (vertex-buffer-id vbo))
+    body ...
+    (glBindBuffer target 0)))
 
 (define attribute-type
   (match-lambda
@@ -122,13 +128,16 @@
      vertices)
     bv))
 
-(define (vertex-buffer-attribute-size vbo)
-  (match (vertex-buffer-type vbo)
+(define (type-size type)
+  (match type
     ((or 'float 'index) 1)
     ('vec2 2)
     ('vec3 3)
     ('vec4 4)))
 
+(define (vertex-buffer-attribute-size vbo)
+  (type-size (vertex-buffer-type vbo)))
+
 (define (index-buffer? vbo)
   (eq? (vertex-buffer-type vbo) 'index))
 
@@ -148,22 +157,31 @@
     ('stream
      (arb-vertex-buffer-object stream-draw-arb))))
 
-(define (make-vertex-buffer* type usage data)
-  (let ((vbo (%make-vertex-buffer (generate-vertex-buffer) type usage data)))
+(define (init-vertex-buffer-data! vbo)
+  (let ((data (vertex-buffer-data vbo)))
     (with-vertex-buffer vbo
       (glBufferData (vertex-buffer-target vbo)
                     (bytevector-length data)
                     (bytevector->pointer data)
-                    (vertex-buffer-usage-gl vbo)))
+                    (vertex-buffer-usage-gl vbo)))))
+
+(define (make-vertex-buffer type usage length)
+  (let ((data (if (eq? type 'index)
+                  (make-u32vector length)
+                  (make-f32vector (* (type-size type) length)))))
+    (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)
     vbo))
 
-(define* (make-vertex-buffer vertices #:optional (index? #f) (usage 'static))
-  (let ((data (vertices-bytevector vertices index?)))
-    (make-vertex-buffer* (if index?
-                             'index
-                             (attribute-type (vector-ref vertices 0)))
-                         usage
-                         data)))
+(define* (vector->vertex-buffer vertices #:optional (index? #f) (usage 'static))
+  (let ((data (vertices-bytevector vertices index?))
+        (type (if index?
+                  'index
+                  (attribute-type (vector-ref vertices 0)))))
+    (bytevector->vertex-buffer type usage data)))
 
 ;;;
 ;;; Mesh
@@ -182,7 +200,11 @@
     (glDeleteVertexArrays 1 (u32vector (mesh-id mesh)))
     (let ((buffers (mesh-vbos mesh)))
       (glDeleteBuffers (length buffers)
-                       (list->u32vector (map vertex-buffer-id buffers))))))
+                       (list->u32vector
+                        (map (match-lambda
+                              ((_ . vbo)
+                               (vertex-buffer-id vbo)))
+                             buffers))))))
 
 (define (generate-vertex-array)
   (let ((bv (u32vector 1)))
@@ -205,19 +227,24 @@
     (glVertexAttribPointer location (vertex-buffer-attribute-size vbo)
                            (data-type float) #f 0 %null-pointer)))
 
-(define (make-mesh indices positions textures)
-  (let* ((index-buffer (make-vertex-buffer indices #t))
-         (position-buffer (make-vertex-buffer positions))
-         (texture-buffer (make-vertex-buffer textures))
-         (mesh (%make-mesh (generate-vertex-array)
-                           (vector-length indices)
-                           (list index-buffer
-                                 position-buffer
-                                 texture-buffer))))
+(define (make-mesh index-buffer position-buffer texture-buffer)
+  (let ((mesh (%make-mesh (generate-vertex-array)
+                          (vertex-buffer-length index-buffer)
+                          `((index . ,index-buffer)
+                            (position . ,position-buffer)
+                            (texture . ,texture-buffer)))))
     (with-mesh mesh
       (vertex-attrib-pointer vertex-position-location position-buffer)
-      (if textures
-          (vertex-attrib-pointer vertex-texture-location texture-buffer))
+      (vertex-attrib-pointer vertex-texture-location texture-buffer)
       (bind-vertex-buffer index-buffer))
     (mesh-guardian mesh)
     mesh))
+
+(define (build-mesh indices positions textures)
+  (let ((index-buffer (vector->vertex-buffer indices #t))
+        (position-buffer (vector->vertex-buffer positions))
+        (texture-buffer (vector->vertex-buffer textures)))
+    (make-mesh index-buffer position-buffer texture-buffer)))
+
+(define (mesh-ref mesh key)
+  (assq-ref (mesh-vbos mesh) key))
diff --git a/sly/render/shape.scm b/sly/render/shape.scm
index 2df6b93..8e374b3 100644
--- a/sly/render/shape.scm
+++ b/sly/render/shape.scm
@@ -33,83 +33,83 @@
 (define* (make-cube size #:optional #:key (texture #f)
                     (shader (load-default-shader)))
   (let* ((half-size (half size))
-         (mesh (make-mesh #(
+         (mesh (build-mesh #(
+                             ;; Front
+                             0 3 2 0 2 1
+                               ;; Back
+                               4 6 7 4 5 6
+                               ;; Top
+                               8 11 10 8 10 9
+                               ;; Bottom
+                               12 14 15 12 13 14
+                               ;; Left
+                               16 19 18 16 18 17
+                               ;; Right
+                               20 22 23 20 21 22)
+                           (vector
                             ;; Front
-                            0 3 2 0 2 1
+                            (vector3 (- half-size) (- half-size) (- half-size))
+                            (vector3 half-size (- half-size) (- half-size))
+                            (vector3 half-size half-size (- half-size))
+                            (vector3 (- half-size) half-size (- half-size))
+                            ;; Back
+                            (vector3 (- half-size) (- half-size) half-size)
+                            (vector3 half-size (- half-size) half-size)
+                            (vector3 half-size half-size half-size)
+                            (vector3 (- half-size) half-size half-size)
+                            ;; Top
+                            (vector3 (- half-size) half-size (- half-size))
+                            (vector3 half-size half-size (- half-size))
+                            (vector3 half-size half-size half-size)
+                            (vector3 (- half-size) half-size half-size)
+                            ;; Bottom
+                            (vector3 (- half-size) (- half-size) (- half-size))
+                            (vector3 half-size (- half-size) (- half-size))
+                            (vector3 half-size (- half-size) half-size)
+                            (vector3 (- half-size) (- half-size) half-size)
+                            ;; Left
+                            (vector3 (- half-size) (- half-size) (- half-size))
+                            (vector3 (- half-size) half-size (- half-size))
+                            (vector3 (- half-size) half-size half-size)
+                            (vector3 (- half-size) (- half-size) half-size)
+                            ;; Right
+                            (vector3 half-size (- half-size) (- half-size))
+                            (vector3 half-size half-size (- half-size))
+                            (vector3 half-size half-size half-size)
+                            (vector3 half-size (- half-size) half-size))
+                           (let ((s1 (texture-s1 texture))
+                                 (t1 (texture-t1 texture))
+                                 (s2 (texture-s2 texture))
+                                 (t2 (texture-t2 texture)))
+                             (vector
+                              ;; Front
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2)
                               ;; Back
-                              4 6 7 4 5 6
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2)
                               ;; Top
-                              8 11 10 8 10 9
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2)
                               ;; Bottom
-                              12 14 15 12 13 14
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2)
                               ;; Left
-                              16 19 18 16 18 17
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2)
                               ;; Right
-                              20 22 23 20 21 22)
-                          (vector
-                           ;; Front
-                           (vector3 (- half-size) (- half-size) (- half-size))
-                           (vector3 half-size (- half-size) (- half-size))
-                           (vector3 half-size half-size (- half-size))
-                           (vector3 (- half-size) half-size (- half-size))
-                           ;; Back
-                           (vector3 (- half-size) (- half-size) half-size)
-                           (vector3 half-size (- half-size) half-size)
-                           (vector3 half-size half-size half-size)
-                           (vector3 (- half-size) half-size half-size)
-                           ;; Top
-                           (vector3 (- half-size) half-size (- half-size))
-                           (vector3 half-size half-size (- half-size))
-                           (vector3 half-size half-size half-size)
-                           (vector3 (- half-size) half-size half-size)
-                           ;; Bottom
-                           (vector3 (- half-size) (- half-size) (- half-size))
-                           (vector3 half-size (- half-size) (- half-size))
-                           (vector3 half-size (- half-size) half-size)
-                           (vector3 (- half-size) (- half-size) half-size)
-                           ;; Left
-                           (vector3 (- half-size) (- half-size) (- half-size))
-                           (vector3 (- half-size) half-size (- half-size))
-                           (vector3 (- half-size) half-size half-size)
-                           (vector3 (- half-size) (- half-size) half-size)
-                           ;; Right
-                           (vector3 half-size (- half-size) (- half-size))
-                           (vector3 half-size half-size (- half-size))
-                           (vector3 half-size half-size half-size)
-                           (vector3 half-size (- half-size) half-size))
-                          (let ((s1 (texture-s1 texture))
-                                (t1 (texture-t1 texture))
-                                (s2 (texture-s2 texture))
-                                (t2 (texture-t2 texture)))
-                            (vector
-                             ;; Front
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2)
-                             ;; Back
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2)
-                             ;; Top
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2)
-                             ;; Bottom
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2)
-                             ;; Left
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2)
-                             ;; Right
-                             (vector2 s1 t1)
-                             (vector2 s2 t1)
-                             (vector2 s2 t2)
-                             (vector2 s1 t2))))))
+                              (vector2 s1 t1)
+                              (vector2 s2 t1)
+                              (vector2 s2 t2)
+                              (vector2 s1 t2))))))
     (make-model #:mesh mesh #:texture texture #:shader shader)))
diff --git a/sly/render/sprite.scm b/sly/render/sprite.scm
index e57eaef..9f06f56 100644
--- a/sly/render/sprite.scm
+++ b/sly/render/sprite.scm
@@ -59,17 +59,17 @@ custom SHADER can be specified."
          (t1 (texture-t1 texture))
          (s2 (texture-s2 texture))
          (t2 (texture-t2 texture))
-         (mesh (make-mesh #(0 3 2 0 2 1)
-                          (vector
-                           (vector3 x1 y1 0)
-                           (vector3 x2 y1 0)
-                           (vector3 x2 y2 0)
-                           (vector3 x1 y2 0))
-                          (vector
-                           (vector2 s1 t1)
-                           (vector2 s2 t1)
-                           (vector2 s2 t2)
-                           (vector2 s1 t2)))))
+         (mesh (build-mesh #(0 3 2 0 2 1)
+                           (vector
+                            (vector3 x1 y1 0)
+                            (vector3 x2 y1 0)
+                            (vector3 x2 y2 0)
+                            (vector3 x1 y2 0))
+                           (vector
+                            (vector2 s1 t1)
+                            (vector2 s2 t1)
+                            (vector2 s2 t2)
+                            (vector2 s1 t2)))))
     (make-model #:shader shader
                 #:texture texture
                 #:mesh mesh
diff --git a/sly/render/tile-map.scm b/sly/render/tile-map.scm
index f47e593..8e8cd0f 100644
--- a/sly/render/tile-map.scm
+++ b/sly/render/tile-map.scm
@@ -121,9 +121,9 @@ equal elements."
 
   (map (match-lambda
         ((texture (indices positions textures))
-         (make-model #:mesh (make-mesh (list->vector (offset-indices indices))
-                                       (list->vector positions)
-                                       (list->vector textures))
+         (make-model #:mesh (build-mesh (list->vector (offset-indices indices))
+                                        (list->vector positions)
+                                        (list->vector textures))
                      #:texture texture
                      #:shader shader)))
        vertices))