summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-01-01 16:48:24 -0500
committerDavid Thompson <dthompson2@worcester.edu>2016-01-01 17:42:38 -0500
commit23d69fdb85481bfc915bb28ff4dafd4765ac90f8 (patch)
tree3b4b4200901693f89fbe53f473c87ccb79b161f6
parentc338673e98df34e7642cfc598792e83115159be0 (diff)
Update examples to use sprite batch.
-rw-r--r--examples/life.scm67
-rw-r--r--examples/mines/mines.scm123
2 files changed, 90 insertions, 100 deletions
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?))
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)