summaryrefslogtreecommitdiff
path: root/examples/mines
diff options
context:
space:
mode:
Diffstat (limited to 'examples/mines')
-rw-r--r--examples/mines/mines.scm133
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: