summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rwxr-xr-xexamples/2048/2048.scm28
-rw-r--r--examples/mines/mines.scm13
2 files changed, 18 insertions, 23 deletions
diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm
index b5efd34..2b520ac 100755
--- a/examples/2048/2048.scm
+++ b/examples/2048/2048.scm
@@ -322,15 +322,14 @@
(h (texture-height tile-texture))
(label (assoc-ref tile-label-cache n))
(label-color (tile-text-color n))
- (bg-color (tile-bg-color n)))
- (chain `(,(model-paint bg-color tile-sprite)
- ,@(if (zero? n)
- '()
- (list (chain label
- (model-paint label-color)
- (model-move (vector2 (/ w 2) (/ h 2)))))))
- (list->model)
- (model-move (vector2 (* x w) (* y h))))))
+ (bg-color (tile-bg-color n))
+ (tile (model-group (model-paint bg-color tile-sprite)
+ (if (zero? n)
+ null-model
+ (chain label
+ (model-paint label-color)
+ (model-move (vector2 (/ w 2) (/ h 2))))))))
+ (model-move (vector2 (* x w) (* y h)) tile)))
(define window-width 640)
(define window-height 480)
@@ -373,12 +372,11 @@
((board-lose? board) game-over)
((board-win? board) you-win)
(else #f))))
- (chain (if message
- (list message play-again)
- '())
- (list->model)
- (model-move (vector2 (/ board-width 2)
- (/ board-height 2))))))
+ (if message
+ (model-move (vector2 (/ board-width 2)
+ (/ board-height 2))
+ (model-group message play-again))
+ null-model)))
board)))
(define instruction-font (load-default-font 16))
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 126db24..ff18f39 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -348,14 +348,11 @@
(define draw-tile
(let ((offset (translate (vector2 (/ tile-size 2) (/ tile-size 2)))))
(lambda (tile)
- ;; A tile may or may not have an overlay, so we do a little
- ;; quasiquoting magic to build the right list.
- (list->model
- `(,(tile-base-sprite tile)
- ,@(let ((overlay (tile-overlay-sprite tile)))
- (if overlay
- (list (model-place offset overlay))
- '())))))))
+ (model-group (tile-base-sprite tile)
+ (let ((overlay (tile-overlay-sprite tile)))
+ (if overlay
+ (model-place offset overlay)
+ null-model))))))
(define-signal board-view
(signal-map (lambda (board)