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/mines/mines.scm | 123 +++++++++++++++++++++--------------------------
 1 file changed, 55 insertions(+), 68 deletions(-)

(limited to 'examples/mines')

diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index fd7256f..502d780 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -39,7 +39,9 @@
              (sly render color)
              (sly render font)
              (sly render sprite)
+             (sly render sprite-batch)
              (sly render texture)
+             (sly render tileset)
              (sly input keyboard)
              (sly input mouse))
 
@@ -52,14 +54,13 @@
 (define (list-replace lst k value)
   (append (take lst k) (cons value (drop lst (1+ k)))))
 
-(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)))))
 
 (define (compact lst)
   (filter identity lst))
@@ -293,53 +294,40 @@
 
 (define font (load-default-font))
 
-(define sprites
+;; Minefield is 8x8, and there are 2 layers of tile graphics.
+(define batch (make-sprite-batch (* 8 8 2)))
+
+(define tileset (load-tileset "images/tiles.png" 32 32))
+
+(define tiles
   (map (match-lambda
-        ((key . config)
-         (let ((sprite (load-sprite (string-append "images/"
-                                                   (assoc-ref config 'name)
-                                                   ".png")
-                                    #:anchor (assoc-ref config 'anchor))))
-           (cons key sprite))))
-       '((1 .        ((name . "1-mine")
-                      (anchor . center)))
-         (2 .        ((name . "2-mines")
-                      (anchor . center)))
-         (3 .        ((name . "3-mines")
-                      (anchor . center)))
-         (4 .        ((name . "4-mines")
-                      (anchor . center)))
-         (5 .        ((name . "5-mines")
-                      (anchor . center)))
-         (6 .        ((name . "6-mines")
-                      (anchor . center)))
-         (7 .        ((name . "7-mines")
-                      (anchor . center)))
-         (8 .        ((name . "8-mines")
-                      (anchor . center)))
-         (mine .     ((name . "mine")
-                      (anchor . center)))
-         (exploded . ((name . "exploded")
-                      (anchor . center)))
-         (flag .     ((name . "flag")
-                      (anchor . center)))
-         (maybe .    ((name . "maybe")
-                      (anchor . center)))
-         (tile-up .  ((name . "tile-up")
-                      (anchor . bottom-left)))
-         (tile-down .((name . "tile-down")
-                      (anchor . bottom-left))))))
-
-(define (sprite-ref key)
-  (assoc-ref sprites key))
-
-(define (tile-base-sprite tile)
-  (sprite-ref
+         ((key . tile-index)
+          (cons key (tileset-ref tileset tile-index))))
+       '((1 . 10)
+         (2 . 11)
+         (3 . 4)
+         (4 . 5)
+         (5 . 6)
+         (6 . 7)
+         (7 . 0)
+         (8 . 1)
+         (mine . 14)
+         (exploded . 15)
+         (flag . 8)
+         (maybe . 9)
+         (tile-up . 13)
+         (tile-down . 12))))
+
+(define (tile-ref key)
+  (assoc-ref tiles key))
+
+(define (tile-base tile)
+  (tile-ref
    (if (tile-shown? tile)
        'tile-down
        'tile-up)))
 
-(define (tile-overlay-sprite tile)
+(define (tile-overlay tile)
   (and=> (cond
           ((tile-shown-mine? tile) 'exploded)
           ((tile-flagged-mine? tile) 'flag)
@@ -348,29 +336,28 @@
                 (tile-neighboring-mines? tile))
            (tile-mine-count tile))
           (else #f))
-         sprite-ref))
+         tile-ref))
 
-(define render-tile
-  (let ((offset (vector2 (/ tile-size 2) (/ tile-size 2))))
-    (lambda (tile)
-      (render-begin
-       (render-sprite (tile-base-sprite tile))
-       (let ((overlay (tile-overlay-sprite tile)))
-         (if overlay
-             (move offset (render-sprite overlay))
-             render-nothing))))))
+(define tile-rect (make-rect 0 0 32 32))
 
 (define-signal board-view
   (signal-let ((board board))
-    (define (render-column tile x)
-      (move (vector2 (* x tile-size) 0)
-            (render-tile tile)))
-
-    (define (render-row row y)
-      (move (vector2 0 (* y tile-size))
-            (list->renderer (enumerate-map render-column row))))
-
-    (list->renderer (enumerate-map render-row board))))
+    (lambda (gfx)
+      (with-sprite-batch batch gfx
+        (enumerate-each
+         (lambda (row y)
+           (enumerate-each
+            (lambda (tile x)
+              (let ((rect (rect-move tile-rect
+                                     (* x tile-size)
+                                     (* y tile-size)))
+                    (base-tex (tile-base tile))
+                    (overlay-tex (tile-overlay tile)))
+                (sprite-batch-add! batch gfx base-tex rect)
+                (when overlay-tex
+                  (sprite-batch-add! batch gfx overlay-tex rect))))
+            row))
+         board)))))
 
 (define (render-message message)
   (move (vector2 (/ (vx resolution) 2)
-- 
cgit v1.2.3