From 23d69fdb85481bfc915bb28ff4dafd4765ac90f8 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 1 Jan 2016 16:48:24 -0500
Subject: Update examples to use sprite batch.

---
 examples/life.scm | 67 +++++++++++++++++++++++++++++--------------------------
 1 file changed, 35 insertions(+), 32 deletions(-)

(limited to 'examples/life.scm')

diff --git a/examples/life.scm b/examples/life.scm
index 2d4e30a..763e5d4 100644
--- a/examples/life.scm
+++ b/examples/life.scm
@@ -33,6 +33,9 @@
              (sly render)
              (sly render camera)
              (sly render sprite)
+             (sly render sprite-batch)
+             (sly render texture)
+             (sly render tileset)
              (sly render color)
              (sly input mouse))
 
@@ -48,15 +51,13 @@
                (vlist-drop vlist (+ 1 index)))))
 
 ;; Pulled out of mines.scm
-
-(define (enumerate-map proc lst)
-  (define (iter k lst)
+(define (enumerate-each proc lst)
+  (let loop ((k 0) (lst lst))
     (match lst
-      (() '())
-      ((x . rest)
-       (cons (proc x k) (iter (1+ k) rest)))))
-
-  (iter 0 lst))
+      (() *unspecified*)
+      ((head . tail)
+       (proc head k)
+       (loop (1+ k) tail)))))
 
 ;;;
 ;;; Sly stuff starts here
@@ -67,17 +68,17 @@
 (define tile-size 32)
 (define window-res (vector2 448 480))
 
+(define tileset
+  (load-tileset "mines/images/tiles.png" 32 32))
+
 (define alive-texture
-  (load-texture "mines/images/tile-down.png"))
+  (tileset-ref tileset 12))
 
 (define empty-texture
-  (load-texture "mines/images/tile-up.png"))
+  (tileset-ref tileset 13))
 
-(define sprite-cell-alive
-  (make-sprite alive-texture #:anchor 'bottom-left))
-
-(define sprite-cell-empty
-  (make-sprite empty-texture #:anchor 'bottom-left))
+(define batch
+  (make-sprite-batch (expt 14 2)))
 
 ;;;
 ;;; State
@@ -289,27 +290,29 @@ If there is no neighbor on an edge, the board wraps around"
     (/ (* board-size tile-size) 2)
     (/ (* board-size tile-size) 2))))
 
+(define sprite-rect
+  (make-rect 0 0 32 32))
+
 ;; Model of the tile grid
 (define-signal tiles-view
   (signal-let ((board board)
                (board-size board-size))
-    (list->renderer
-     (enumerate-map
-      (lambda (row row-count)
-        (list->renderer
-         (enumerate-map
-          (lambda (tile-alive col-count)
-            (move (tile-pos row-count col-count
-                            board-size tile-size)
-                  (render-sprite
-                   (if tile-alive
-                       sprite-cell-alive
-                       sprite-cell-empty))))
-          (vlist->list row))))
-      ;; FIXME:
-      ;; This slows things down more than it should have to
-      ;; we should map natively on the vlist
-      (vlist->list board)))))
+    (lambda (gfx)
+      (with-sprite-batch batch gfx
+        (enumerate-each
+         (lambda (row y)
+           (enumerate-each
+            (lambda (alive? x)
+              (let ((rect (rect-move sprite-rect
+                                     (tile-pos y x board-size tile-size))))
+                (sprite-batch-add! batch
+                                   gfx
+                                   (if alive?
+                                       alive-texture
+                                       empty-texture)
+                                   rect)))
+            (vlist->list row)))
+         (vlist->list board))))))
 
 (define-signal camera
   (signal-let ((running? simulation-running?))
-- 
cgit v1.2.3