mesh: Use new renderer API.

* sly/mesh.scm (<vertex-buffer>, %make-vertex-buffer, vertex-buffer?,
  vertex-buffer-id, vertex-buffer-type, vertex-buffer-attr-size,
  vertex-buffer-length, generate-vertex-buffer, bind-vertex-buffer,
  with-vertex-buffer, vertices-bytevector, attribute-size,
  gl-buffer-type, make-vertex-buffer, generate-vertex-array,
  with-vertex-array, vertex-attrib-pointer): Remove old vertex
  buffer/array procedures.
  (mesh-length, draw-mesh): Delete.
  (mesh-shader): New procedure.
  (make-mesh): Reimplement.
  (draw): New method.
* sly/shape.scm (make-cube): Decouple from scene node. Use new mesh
  constructor.
* sly/sprite.scm (make-sprite): Likewise.

3 files changed, 108 insertions, 242 deletions

diff --git a/sly/mesh.scm b/sly/mesh.scm
index 89e700c..568aa90 100644
--- a/sly/mesh.scm
+++ b/sly/mesh.scm
@@ -22,10 +22,9 @@
 ;;; Code:
 
 (define-module (sly mesh)
+  #:use-module (oop goops)
   #:use-module (ice-9 match)
-  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-43)
   #:use-module (system foreign)
   #:use-module (gl)
   #:use-module (gl low-level)
@@ -35,159 +34,35 @@
   #:use-module (sly texture)
   #:use-module (sly math vector)
   #:use-module (sly signal)
+  #:use-module (sly transform)
+  #:use-module (sly render utils)
+  #:use-module (sly render vertex-array)
+  #:use-module (sly render renderer)
   #:export (make-mesh
             mesh?
             mesh-length
             mesh-shader
             mesh-texture
