summaryrefslogtreecommitdiff
path: root/examples/life.scm
diff options
context:
space:
mode:
Diffstat (limited to 'examples/life.scm')
-rw-r--r--examples/life.scm67
1 files changed, 35 insertions, 32 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?))