diff options
| -rwxr-xr-x | examples/2048/2048.scm | 28 | ||||
| -rw-r--r-- | examples/mines/mines.scm | 13 |
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) |