examples: Update a few example programs.

* examples/2048/2048: Update.
* examples/animation.scm: Likewise.
* examples/common.scm: Likewise.
* examples/simple.scm: Likewise.

4 files changed, 90 insertions, 73 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)))))
diff --git a/examples/animation.scm b/examples/animation.scm
index b38b1a8..cc84c27 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -15,33 +15,52 @@
 ;;; along with this program.  If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(use-modules (sly animation)
-             (sly game)
+(use-modules (sly game)
+             (sly window)
+             (sly signal)
+             (sly math)
+             (sly math tween)
+             (sly math vector)
+             (sly render camera)
+             (sly render group)
              (sly render sprite)
-             (sly render tileset)
-             (sly vector)
-             (sly window))
+             (sly render tileset))
 
 (load "common.scm")
 
-(define (make-demo-animation)
-  "Load a texture, split it into 64x64 tiles, and build an animated
-sprite out of it."
-  (let* ((tiles (load-tileset "images/princess.png" 64 64))
-         (frames (vector (tileset-ref tiles 19)
-                         (tileset-ref tiles 20)
-                         (tileset-ref tiles 21)
-                         (tileset-ref tiles 22)
-                         (tileset-ref tiles 23)
-                         (tileset-ref tiles 24)
-                         (tileset-ref tiles 25)
-                         (tileset-ref tiles 26))))
-    (make-animation frames 6 #t)))
-
-(define sprite (make-sprite (make-demo-animation)
-                            #:position #(320 240)))
-
-(add-hook! draw-hook (lambda (dt alpha) (draw-sprite sprite)))
+(define walk-cycle
+  (let ((tiles (load-tileset "images/princess.png" 64 64)))
+    (list->vector
+     (map (lambda (id)
+            (sprite (tileset-ref tiles id)))
+          '(19 20 21 22 23 24 25 26)))))
+
+(define position-tween
+  (tween vlerp (compose ease-linear ease-loop)
+         (vector2 480 240) (vector2 160 240) 120))
+
+(define frame-tween
+  (let* ((frame-count (vector-length walk-cycle))
+         (frame-rate (/ 60 frame-count)))
+    (tween (compose floor lerp) (compose ease-linear ease-loop)
+           0 frame-count (* frame-count frame-rate))))
+
+(define-signal timer
+  (signal-fold + 0 (signal-every 1)))
+
+(define-signal scene
+  (signal-map (lambda (time)
+                (group-move (position-tween time)
+                            (group (vector-ref walk-cycle (frame-tween time)))))
+              timer))
+
+(define camera (orthographic-camera 640 480))
+
+(add-hook! draw-hook (lambda _ (draw-group (signal-ref scene) camera)))
 
 (with-window (make-window #:title "Animation")
   (start-game-loop))
+
+;;; Local Variables:
+;;; compile-command: "../pre-inst-env guile animation.scm"
+;;; End:
diff --git a/examples/common.scm b/examples/common.scm
index 46797bb..541488a 100644
--- a/examples/common.scm
+++ b/examples/common.scm
@@ -21,7 +21,6 @@
              (sly input keyboard)
              (sly repl)
              (sly signal)
-             (sly render sprite)
              (sly window))
 
 (open-window)
diff --git a/examples/simple.scm b/examples/simple.scm
index 0fd4503..9560f6f 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -15,34 +15,25 @@
 ;;; along with this program.  If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(use-modules (sly camera)
-             (sly game)
-             (sly math rect)
-             (sly render scene)
-             (sly render sprite)
-             (sly math transform)
-             (sly vector)
+(use-modules (sly game)
              (sly window)
-             (sly render color))
+             (sly math vector)
+             (sly render camera)
+             (sly render group)
+             (sly render sprite))
 
 (load "common.scm")
 
 (define scene
-  (scene-root
-   (scene-node
-    (position #(320 240))
-    (uniforms `(("color" ,white)))
-    (children
-     (list (load-sprite "images/p1_front.png"))))))
+  (group-move (vector2 320 240)
+              (group (load-sprite "images/p1_front.png"))))
 
-(define camera
-  (make-camera scene
-               identity-transform
-               (orthographic-projection 0 640 0 480 0 1)
-               (make-rect 0 0 640 480)))
+(define camera (orthographic-camera 640 480))
+
+(add-hook! draw-hook (lambda _ (draw-group scene camera)))
 
 (with-window (make-window #:title "Simple Sprite Demo")
-  (start-game-loop camera))
+  (start-game-loop))
 
 ;;; Local Variables:
 ;;; compile-command: "../pre-inst-env guile simple.scm"