summaryrefslogtreecommitdiff
path: root/examples/2048/2048
diff options
context:
space:
mode:
Diffstat (limited to 'examples/2048/2048')
-rwxr-xr-xexamples/2048/204866
1 files changed, 37 insertions, 29 deletions
diff --git a/examples/2048/2048 b/examples/2048/2048
index ddf46df..8d0c134 100755
--- a/examples/2048/2048
+++ b/examples/2048/2048
@@ -327,12 +327,14 @@
(label (assoc-ref tile-label-cache n))
(label-color (tile-text-color n))
(bg-color (tile-bg-color n)))
- (apply group-move (vector2 (* x w) (* y h))
- (model-paint bg-color tile-sprite)
- (if (zero? n)
- '()
- (list (group-move (vector2 (/ w 2) (/ h 2))
- (model-paint label-color label)))))))
+ (group-move (vector2 (* x w) (* y h))
+ (make-group
+ (cons (model-paint bg-color tile-sprite)
+ (if (zero? n)
+ '()
+ (list (group-move (vector2 (/ w 2) (/ h 2))
+ (group (model-paint label-color
+ label))))))))))
(define window-width 640)
(define window-height 480)
@@ -362,22 +364,25 @@
(define play-again-font (load-default-font 16))
(define-signal status-message
- (signal-map
- (lambda (board)
- (let ((message (cond
- ((board-lose? board) "GAME OVER")
- ((board-win? board) "YOU WIN!")
- (else #f))))
- (apply group-move (vector2 (/ board-width 2)
- (/ board-height 2))
- (if message
- (list (model-paint black (label font message
- #:anchor 'bottom-center))
- (model-paint black (label play-again-font
- "Press N to play again"
- #:anchor 'top-center)))
- '()))))
- board))
+ (let ((play-again (model-paint black (label play-again-font
+ "Press N to play again"
+ #:anchor 'top-center)))
+ (game-over (model-paint black (label font "GAME OVER"
+ #:anchor 'bottom-center)))
+ (you-win (model-paint black (label font "YOU WIN!"
+ #:anchor 'bottom-center))))
+ (signal-map
+ (lambda (board)
+ (let ((message (cond
+ ((board-lose? board) game-over)
+ ((board-win? board) you-win)
+ (else #f))))
+ (group-move (vector2 (/ board-width 2)
+ (/ board-height 2))
+ (make-group (if message
+ (list message play-again)
+ '())))))
+ board)))
(define instruction-font (load-default-font 16))
@@ -386,9 +391,10 @@
(define-signal instructions
(group-move (vector2 (/ board-width 2) (- window-height (vy center-pos)))
- (model-paint text-color-1
- (label instruction-font instruction-text
- #:anchor 'top-center))))
+ (group
+ (model-paint text-color-1
+ (label instruction-font instruction-text
+ #:anchor 'top-center)))))
(define score-header-font (load-default-font 14))
(define score-font (load-default-font 22))
@@ -406,10 +412,12 @@
(let ((score (label score-font (number->string score)
#:anchor 'center)))
(group-move (vector2 x (- window-height 28))
- (model-paint text-color-1 header)
- (group-move (position-tween timer)
- (model-paint (color-tween timer)
- score)))))
+ (group
+ (model-paint text-color-1 header)
+ (group-move (position-tween timer)
+ (group
+ (model-paint (color-tween timer)
+ score)))))))
score
(signal-drop (lambda (t) (> t duration))
0 (signal-since 1 score)))))