render: sprite: Rewrite sprite batching API.

This new version performs better and has a better API. It closely
resembles Love2D's sprite batch API.

* chickadee/render/sprite.scm (with-batched-sprites,
  sprite-batch-reset!, sprite-batch-begin!,
  draw-sprite-batched, *batch?*, %batch): Delete.
  (draw-sprite-unbatched): Rename to 'draw-sprite*'.
  (<sprite-batch>)[index-buffer, position-buffer, texture-buffer]:
  Delete fields.
  [vertex-buffer]: New field.
  (init-sprite-batch, double-sprite-batch-size!, sprite-batch-add!,
  sprite-batch-flush!): Rewrite.
  (make-sprite-batch): Add 'capacity' and 'blend-mode' arguments.
  (draw-sprite-batch): New procedure.
  (draw-nine-patch*): Stop using sprite batches for now.
* chickadee/render/font.scm: (<font>)[sprite-batches]: New field.
  (load-tile-font, load-font): Create a sprite batch for each texture
  loaded.
  (draw-text*): Use sprite batches.
* chickadee/render/tiled.scm: (<tile>)[batch]: New field.
  (<tileset>)[batch]: New field.
  (load-tile-map): Create a sprite batch for each tileset.
  (draw-tile-layer): Use new sprite batch API.
  (draw-tile-map*): Remove reference to deleted macro.

5 files changed, 373 insertions, 318 deletions