-            draw-mesh))
-
-;;;
-;;; Vertex Buffers and Vertex Arrays
-;;;
-
-(define-record-type <vertex-buffer>
-  (%make-vertex-buffer id type attr-size length)
-  vertex-buffer?
-  (id vertex-buffer-id)
-  (type vertex-buffer-type)
-  (attr-size vertex-buffer-attr-size)
-  (length vertex-buffer-length))
-
-(define (generate-vertex-buffer)
-  (let ((bv (u32vector 1)))
-    (glGenBuffers 1 (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define (bind-vertex-buffer vbo)
-  (glBindBuffer (vertex-buffer-type vbo)
-                (vertex-buffer-id vbo)))
-
-(define-syntax-rule (with-vertex-buffer vbo body ...)
-  (let ((type (vertex-buffer-type vbo)))
-    (glBindBuffer type (vertex-buffer-id vbo))
-    body ...
-    (glBindBuffer type 0)))
-
-(define (vertices-bytevector vertices index?)
-  (let* ((elem (vector-ref vertices 0))
-         (bv (if index?
-                 (make-u32vector (vector-length vertices))
-                 (make-f32vector (* (vector-length vertices)
-                                    (attribute-size elem)))))
-         (setter (if index? u32vector-set! f32vector-set!)))
-    (vector-for-each
-     (match-lambda*
-      ((i (? number? k))
-       (setter bv i k))
-      ((i ($ <vector2> x y))
-       (let ((offset (* i 2)))
-         (setter bv offset x)
-         (setter bv (1+ offset) y)))
-      ((i ($ <vector3> x y z))
-       (let ((offset (* i 3)))
-         (setter bv offset x)
-         (setter bv (1+ offset) y)
-         (setter bv (+ offset 2) z)))
-      ((i ($ <vector4> x y z w))
-       (let ((offset (* i 4)))
-         (setter bv offset x)
-         (setter bv (1+ offset) y)
-         (setter bv (+ offset 2) z)
-         (setter bv (+ offset 3) w)))
-      ((i (color? c))
-       (let ((offset (* i 4)))
-         (setter bv offset (color-r c))
-         (setter bv (1+ offset) (color-g c))
-         (setter bv (+ offset 2) (color-b c))
-         (setter bv (+ offset 3) (color-a c)))))
-     vertices)
-    bv))
-
-(define (attribute-size attr)
-  (cond
-   ((number? attr) 1)
-   ((vector2? attr) 2)
-   ((vector3? attr) 3)
-   ((or (vector4? attr)
-        (color? attr))
-    4)
-   (else
-    (error "Unsupported attribute: " attr))))
-
-(define (gl-buffer-type index?)
-  (if index?
-      (arb-vertex-buffer-object element-array-buffer-arb)
-      (arb-vertex-buffer-object array-buffer-arb)))
-
-(define* (make-vertex-buffer vertices #:optional (index? #f))
-  (let ((bv (vertices-bytevector vertices index?))
-        (vbo (%make-vertex-buffer (generate-vertex-buffer)
-                                  (gl-buffer-type index?)
-                                  (attribute-size (vector-ref vertices 0))
-                                  (vector-length vertices))))
-    (with-vertex-buffer vbo
-      (glBufferData (vertex-buffer-type vbo)
-                    (bytevector-length bv)
-                    (bytevector->pointer bv)
-                    (arb-vertex-buffer-object static-draw-arb)))
-    vbo))
-
-(define (generate-vertex-array)
-  (let ((bv (u32vector 1)))
-    (glGenVertexArrays 1 (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define-syntax-rule (with-vertex-array vao body ...)
-  (begin
-    (glBindVertexArray vao)
-    body ...
-    (glBindVertexArray 0)))
-
-(define (vertex-attrib-pointer shader attribute vbo)
-  (let ((location (shader-program-attribute-location shader attribute)))
-    (glEnableVertexAttribArray location)
-    (with-vertex-buffer vbo
-      (glVertexAttribPointer location (vertex-buffer-attr-size vbo)
-                             (data-type float) #f 0 %null-pointer))))
+            mesh->render-op))
 
 ;;;
 ;;; Mesh
 ;;;
 
 (define-record-type <mesh>
-  (%make-mesh vao length shader)
+  (%make-mesh vao shader texture)
   mesh?
   (vao mesh-vao)
-  (length mesh-length)
-  (shader mesh-shader))
-
-(define* (make-mesh #:optional #:key shader indices data)
-  (let ((vao (generate-vertex-array)))
-    (with-vertex-array vao
-      (let loop ((data data))
-        (match data
-          (((attribute vertices) . rest)
-           (vertex-attrib-pointer shader attribute
-                                  (make-vertex-buffer vertices))
-           (loop rest))
-          (() #f)))
-      (bind-vertex-buffer (make-vertex-buffer indices #t)))
-    (%make-mesh vao (vector-length indices) shader)))
-
-(define (draw-mesh mesh uniforms)
-  (define (draw)
-    (glDrawElements (begin-mode triangles)
-                    (mesh-length mesh)
-                    (data-type unsigned-int)
-                    %null-pointer))
-
-  (with-shader-program (mesh-shader mesh)
-    (for-each (lambda (uniform)
-                (match uniform
-                  ((name value)
-                   (uniform-set! (mesh-shader mesh) name
-                                 (signal-ref-maybe value)))))
-              uniforms)
-    (with-vertex-array (mesh-vao mesh)
-      (draw))))
+  (shader mesh-shader)
+  (texture mesh-texture))
+
+(define* (make-mesh #:optional #:key shader texture indices positions textures)
+  (%make-mesh (make-vertex-array indices positions textures)
+              shader texture))
+
+(define-method (draw (mesh <<mesh>>) transform)
+  (make-render-op #:vertex-array (mesh-vao mesh)
+                  #:texture (mesh-texture mesh)
+                  #:shader (mesh-shader mesh)
+                  #:uniforms `(("color" ,white))
+                  #:transform transform))
diff --git a/sly/shape.scm b/sly/shape.scm
index b71f59c..ed9e440 100644
--- a/sly/shape.scm
+++ b/sly/shape.scm
@@ -24,7 +24,6 @@
 (define-module (sly shape)
   #:use-module (sly math)
   #:use-module (sly mesh)
-  #:use-module (sly scene)
   #:use-module (sly shader)
   #:use-module (sly texture)
   #:use-module (sly math vector)
@@ -33,90 +32,85 @@
 (define* (make-cube size #:optional #:key (texture #f)
                     (shader (load-default-shader)))
   (let ((half-size (half size)))
-    (make-scene-node
+    (make-mesh
+     #:shader shader
      #:texture texture
-     #:children
-     (make-mesh
-      #:shader shader
-      #:indices #(
+     #:indices #(
+                 ;; 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)
+     #:positions (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
-                  4 6 7 4 5 6
+                  (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
-                  8 11 10 8 10 9
+                  (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
-                  12 14 15 12 13 14
+                  (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
-                  16 19 18 16 18 17
+                  (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
-                  20 22 23 20 21 22)
-      #:data `(("position" ,(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)))
-               ,@(if texture
-                     (let ((s1 (texture-s1 texture))
-                           (t1 (texture-t1 texture))
-                           (s2 (texture-s2 texture))
-                           (t2 (texture-t2 texture)))
-                       `(("tex"
-                          ,(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)))))
-                     '()))))))
+                  (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))
+     #:textures (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))))))
diff --git a/sly/sprite.scm b/sly/sprite.scm
index 644d766..f6f2d78 100644
--- a/sly/sprite.scm
+++ b/sly/sprite.scm
@@ -34,7 +34,6 @@
   #:use-module (sly helpers)
   #:use-module (sly math)
   #:use-module (sly mesh)
-  #:use-module (sly scene)
   #:use-module (sly shader)
   #:use-module (sly signal)
   #:use-module (sly texture)
@@ -63,22 +62,20 @@ custom SHADER can be specified."
          (t1 (texture-t1 texture))
          (s2 (texture-s2 texture))
          (t2 (texture-t2 texture)))
-    (make-scene-node
+    (make-mesh
+     #:shader shader
      #:texture texture
-     #:children
-     (make-mesh
-      #:shader shader
-      #:indices #(0 3 2 0 2 1)
-      #:data `(("position" ,(vector
-                             (vector3 x1 y1 0)
-                             (vector3 x2 y1 0)
-                             (vector3 x2 y2 0)
-                             (vector3 x1 y2 0)))
-               ("tex" ,(vector
-                        (vector2 s1 t1)
-                        (vector2 s2 t1)
-                        (vector2 s2 t2)
-                        (vector2 s1 t2))))))))
+     #:indices #(0 3 2 0 2 1)
+     #:positions (vector
+                  (vector3 x1 y1 0)
+                  (vector3 x2 y1 0)
+                  (vector3 x2 y2 0)
+                  (vector3 x1 y2 0))
+     #:textures (vector
+                 (vector2 s1 t1)
+                 (vector2 s2 t1)
+                 (vector2 s2 t2)
+                 (vector2 s1 t2)))))
 
 (define* (load-sprite file-name #:optional #:key (shader (load-default-shader))
                       (anchor 'center) (color white))