diff options
Diffstat (limited to 'examples/mines')
| -rw-r--r-- | examples/mines/mines.scm | 133 |
1 files changed, 75 insertions, 58 deletions
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm index 502d780..0b93473 100644 --- a/examples/mines/mines.scm +++ b/examples/mines/mines.scm @@ -289,17 +289,7 @@ ;;; View ;;; -(init-window) -(enable-fonts) - -(define font (load-default-font)) - -;; 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 +(define (make-tiles tileset) (map (match-lambda ((key . tile-index) (cons key (tileset-ref tileset tile-index)))) @@ -318,66 +308,92 @@ (tile-up . 13) (tile-down . 12)))) -(define (tile-ref key) +(define (tile-ref tiles key) (assoc-ref tiles key)) -(define (tile-base tile) - (tile-ref - (if (tile-shown? tile) - 'tile-down - 'tile-up))) - -(define (tile-overlay tile) - (and=> (cond - ((tile-shown-mine? tile) 'exploded) - ((tile-flagged-mine? tile) 'flag) - ((tile-flagged-maybe? tile) 'maybe) - ((and (tile-shown-not-mine? tile) - (tile-neighboring-mines? tile)) - (tile-mine-count tile)) - (else #f)) - tile-ref)) +(define (tile-base tiles tile) + (tile-ref tiles + (if (tile-shown? tile) + 'tile-down + 'tile-up))) + +(define (tile-overlay tiles tile) + (let ((type (cond + ((tile-shown-mine? tile) 'exploded) + ((tile-flagged-mine? tile) 'flag) + ((tile-flagged-maybe? tile) 'maybe) + ((and (tile-shown-not-mine? tile) + (tile-neighboring-mines? tile)) + (tile-mine-count tile)) + (else #f)))) + (tile-ref tiles type))) (define tile-rect (make-rect 0 0 32 32)) -(define-signal board-view - (signal-let ((board 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) +(define (render-board board tiles batch) + (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 tiles tile)) + (overlay-tex (tile-overlay tiles 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 font message) (move (vector2 (/ (vx resolution) 2) (- (vy resolution) 64)) (render-sprite (make-label font message #:anchor 'center)))) -(define-signal status-message - (let ((game-over (render-message "GAME OVER - Press N to play again")) - (you-win (render-message "YOU WIN! - Press N to play again"))) - (signal-let ((board board)) - (cond - ((board-lose? board) game-over) - ((board-win? board) you-win) - (else render-nothing))))) +(define (render-message-maybe message) + (signal-map-maybe (lambda (font) + (render-message font message)) + font)) (define camera (2d-camera #:area (make-rect (vector2 0 0) resolution) #:clear-color tango-dark-plum)) +(define-signal font + (on-start (load-default-font))) + +;; Minefield is 8x8, and there are 2 layers of tile graphics. +(define-signal batch + (on-start (make-sprite-batch (* 8 8 2)))) + +(define-signal tileset + (on-start (load-tileset "images/tiles.png" 32 32))) + +(define-signal tiles + (signal-map-maybe make-tiles tileset)) + +(define-signal board-view + (signal-map-maybe render-board board tiles batch)) + +(define-signal status-message + (signal-let ((game-over (render-message-maybe + "GAME OVER - Press N to play again")) + (you-win (render-message-maybe + "YOU WIN! - Press N to play again")) + (board board)) + (cond + ((not (or game-over you-win)) ; assets not loaded + render-nothing) + ((board-lose? board) + game-over) + ((board-win? board) + you-win) + (else render-nothing)))) + (define-signal scene (signal-let ((view board-view) (status status-message) @@ -385,17 +401,18 @@ (with-camera camera (render-begin status - (move center view))))) + (move center (or view render-nothing)))))) ;;; ;;; Initialization ;;; -(start-sly-repl) +;;(start-sly-repl) (add-hook! window-close-hook stop-game-loop) (with-window (make-window #:title "Mines" #:resolution resolution) + (enable-fonts) (run-game-loop scene)) ;;; Local Variables: |