diff --git a/chickadee/render/font.scm b/chickadee/render/font.scm
index aace909..537590d 100644
--- a/chickadee/render/font.scm
+++ b/chickadee/render/font.scm
@@ -60,14 +60,15 @@
   (advance font-char-advance))
 
 (define-record-type <font>
-  (make-font face bold? italic? line-height chars kerning)
+  (make-font face bold? italic? line-height chars kerning sprite-batches)
   font?
   (face font-face)
   (bold? font-bold?)
   (italic? font-italic?)
   (line-height font-line-height)
   (chars font-chars)
-  (kerning font-kerning))
+  (kerning font-kerning)
+  (sprite-batches font-sprite-batches))
 
 (define (display-font font port)
   (format port "#<font face: ~a line-height: ~d bold?: ~a italic?: ~a>"
@@ -98,7 +99,8 @@ order that they are specified in the character set or text will not
 render properly.  Optionally, each tile may have SPACING pixels of
 horizontal and vertical space between surrounding tiles and the entire
 image may have MARGIN pixels of empty space around its border."
-  (let* ((atlas (split-texture (load-image file) tile-width tile-height
+  (let* ((texture (load-image file))
+         (atlas (split-texture texture tile-width tile-height
                                #:margin margin
                                #:spacing spacing))
          (chars
@@ -115,8 +117,10 @@ image may have MARGIN pixels of empty space around its border."
             table))
          ;; These fonts are by definition monospace fonts, so no
          ;; kerning.
-         (kernings (make-hash-table)))
-    (make-font face #f #f tile-height chars kernings)))
+         (kernings (make-hash-table))
+         (batches (make-hash-table)))
+    (hashq-set! batches texture (make-sprite-batch texture))
+    (make-font face #f #f tile-height chars kernings batches)))
 
 (define (load-font file)
   "Load the AngelCode formatted bitmap font within FILE.  The file
@@ -301,8 +305,12 @@ extension must be either .xml or .fnt."
                              image-width
                              image-height
                              line-height))
-         (kernings (parse-kernings ((sxpath '(font kernings kerning)) tree))))
-    (make-font face bold? italic? line-height chars kernings)))
+         (kernings (parse-kernings ((sxpath '(font kernings kerning)) tree)))
+         (batches (make-hash-table)))
+    (hash-for-each (lambda (id texture)
+                     (hashq-set! batches texture (make-sprite-batch texture)))
+                   pages)
+    (make-font face bold? italic? line-height chars kernings batches)))
 
 (define (font-ref font char)
   (hashv-ref (font-chars font) char))
@@ -312,29 +320,38 @@ extension must be either .xml or .fnt."
         (rect (make-rect 0.0 0.0 0.0 0.0)))
     (lambda* (font text matrix #:key (blend-mode 'alpha)
                    (start 0) (end (string-length text)))
-      ;; TODO: Respect kerning.
-      (define (render-char c)
-        (if (eqv? c #\newline)
-            (begin
-              (set-vec2-x! cursor 0.0)
-              (set-vec2-y! cursor (- (vec2-y cursor) (font-line-height font))))
-            ;; TODO: What if "?" isn't in the font?
-            (let* ((char (or (font-ref font c) (font-ref font #\?)))
-                   (texture (font-char-texture-region char))
-                   (dimensions (font-char-dimensions char))
-                   (offset (font-char-offset char)))
-              (set-rect-x! rect (+ (vec2-x cursor) (vec2-x offset)))
-              (set-rect-y! rect (+ (vec2-y cursor) (vec2-y offset)))
-              (set-rect-width! rect (vec2-x dimensions))
-              (set-rect-height! rect (vec2-y dimensions))
-              (draw-sprite* texture rect matrix #:blend-mode blend-mode)
-              ;; Move forward to where the next character needs to be drawn.
-              (set-vec2-x! cursor
-                           (+ (vec2-x cursor)
-                              (vec2-x
-                               (font-char-advance char)))))))
-      (set-vec2! cursor 0.0 0.0)
-      (string-for-each render-char text start end))))
+      (let ((batches (font-sprite-batches font)))
+        ;; TODO: Respect kerning.
+        (define (render-char c)
+          (if (eqv? c #\newline)
+              (begin
+                (set-vec2-x! cursor 0.0)
+                (set-vec2-y! cursor (- (vec2-y cursor) (font-line-height font))))
+              ;; TODO: What if "?" isn't in the font?
+              (let* ((char (or (font-ref font c) (font-ref font #\?)))
+                     (texture (font-char-texture-region char))
+                     (batch (hashq-ref batches (texture-parent texture)))
+                     (dimensions (font-char-dimensions char))
+                     (offset (font-char-offset char)))
+                (set-rect-x! rect (+ (vec2-x cursor) (vec2-x offset)))
+                (set-rect-y! rect (+ (vec2-y cursor) (vec2-y offset)))
+                (set-rect-width! rect (vec2-x dimensions))
+                (set-rect-height! rect (vec2-y dimensions))
+                (sprite-batch-add* batch rect matrix
+                                   #:texture-region texture)
+                ;; Move forward to where the next character needs to be drawn.
+                (set-vec2-x! cursor
+                             (+ (vec2-x cursor)
+                                (vec2-x
+                                 (font-char-advance char)))))))
+        (set-vec2! cursor 0.0 0.0)
+        (hash-for-each (lambda (texture batch)
+                         (sprite-batch-clear! batch))
+                       batches)
+        (string-for-each render-char text start end)
+        (hash-for-each (lambda (texture batch)
+                         (draw-sprite-batch batch #:blend-mode blend-mode))
+                       batches)))))
 
 (define %default-scale (vec2 1.0 1.0))
 (define %null-vec2 (vec2 0.0 0.0))
diff --git a/chickadee/render/sprite.scm b/chickadee/render/sprite.scm
index 708cc78..c453a9d 100644
--- a/chickadee/render/sprite.scm
+++ b/chickadee/render/sprite.scm
@@ -30,6 +30,16 @@
   #:use-module (chickadee render buffer)
   #:export (draw-sprite*
             draw-sprite
+
+            make-sprite-batch
+            sprite-batch?
+            sprite-batch-texture
+            set-sprite-batch-texture!
+            sprite-batch-clear!
+            sprite-batch-add*
+            sprite-batch-add!
+            draw-sprite-batch
+
             with-batched-sprites
             draw-nine-patch*
             draw-nine-patch))
@@ -62,7 +72,7 @@ void main (void) {
 }
 ")))
 
-(define draw-sprite-unbatched
+(define draw-sprite*
   (let* ((stride 16)            ; 4 f32s, 2 for vertex, 2 for texcoord
          (buffer (delay
                    (make-buffer #f
@@ -97,16 +107,22 @@ void main (void) {
                                `((0 . ,(force pos))
                                  (1 . ,(force tex))))))
          (mvp (make-null-matrix4)))
-    (lambda (texture region world-matrix blend-mode texture-region tint)
+    (lambda* (texture
+              rect
+              matrix
+              #:key
+              (tint white)
+              (blend-mode 'alpha)
+              (texcoords (texture-gl-tex-rect texture)))
       (with-mapped-typed-buffer (force pos)
-        (let* ((x1 (rect-x region))
-               (y1 (rect-y region))
-               (x2 (+ x1 (rect-width region)))
-               (y2 (+ y1 (rect-height region)))
-               (s1 (rect-x texture-region))
-               (t1 (rect-y texture-region))
-               (s2 (+ (rect-x texture-region) (rect-width texture-region)))
-               (t2 (+ (rect-y texture-region) (rect-height texture-region)))
+        (let* ((x1 (rect-x rect))
+               (y1 (rect-y rect))
+               (x2 (+ x1 (rect-width rect)))
+               (y2 (+ y1 (rect-height rect)))
+               (s1 (rect-x texcoords))
+               (t1 (rect-y texcoords))
+               (s2 (+ (rect-x texcoords) (rect-width texcoords)))
+               (t2 (+ (rect-y texcoords) (rect-height texcoords)))
                (bv (typed-buffer-data (force pos))))
           ;; Texture origin is at the top-left, so we need to flip the Y
           ;; coordinate relative to the vertices.
@@ -130,72 +146,117 @@ void main (void) {
         (with-texture 0 texture
           (gpu-apply (force unbatched-sprite-shader) (force vertex-array)
                      #:tint tint
-                     #:mvp (if world-matrix
+                     #:mvp (if matrix
                                (begin
-                                 (matrix4-mult! mvp world-matrix
+                                 (matrix4-mult! mvp matrix
                                                 (current-projection))
                                  mvp)
                                (current-projection))))))))
 
+(define %null-vec2 (vec2 0.0 0.0))
+(define %default-scale (vec2 1.0 1.0))
+
+(define draw-sprite
+  (let ((matrix (make-null-matrix4)))
+    (lambda* (texture
+              position
+              #:key
+              (tint white)
+              (origin %null-vec2)
+              (scale %default-scale)
+              (rotation 0.0)
+              (blend-mode 'alpha)
+              (rect (texture-gl-rect texture)))
+      "Draw TEXTURE at POSITION.
+
+Optionally, other transformations may be applied to the sprite.
+ROTATION specifies the angle to rotate the sprite, in radians.  SCALE
+specifies the scaling factor as a 2D vector.  All transformations are
+applied relative to ORIGIN, a 2D vector.
+
+TINT specifies the color to multiply against all the sprite's pixels.
+By default white is used, which does no tinting at all.
+
+By default, alpha blending is used but can be changed by specifying
+BLEND-MODE."
+      (matrix4-2d-transform! matrix
+                             #:origin origin
+                             #:position position
+                             #:rotation rotation
+                             #:scale scale)
+      (draw-sprite* texture rect matrix
+                    #:tint tint
+                    #:blend-mode blend-mode))))
+
 
 ;;;
-;;; Sprite Batch
+;;; Sprite Batches
 ;;;
 
 (define-record-type <sprite-batch>
-  (%make-sprite-batch texture blend-mode size capacity index-buffer
-                      position-buffer texture-buffer vertex-array)
+  (%make-sprite-batch texture size capacity vertex-buffer vertex-array)
   sprite-batch?
   (texture sprite-batch-texture set-sprite-batch-texture!)
-  (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!)
   (size sprite-batch-size set-sprite-batch-size!)
   (capacity sprite-batch-capacity set-sprite-batch-capacity!)
-  (index-buffer sprite-batch-index-buffer set-sprite-batch-index-buffer!)
-  (position-buffer sprite-batch-position-buffer set-sprite-batch-position-buffer!)
-  (texture-buffer sprite-batch-texture-buffer set-sprite-batch-texture-buffer!)
+  (vertex-buffer sprite-batch-vertex-buffer set-sprite-batch-vertex-buffer!)
   (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))
 
 (define (init-sprite-batch batch capacity)
-  (let* ((index (make-streaming-typed-buffer 'scalar
-                                             'unsigned-int
-                                             (* capacity 6)
-                                             #:target 'index))
+  (let* ((index-data (let ((bv (make-u32vector (* capacity 6))))
+                       (let loop ((i 0))
+                         (when (< i capacity)
+                           (let ((index-offset (* i 6))
+                                 (vertex-offset (* i 4)))
+                             (u32vector-set! bv index-offset vertex-offset)
+                             (u32vector-set! bv (+ index-offset 1) (+ vertex-offset 3))
+                             (u32vector-set! bv (+ index-offset 2) (+ vertex-offset 2))
+                             (u32vector-set! bv (+ index-offset 3) vertex-offset)
+                             (u32vector-set! bv (+ index-offset 4) (+ vertex-offset 2))
+                             (u32vector-set! bv (+ index-offset 5) (+ vertex-offset 1))
+                             (loop (+ i 1)))))
+                       bv))
+         (index-buffer (make-buffer index-data
+                                    #:name "indices"
+                                    #:target 'index))
+         (indices (make-typed-buffer #:name "indices"
+                                     #:buffer index-buffer
+                                     #:type 'scalar
+                                     #:component-type 'unsigned-int))
          (stride 32) ; 8 f32s, 2 for vertex, 2 for texcoord, 4 for tint color
          (buffer (make-buffer #f
                               #:name "sprite batch buffer"
                               #:length (* capacity stride 4)
                               #:stride stride
                               #:usage 'stream))
-         (pos (make-typed-buffer #:name "sprite batches vertices"
+         (pos (make-typed-buffer #:name "sprite batch vertices"
                                  #:buffer buffer
                                  #:type 'vec2
                                  #:component-type 'float
                                  #:length (* capacity 4)))
-         (tex (make-typed-buffer #:name "batched-sprite-vertices"
+         (tex (make-typed-buffer #:name "sprite batch texture coordinates"
                                  #:buffer buffer
                                  #:type 'vec2
                                  #:component-type 'float
                                  #:length (* capacity 4)
                                  #:offset 8))
-         (tint (make-typed-buffer #:name "batched-sprite-tint"
+         (tint (make-typed-buffer #:name "sprite batch tint colors"
                                   #:buffer buffer
                                   #:type 'vec4
                                   #:component-type 'float
                                   #:length (* capacity 4)
                                   #:offset 16))
-         (va (make-vertex-array #:indices index
+         (va (make-vertex-array #:indices indices
                                 #:attributes `((0 . ,pos)
                                                (1 . ,tex)
                                                (2 . ,tint)))))
     (set-sprite-batch-capacity! batch capacity)
-    (set-sprite-batch-index-buffer! batch index)
-    (set-sprite-batch-position-buffer! batch pos)
-    (set-sprite-batch-texture-buffer! batch tex)
+    (set-sprite-batch-vertex-buffer! batch buffer)
     (set-sprite-batch-vertex-array! batch va)))
 
-(define (make-sprite-batch capacity)
+(define* (make-sprite-batch texture #:key (capacity 256))
   "Make a sprite batch that can hold CAPACITY sprites."
-  (let ((batch (%make-sprite-batch #f #f 0 0 #f #f #f #f)))
+  (let ((batch (%make-sprite-batch texture 0 0 #f #f)))
     (init-sprite-batch batch capacity)
     batch))
 
@@ -203,32 +264,116 @@ void main (void) {
   (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
 
 (define (double-sprite-batch-size! batch)
-  (let* ((old-index (sprite-batch-index-buffer batch))
-         (old-verts (sprite-batch-position-buffer batch))
-         (old-index-data (typed-buffer-data old-index))
-         (old-vertex-data (typed-buffer-data old-verts)))
-    (unmap-typed-buffer! old-index)
-    (unmap-typed-buffer! old-verts)
+  (let* ((old-verts (sprite-batch-vertex-buffer batch))
+         (old-vertex-data (buffer-data old-verts)))
+    (unmap-buffer! old-verts)
     (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
-    (sprite-batch-begin! batch)
-    (let ((new-index (sprite-batch-index-buffer batch))
-          (new-verts (sprite-batch-position-buffer batch)))
-      (define (copy from to)
-        (bytevector-copy! from 0
-                          (typed-buffer-data to) 0
-                          (bytevector-length from)))
-      (copy old-index-data new-index)
-      (copy old-vertex-data new-verts))))
-
-(define (sprite-batch-reset! batch)
+    (let ((new-verts (sprite-batch-vertex-buffer batch)))
+      (map-buffer! new-verts 'write-only)
+      (bytevector-copy! old-vertex-data 0
+                        (buffer-data new-verts) 0
+                        (bytevector-length old-vertex-data)))))
+
+(define (sprite-batch-clear! batch)
   "Reset BATCH to size 0."
-  (set-sprite-batch-texture! batch #f)
-  (set-sprite-batch-blend-mode! batch #f)
   (set-sprite-batch-size! batch 0))
 
-(define (sprite-batch-begin! batch)
-  (map-typed-buffer! (sprite-batch-index-buffer batch))
-  (map-typed-buffer! (sprite-batch-position-buffer batch)))
+(define (sprite-batch-flush! batch)
+  "Submit the contents of BATCH to the GPU."
+  (unmap-buffer! (sprite-batch-vertex-buffer batch)))
+
+(define* (sprite-batch-add* batch rect matrix
+                            #:key
+                            (tint white)
+                            texture-region)
+  "Add RECT, transformed by MATRIX, to BATCH.  To render a subsection
+of the batch's texture, a texture object whose parent is the batch
+texture may be specified via the TEXTURE-REGION argument."
+  ;; Expand the buffers when necessary.
+  (when (sprite-batch-full? batch)
+        (double-sprite-batch-size! batch))
+  (map-buffer! (sprite-batch-vertex-buffer batch) 'write-only)
+  (let* ((size (sprite-batch-size batch))
+         (vertices (buffer-data (sprite-batch-vertex-buffer batch)))
+         (offset (* size 32)) ; each sprite is 32 floats in size
+         (minx (rect-x rect))
+         (miny (rect-y rect))
+         (maxx (+ minx (rect-width rect)))
+         (maxy (+ miny (rect-height rect)))
+         (x1 (transform-x matrix minx miny))
+         (y1 (transform-y matrix minx miny))
+         (x2 (transform-x matrix maxx miny))
+         (y2 (transform-y matrix maxx miny))
+         (x3 (transform-x matrix maxx maxy))
+         (y3 (transform-y matrix maxx maxy))
+         (x4 (transform-x matrix minx maxy))
+         (y4 (transform-y matrix minx maxy))
+         (texcoords (texture-gl-tex-rect
+                     (or texture-region
+                         (sprite-batch-texture batch))))
+         (s1 (rect-x texcoords))
+         (t1 (rect-y texcoords))
+         (s2 (+ (rect-x texcoords) (rect-width texcoords)))
+         (t2 (+ (rect-y texcoords) (rect-height texcoords))))
+    ;; Add vertices.
+    ;; Bottom-left
+    (f32vector-set! vertices offset x1)
+    (f32vector-set! vertices (+ offset 1) y1)
+    ;; Bottom-right
+    (f32vector-set! vertices (+ offset 8) x2)
+    (f32vector-set! vertices (+ offset 9) y2)
+    ;; Top-right
+    (f32vector-set! vertices (+ offset 16) x3)
+    (f32vector-set! vertices (+ offset 17) y3)
+    ;; Top-left
+    (f32vector-set! vertices (+ offset 24) x4)
+    (f32vector-set! vertices (+ offset 25) y4)
+    ;; Add texture coordinates.
+    ;; Bottom-left
+    (f32vector-set! vertices (+ offset 2) s1)
+    (f32vector-set! vertices (+ offset 3) t2)
+    ;; Bottom-right
+    (f32vector-set! vertices (+ offset 10) s2)
+    (f32vector-set! vertices (+ offset 11) t2)
+    ;; Top-right
+    (f32vector-set! vertices (+ offset 18) s2)
+    (f32vector-set! vertices (+ offset 19) t1)
+    ;; Top-left
+    (f32vector-set! vertices (+ offset 26) s1)
+    (f32vector-set! vertices (+ offset 27) t1)
+    ;; Add tint.
+    (let ((bv ((@@ (chickadee render color) unwrap-color) tint))
+          (byte-offset (* offset 4)))
+      (bytevector-copy! bv 0 vertices (+ byte-offset 16) 16)
+      (bytevector-copy! bv 0 vertices (+ byte-offset 48) 16)
+      (bytevector-copy! bv 0 vertices (+ byte-offset 80) 16)
+      (bytevector-copy! bv 0 vertices (+ byte-offset 112) 16))
+    (set-sprite-batch-size! batch (1+ size))))
+
+(define sprite-batch-add!
+  (let ((matrix (make-null-matrix4)))
+    (lambda* (batch
+              position
+              #:key
+              (origin %null-vec2)
+              (scale %default-scale)
+              (rotation 0.0)
+              (tint white)
+              texture-region)
+      "Add sprite to BATCH at POSITION.  To render a subsection of the
+batch's texture, a texture object whose parent is the batch texture
+may be specified via the TEXTURE-REGION argument."
+      (let ((rect (texture-gl-rect
+                   (or texture-region (sprite-batch-texture batch)))))
+        (matrix4-2d-transform! matrix
+                               #:origin origin
+                               #:position position
+                               #:rotation rotation
+                               #:scale scale)
+        (sprite-batch-add* batch rect matrix
+                           #:tint tint
+                           #:texture-region texture-region)))))
+
 
 (define batched-sprite-shader
   (delay
@@ -261,161 +406,15 @@ void main (void) {
 }
 ")))
 
-(define (sprite-batch-flush! batch)
-  "Render the contents of BATCH and clear the cache."
-  (unless (zero? (sprite-batch-size batch))
-    (with-blend-mode (sprite-batch-blend-mode batch)
-      (with-texture 0 (sprite-batch-texture batch)
-        (unmap-typed-buffer! (sprite-batch-index-buffer batch))
-        (unmap-typed-buffer! (sprite-batch-position-buffer batch))
-        (gpu-apply* (force batched-sprite-shader)
-                    (sprite-batch-vertex-array batch)
-                    (* (sprite-batch-size batch) 6)
-                    #:mvp (current-projection))
-        (sprite-batch-reset! batch)))))
-
-(define (sprite-batch-add! batch texture region world-matrix blend-mode
-                           texture-region tint)
-  ;; Expand the buffers when necessary.
-  (when (sprite-batch-full? batch)
-    (double-sprite-batch-size! batch))
-  ;; Flush the batch if any GL state needs changing.
-  (unless (and (eq? (sprite-batch-texture batch) texture)
-               (eq? (sprite-batch-blend-mode batch) blend-mode))
-    (sprite-batch-flush! batch)
-    (sprite-batch-begin! batch)
-    (set-sprite-batch-texture! batch texture)
-    (set-sprite-batch-blend-mode! batch blend-mode))
-  (let ((size (sprite-batch-size batch)))
-    (let* ((indices (typed-buffer-data (sprite-batch-index-buffer batch)))
-           (vertices (typed-buffer-data (sprite-batch-position-buffer batch)))
-           (index-offset (* size 6))
-           (offset (* size 32))
-           (minx (rect-x region))
-           (miny (rect-y region))
-           (maxx (+ minx (rect-width region)))
-           (maxy (+ miny (rect-height region)))
-           (x1 (transform-x world-matrix minx miny))
-           (y1 (transform-y world-matrix minx miny))
-           (x2 (transform-x world-matrix maxx miny))
-           (y2 (transform-y world-matrix maxx miny))
-           (x3 (transform-x world-matrix maxx maxy))
-           (y3 (transform-y world-matrix maxx maxy))
-           (x4 (transform-x world-matrix minx maxy))
-           (y4 (transform-y world-matrix minx maxy))
-           (s1 (rect-x texture-region))
-           (t1 (rect-y texture-region))
-           (s2 (+ (rect-x texture-region) (rect-width texture-region)))
-           (t2 (+ (rect-y texture-region) (rect-height texture-region))))
-      ;; Add indices.
-      (let ((index-vertex-offset (* size 4)))
-        (u32vector-set! indices index-offset index-vertex-offset)
-        (u32vector-set! indices (+ index-offset 1) (+ index-vertex-offset 3))
-        (u32vector-set! indices (+ index-offset 2) (+ index-vertex-offset 2))
-        (u32vector-set! indices (+ index-offset 3) index-vertex-offset)
-        (u32vector-set! indices (+ index-offset 4) (+ index-vertex-offset 2))
-        (u32vector-set! indices (+ index-offset 5) (+ index-vertex-offset 1)))
-      ;; Add vertices.
-      ;; Bottom-left
-      (f32vector-set! vertices offset x1)
-      (f32vector-set! vertices (+ offset 1) y1)
-      ;; Bottom-right
-      (f32vector-set! vertices (+ offset 8) x2)
-      (f32vector-set! vertices (+ offset 9) y2)
-      ;; Top-right
-      (f32vector-set! vertices (+ offset 16) x3)
-      (f32vector-set! vertices (+ offset 17) y3)
-      ;; Top-left
-      (f32vector-set! vertices (+ offset 24) x4)
-      (f32vector-set! vertices (+ offset 25) y4)
-      ;; Add texture coordinates.
-      ;; Bottom-left
-      (f32vector-set! vertices (+ offset 2) s1)
-      (f32vector-set! vertices (+ offset 3) t2)
-      ;; Bottom-right
-      (f32vector-set! vertices (+ offset 10) s2)
-      (f32vector-set! vertices (+ offset 11) t2)
-      ;; Top-right
-      (f32vector-set! vertices (+ offset 18) s2)
-      (f32vector-set! vertices (+ offset 19) t1)
-      ;; Top-left
-      (f32vector-set! vertices (+ offset 26) s1)
-      (f32vector-set! vertices (+ offset 27) t1)
-      ;; Add tint.
-      (let ((bv ((@@ (chickadee render color) unwrap-color) tint))
-            (byte-offset (* offset 4)))
-        (bytevector-copy! bv 0 vertices (+ byte-offset 16) 16)
-        (bytevector-copy! bv 0 vertices (+ byte-offset 48) 16)
-        (bytevector-copy! bv 0 vertices (+ byte-offset 80) 16)
-        (bytevector-copy! bv 0 vertices (+ byte-offset 112) 16))
-      (set-sprite-batch-size! batch (1+ size)))))
-
-(define *batch?* #f)
-(define %batch (delay (make-sprite-batch 256)))
-
-(define (draw-sprite-batched texture region world-matrix blend-mode
-                             texture-region tint)
-  (sprite-batch-add! (force %batch) texture region world-matrix blend-mode
-                     texture-region tint))
-
-(define-syntax-rule (with-batched-sprites body ...)
-  "Use batched rendering for all draw-sprite calls within BODY."
-  (if *batch?*
-      (begin body ...)
-      (dynamic-wind
-        (lambda ()
-          (set! *batch?* #t))
-        (lambda ()
-          (sprite-batch-reset! (force %batch))
-          body ...
-          (sprite-batch-flush! (force %batch)))
-        (lambda ()
-          (set! *batch?* #f)))))
-
-(define* (draw-sprite* texture rect matrix #:key
-                       (tint white)
-                       (blend-mode 'alpha)
-                       (texcoords (texture-gl-tex-rect texture)))
-  (if *batch?*
-      (draw-sprite-batched texture rect matrix blend-mode
-                           texcoords tint)
-      (draw-sprite-unbatched texture rect matrix blend-mode
-                             texcoords tint)))
-
-(define %null-vec2 (vec2 0.0 0.0))
-(define %default-scale (vec2 1.0 1.0))
-
-(define draw-sprite
-  (let ((matrix (make-null-matrix4)))
-    (lambda* (texture
-              position
-              #:key
-              (tint white)
-              (origin %null-vec2)
-              (scale %default-scale)
-              (rotation 0.0)
-              (blend-mode 'alpha)
-              (rect (texture-gl-rect texture)))
-      "Draw TEXTURE at POSITION.
-
-Optionally, other transformations may be applied to the sprite.
-ROTATION specifies the angle to rotate the sprite, in radians.  SCALE
-specifies the scaling factor as a 2D vector.  All transformations are
-applied relative to ORIGIN, a 2D vector.
-
-TINT specifies the color to multiply against all the sprite's pixels.
-By default white is used, which does no tinting at all.
-
-By default, alpha blending is used but can be changed by specifying
-BLEND-MODE."
-      (matrix4-2d-transform! matrix
-                             #:origin origin
-                             #:position position
-                             #:rotation rotation
-                             #:scale scale)
-      (draw-sprite* texture rect matrix
-                    #:tint tint
-                    #:blend-mode blend-mode))))
+(define* (draw-sprite-batch batch #:key (blend-mode 'alpha))
+  "Render the contents of BATCH."
+  (sprite-batch-flush! batch)
+  (with-blend-mode blend-mode
+    (with-texture 0 (sprite-batch-texture batch)
+      (gpu-apply* (force batched-sprite-shader)
+                  (sprite-batch-vertex-array batch)
+                  (* (sprite-batch-size batch) 6)
+                  #:mvp (current-projection)))))
 
 
 ;;;
@@ -473,34 +472,33 @@ BLEND-MODE."
                         #:texcoords texcoords
                         #:blend-mode blend-mode
                         #:tint tint))
-        (with-batched-sprites
-         ;; bottom-left
-         (draw-piece border-x1 border-y1 fill-x1 fill-y1
-                     border-s1 fill-t2 fill-s1 border-t2)
-         ;; bottom-center
-         (draw-piece fill-x1 border-y1 fill-x2 fill-y1
-                     fill-s1 fill-t2 fill-s2 border-t2)
-         ;; bottom-right
-         (draw-piece fill-x2 border-y1 border-x2 fill-y1
-                     fill-s2 fill-t2 border-s2 border-t2)
-         ;; center-left
-         (draw-piece border-x1 fill-y1 fill-x1 fill-y2
-                     border-s1 fill-t2 fill-s1 fill-t1)
-         ;; center
-         (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
-                     fill-s1 fill-t2 fill-s2 fill-t1)
-         ;; center-right
-         (draw-piece fill-x2 fill-y1 border-x2 fill-y2
-                     fill-s2 fill-t2 border-s2 fill-t1)
-         ;; top-left
-         (draw-piece border-x1 fill-y2 fill-x1 border-y2
-                     border-s1 border-t1 fill-s1 fill-t1)
-         ;; top-center
-         (draw-piece fill-x1 fill-y2 fill-x2 border-y2
-                     fill-s1 border-t1 fill-s2 fill-t1)
-         ;; top-right
-         (draw-piece fill-x2 fill-y2 border-x2 border-y2
-                     fill-s2 border-t1 border-s2 fill-t1))))))
+        ;; bottom-left
+        (draw-piece border-x1 border-y1 fill-x1 fill-y1
+                    border-s1 fill-t2 fill-s1 border-t2)
+        ;; bottom-center
+        (draw-piece fill-x1 border-y1 fill-x2 fill-y1
+                    fill-s1 fill-t2 fill-s2 border-t2)
+        ;; bottom-right
+        (draw-piece fill-x2 border-y1 border-x2 fill-y1
+                    fill-s2 fill-t2 border-s2 border-t2)
+        ;; center-left
+        (draw-piece border-x1 fill-y1 fill-x1 fill-y2
+                    border-s1 fill-t2 fill-s1 fill-t1)
+        ;; center
+        (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
+                    fill-s1 fill-t2 fill-s2 fill-t1)
+        ;; center-right
+        (draw-piece fill-x2 fill-y1 border-x2 fill-y2
+                    fill-s2 fill-t2 border-s2 fill-t1)
+        ;; top-left
+        (draw-piece border-x1 fill-y2 fill-x1 border-y2
+                    border-s1 border-t1 fill-s1 fill-t1)
+        ;; top-center
+        (draw-piece fill-x1 fill-y2 fill-x2 border-y2
+                    fill-s1 border-t1 fill-s2 fill-t1)
+        ;; top-right
+        (draw-piece fill-x2 fill-y2 border-x2 border-y2
+                    fill-s2 border-t1 border-s2 fill-t1)))))
 
 (define draw-nine-patch
   (let ((position (vec2 0.0 0.0))
diff --git a/chickadee/render/tiled.scm b/chickadee/render/tiled.scm
index 1a4c200..1fbdbe6 100644
--- a/chickadee/render/tiled.scm
+++ b/chickadee/render/tiled.scm
@@ -118,16 +118,17 @@
   (duration animation-frame-duration))
 
 (define-record-type <tile>
-  (%make-tile id texture animation properties)
+  (%make-tile id texture batch animation properties)
   tile?
   (id tile-id)
   (texture tile-texture)
+  (batch tile-batch)
   (animation tile-animation)
   (properties tile-properties))
 
 (define-record-type <tileset>
   (%make-tileset name first-gid size tile-width tile-height
-                 atlas tiles properties)
+                 atlas tiles properties batch)
   tileset?
   (name tileset-name)
   (first-gid tileset-first-gid)
@@ -136,7 +137,8 @@
   (tile-height tileset-tile-height)
   (atlas tileset-atlas)
   (tiles tileset-tiles)
-  (properties tileset-properties))
+  (properties tileset-properties)
+  (batch tileset-batch))
 
 (define-record-type <map-tile>
   (%make-map-tile tile rect)
@@ -230,26 +232,25 @@
           (duration (attr node 'duration string->number)))
       ;; TODO: lookup actual tile in tileset
       (%make-animation-frame tile-id duration)))
-  (define (parse-tile node rows columns atlas)
+  (define (parse-tile node rows columns atlas batch)
     (let ((id (attr node 'id string->number))
           (animation (map parse-frame ((sxpath '(animation frame)) node)))
           (properties (map parse-property
                            ((sxpath '(properties property)) node))))
-      (%make-tile id (texture-atlas-ref atlas id)
-                  animation properties)))
-  (define (parse-tiles nodes size columns atlas)
+      (%make-tile id (texture-atlas-ref atlas id) batch animation properties)))
+  (define (parse-tiles nodes size columns atlas batch)
     (let ((table (make-hash-table))
           (tiles (make-vector size))
           (rows (/ size columns)))
       (for-each (lambda (node)
-                  (let ((tile (parse-tile node rows columns atlas)))
+                  (let ((tile (parse-tile node rows columns atlas batch)))
                     (hash-set! table (tile-id tile) tile)))
                 nodes)
       (let loop ((i 0))
         (when (< i size)
           (let ((tile
                  (or (hash-ref table i)
-                     (%make-tile i (texture-atlas-ref atlas i) #f '()))))
+                     (%make-tile i (texture-atlas-ref atlas i) batch #f '()))))
             (vector-set! tiles i tile))
           (loop (+ i 1))))
       tiles))
@@ -266,11 +267,12 @@
            (texture (parse-image ((sxpath '(image)) node)))
            (atlas (split-texture texture tile-width tile-height
                                  #:margin margin #:spacing spacing))
-           (tiles (parse-tiles ((sxpath '(tile)) node) size columns atlas))
+           (batch (make-sprite-batch texture))
+           (tiles (parse-tiles ((sxpath '(tile)) node) size columns atlas batch))
            (properties (map parse-property
                             ((sxpath '(properties property)) node))))
       (%make-tileset name first-gid size tile-width tile-height
-                     atlas tiles  properties)))
+                     atlas tiles properties batch)))
   (define (parse-external-tileset node)
     (let* ((first-gid (attr node 'firstgid string->number))
            (source (scope (attr node 'source)))
@@ -419,9 +421,11 @@
             (let ((tile (vector-ref (tile-layer-tiles layer)
                                     (+ (* y width) x))))
               (when tile
-                (draw-sprite* (tile-texture (map-tile-ref tile))
-                              (map-tile-rect tile)
-                              matrix)))
+                (let ((tref (map-tile-ref tile)))
+                  (sprite-batch-add* (tile-batch tref)
+                                     (map-tile-rect tile)
+                                     matrix
+                                     #:texture-region (tile-texture tref)))))
             (x-loop (+ x 1))))
         (y-loop (+ y 1))))))
 
@@ -440,13 +444,18 @@
          (y1 (max (inexact->exact (floor (/ ry th))) 0))
          (x2 (min (inexact->exact (ceiling (/ (+ rx rw) tw))) w))
          (y2 (min (inexact->exact (ceiling (/ (+ ry rh) th))) h)))
-    (with-batched-sprites
-     (vector-for-each (lambda (i layer)
-                        (when (and (tile-layer? layer)
-                                   (or (not layers)
-                                       (memv i layers)))
-                          (draw-tile-layer layer matrix x1 y1 x2 y2)))
-                      (tile-map-layers tile-map)))))
+    (vector-for-each (lambda (i layer)
+                       (when (and (tile-layer? layer)
+                                  (or (not layers)
+                                      (memv i layers)))
+                             (for-each (lambda (tileset)
+                                         (sprite-batch-clear! (tileset-batch tileset)))
+                                       (tile-map-tilesets tile-map))
+                             (draw-tile-layer layer matrix x1 y1 x2 y2)
+                             (for-each (lambda (tileset)
+                                         (draw-sprite-batch (tileset-batch tileset)))
+                                       (tile-map-tilesets tile-map))))
+                     (tile-map-layers tile-map))))
 
 (define %null-vec2 (vec2 0.0 0.0))
 (define %default-scale (vec2 1.0 1.0))
diff --git a/doc/api.texi b/doc/api.texi
index 6669b5f..473e3b9 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1359,26 +1359,55 @@ It's not uncommon to need to draw hundreds or thousands of sprites
 each frame.  However, GPUs (graphics processing units) are tricky
 beasts that prefer to be sent few, large chunks of data to render
 rather than many, small chunks.  Using @code{draw-sprite} on its own
-will involve at least one GPU call @emph{per sprite}, which will
-quickly lead to poor performance.  To deal with this, a technique
-known as ``sprite batching'' can be used.  Instead of drawing each
-sprite immediately, the sprite batch will build up a large of buffer
-of sprites to draw and defer rendering until the last possible moment.
-Batching isn't a panacea, though.  Batching only works if the sprites
-being drawn share as much in common as possible.  Every time you draw
-a sprite with a different texture or blend mode, the batch will be
-sent off to the GPU.  Therefore, batching is most useful if you
-minimize such changes.  A good strategy for reducing texture changes
-is to stuff many bitmaps into a single image file and create a
-``texture atlas'' (@pxref{Textures}) to access the sub-images within.
-
-Taking advantage of sprite batching in Chickadee is easy, just wrap
-the code that is calling @code{draw-sprite} a lot in the
-@code{with-batched-sprites} form.
-
-@deffn {Syntax} with-batched-sprites @var{body} @dots{}
-Use batched rendering for all @code{draw-sprite} calls within
-@var{body}.
+will involve at least one GPU call @emph{per sprite}.  This is fine
+for rendering a few dozen sprites, but will become a serious
+bottleneck when rendering hundreds or thousands of sprites.  To deal
+with this, a technique known as ``sprite batching'' is used.  Instead
+of drawing each sprite immediately, the sprite batch will build up a
+large of buffer of sprites to draw and send them to the GPU all at
+once.  There is one caveat, however.  Batching only works if the
+sprites being drawn share a common texture.  A good strategy for
+reducing the number of different textures is to stuff many bitmaps
+into a single image file and create a ``texture atlas''
+(@pxref{Textures}) to access the sub-images within.
+
+@deffn {Procedure} make-sprite-batch @var{texture} [#:capacity 256]
+Create a new sprite batch for @var{texture} with initial space for
+@var{capacity} sprites.  Sprite batches automatically resize when they
+are full to accomodate as many sprites as necessary.
+@end deffn
+
+@deffn {Procedure} sprite-batch? @var{obj}
+Return @code{#t} if @var{obj} is a sprite batch.
+@end deffn
+
+@deffn {Procedure} sprite-batch-texture @var{batch}
+Return the texture for @var{batch}.
+@end deffn
+
+@deffn {Procedure} set-sprite-batch-texture! @var{batch} @var{texture}
+Set texture for @var{batch} to @var{texture}.
+@end deffn
+
+@deffn {Procedure} sprite-batch-add! @var{batch} @var{position} @@
+                   [#:origin] [#:scale] [:rotation] @@
+                   [#:tint @code{white}] [#:texture-region]
+
+Add sprite located at @var{position} to @var{batch}.
+
+To render a subsection of the batch's texture, a texture object whose
+parent is the batch texture may be specified as @var{texture-region}.
+
+See @code{draw-sprite} for information about the other arguments.
+@end deffn
+
+@deffn {Procedure} sprite-batch-clear! @var{batch}
+Reset size of @var{batch} to 0.
+@end deffn
+
+@deffn {Procedure} draw-sprite-batch @var{batch} [#:blend-mode @code{alpha}]
+Render @var{batch} using @var{blend-mode}.  Alpha blending is used by
+default.
 @end deffn
 
 With a basic sprite abstraction in place, it's possible to build other
diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm
index c31ffbf..4bddf8f 100644
--- a/examples/sprite-batch.scm
+++ b/examples/sprite-batch.scm
@@ -14,6 +14,7 @@
              (statprof))
 
 (define texture #f)
+(define batch #f)
 (define start-time (sdl-ticks))
 (define avg-frame-time 16)
 (define num-sprites 5000)
@@ -37,6 +38,7 @@
 (define (load)
   (set! *random-state* (random-state-from-platform))
   (set! texture (load-image "images/shot.png"))
+  (set! batch (make-sprite-batch texture #:capacity 8000))
   (script
    (forever
     (sleep 60)
@@ -44,13 +46,14 @@
 
 (define stats-text-pos (vec2 4.0 464.0))
 (define (draw alpha)
-  (with-batched-sprites
-   (for-each (match-lambda
-               ((r v)
-                (set-rect-x! r (+ (rect-x r) (vec2-x v)))
-                (set-rect-y! r (+ (rect-y r) (vec2-y v)))
-                (draw-sprite* texture r matrix)))
-             sprites))
+  (sprite-batch-clear! batch)
+  (for-each (match-lambda
+             ((r v)
+              (set-rect-x! r (+ (rect-x r) (vec2-x v)))
+              (set-rect-y! r (+ (rect-y r) (vec2-y v)))
+              (sprite-batch-add* batch r matrix)))
+            sprites)
+  (draw-sprite-batch batch)
   (draw-text stats-text stats-text-pos)
   (let ((current-time (sdl-ticks)))
     (set! avg-frame-time
@@ -61,6 +64,5 @@
 (define (update dt)
   (update-agenda 1))
 
-(gcprof
- (lambda ()
-   (run-game #:load load #:draw draw #:update update)))
+(run-game #:load load #:draw draw #:update update
+          #:window-title "sprite batch stress test")