diff options
Diffstat (limited to 'examples/mines/mines.scm')
| -rw-r--r-- | examples/mines/mines.scm | 123 |
1 files changed, 55 insertions, 68 deletions
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) |