render: Add sprite batch.

Finally, we can have decent sprite rendering performance!

* sly/render/sprite-batch.scm: New file.
* Makefile.am (SOURCES): Add it.

3 files changed, 262 insertions, 0 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index 3af9ad2..f8534e6 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -18,5 +18,7 @@
    (eval . (put 'with-model-view-mul 'scheme-indent-function 1))
    (eval . (put 'with-camera 'scheme-indent-function 1))
    (eval . (put 'with-color 'scheme-indent-function 1))
+   (eval . (put 'with-vertex-buffer 'scheme-indent-function 1))
+   (eval . (put 'with-sprite-batch 'scheme-indent-function 2))
    (eval . (put 'uniform-let 'scheme-indent-function 1))
    (eval . (put 'call-with-surface 'scheme-indent-function 1)))))
diff --git a/Makefile.am b/Makefile.am
index d5336ba..89a1514 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -52,6 +52,7 @@ SOURCES = 					\
   sly/render/shader.scm				\
   sly/render/shape.scm				\
   sly/render/sprite.scm				\
+  sly/render/sprite-batch.scm			\
   sly/render/tileset.scm			\
   sly/render/tile-map.scm			\
   sly/render/viewport.scm			\
diff --git a/sly/render/sprite-batch.scm b/sly/render/sprite-batch.scm
new file mode 100644
index 0000000..bd008cc
--- /dev/null
+++ b/sly/render/sprite-batch.scm
@@ -0,0 +1,259 @@
+;;; Sly
+;;; Copyright (C) 2016 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Deferred sprite rendering for improved performance.
+;;
+;;; Code:
+
+(define-module (sly render sprite-batch)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-9)
+  #:use-module (system foreign)
+  #:use-module (gl)
+  #:use-module (gl low-level)
+  #:use-module (sly agenda)
+  #:use-module (sly utils)
+  #:use-module (sly render)
+  #:use-module (sly render color)
+  #:use-module (sly render mesh)
+  #:use-module (sly render shader)
+  #:use-module (sly render texture)
+  #:use-module (sly render utils)
+  #:use-module (sly math vector)
+  #:use-module (sly math rect)
+  #:use-module (sly wrappers gl)
+  #:export (make-sprite-batch
+            sprite-batch?
+            sprite-batch-capacity
+            sprite-batch-size
+            sprite-batch-add!
+            sprite-batch-reset!
+            sprite-batch-flush!
+            with-sprite-batch))
+
+
+;;;
+;;; Sprite Batch
+;;;
+
+(define-record-type <sprite-batch>
+  (%make-sprite-batch texture size capacity index-buffer
+                      position-buffer texture-buffer vao)
+  sprite-batch?
+  (texture sprite-batch-texture set-sprite-batch-texture!)
+  (size sprite-batch-size set-sprite-batch-size!)
+  (capacity sprite-batch-capacity)
+  (index-buffer sprite-batch-index-buffer)
+  (position-buffer sprite-batch-position-buffer)
+  (texture-buffer sprite-batch-texture-buffer)
+  (vao sprite-batch-vao))
+
+;; TODO: Add guardian.
+
+(define (make-sprite-batch capacity)
+  "Make a sprite batch that can hold CAPACITY sprites."
+  (let* ((index (make-streaming-vertex-buffer 'index (* capacity 6)))
+         (pos   (make-streaming-vertex-buffer 'vec3  (* capacity 4)))
+         (tex   (make-streaming-vertex-buffer 'vec2  (* capacity 4)))
+         (vao   (generate-vertex-array)))
+
+    ;; Build the vertex array for the buffer.
+    (glBindVertexArray vao)
+    (vertex-attrib-pointer vertex-position-location pos)
+    (vertex-attrib-pointer vertex-texture-location  tex)
+    (apply-vertex-buffer index)
+    (glBindVertexArray 0)
+
+    (%make-sprite-batch #f 0 capacity index pos tex vao)))
+
+(define (same-texture? t1 t2)
+  (define (maybe-parent-texture t)
+    (if (texture-region? t)
+        (texture-parent t)
+        t))
+
+  (= (texture-id (maybe-parent-texture t1))
+     (texture-id (maybe-parent-texture t2))))
+
+(define* (sprite-batch-add! batch context texture rect)
+  ;; Draw batch if we are at capacity or the texture is changing.
+  (when (or (= (sprite-batch-capacity batch) (sprite-batch-size batch))
+            (and (sprite-batch-texture batch)
+                 (not (same-texture? texture (sprite-batch-texture batch)))))
+    (sprite-batch-flush! batch context)
+    (sprite-batch-begin! batch))
+
+  (when (texture-null? (sprite-batch-texture batch))
+    (set-sprite-batch-texture! batch texture))
+
+  (let* ((size          (sprite-batch-size batch))
+         (index-offset  (* size 6))
+         (index-vertex-offset (* size 4))
+         (vertex-offset (* size 12)) ; 4 vertices, 3 floats per vertex
+         (texture-offset (* size 8))
+         (index-buffer (vertex-buffer-data
+                        (sprite-batch-index-buffer batch)))
+         (pos-buffer (vertex-buffer-data
+                      (sprite-batch-position-buffer batch)))
+         (tex-buffer (vertex-buffer-data
+                      (sprite-batch-texture-buffer batch))))
+
+    ;; Add indices.
+    (u32vector-set! index-buffer
+                    index-offset
+                    index-vertex-offset)
+    (u32vector-set! index-buffer
+                    (+ index-offset 1)
+                    (+ index-vertex-offset 3))
+    (u32vector-set! index-buffer
+                    (+ index-offset 2)
+                    (+ index-vertex-offset 2))
+    (u32vector-set! index-buffer
+                    (+ index-offset 3)
+                    index-vertex-offset)
+    (u32vector-set! index-buffer
+                    (+ index-offset 4)
+                    (+ index-vertex-offset 2))
+    (u32vector-set! index-buffer
+                    (+ index-offset 5)
+                    (+ index-vertex-offset 1))
+
+    ;; Add vertices.
+    ;; Bottom-left
+    (f32vector-set! pos-buffer
+                    vertex-offset
+                    (rect-left rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 1)
+                    (rect-bottom rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 2)
+                    0)
+    ;; Bottom-right
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 3)
+                    (rect-right rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 4)
+                    (rect-bottom rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 5)
+                    0)
+    ;; Top-right
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 6)
+                    (rect-right rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 7)
+                    (rect-top rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 8)
+                    0)
+    ;; Top-left
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 9)
+                    (rect-left rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 10)
+                    (rect-top rect))
+    (f32vector-set! pos-buffer
+                    (+ vertex-offset 11)
+                    0)
+
+    ;; Add texture coordinates.
+    ;; Bottom-left
+    (f32vector-set! tex-buffer
+                    texture-offset
+                    (texture-s1 texture))
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 1)
+                    (texture-t1 texture))
+    ;; Bottom-right
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 2)
+                    (texture-s2 texture))
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 3)
+                    (texture-t1 texture))
+    ;; Top-right
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 4)
+                    (texture-s2 texture))
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 5)
+                    (texture-t2 texture))
+    ;; Top-left
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 6)
+                    (texture-s1 texture))
+    (f32vector-set! tex-buffer
+                    (+ texture-offset 7)
+                    (texture-t2 texture))
+
+    (set-sprite-batch-size! batch (1+ size))))
+
+(define (sprite-batch-reset! batch)
+  "Reset BATCH to size 0."
+  (set-sprite-batch-texture! batch null-texture)
+  (set-sprite-batch-size! batch 0))
+
+(define (sprite-batch-begin! batch)
+  (map-vertex-buffer! (sprite-batch-index-buffer batch))
+  (map-vertex-buffer! (sprite-batch-position-buffer batch))
+  (map-vertex-buffer! (sprite-batch-texture-buffer batch)))
+
+(define (sprite-batch-flush! batch context)
+  "Render the contents of BATCH and clear the cache."
+  (unless (zero? (sprite-batch-size batch))
+    (graphics-mesh-excursion context
+      (lambda (context)
+        (set-graphics-mesh! context null-mesh)
+        (graphics-texture-excursion context
+          (lambda (context)
+            (set-graphics-texture! context (sprite-batch-texture batch))
+            (graphics-model-view-excursion context
+              (lambda (context)
+                (graphics-model-view-mul! context
+                                          (graphics-projection-transform context))
+                (graphics-uniform-excursion context
+                    `((mvp ,(graphics-model-view-transform context))
+                      (texture? ,(not (texture-null? (graphics-texture context)))))
+                  (lambda (context)
+                    (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
+                    (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
+                    (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
+
+                    (glBindVertexArray (sprite-batch-vao batch))
+                    (glDrawElements (begin-mode triangles)
+                                    ;; 6 indices per sprite.
+                                    (* (sprite-batch-size batch) 6)
+                                    (data-type unsigned-int)
+                                    %null-pointer)
+                    (glBindVertexArray 0)
+
+                    (sprite-batch-reset! batch)))))))))))
+
+(define-syntax-rule (with-sprite-batch batch context body ...)
+  (begin
+    (sprite-batch-reset! batch)
+    (sprite-batch-begin! batch)
+    body ...
+    (sprite-batch-flush! batch context)))