Code cleanup

2 files changed, 48 insertions, 185 deletions

diff --git a/demo/sandbox.scm b/demo/sandbox.scm
index d7bd53f..f757c7f 100644
--- a/demo/sandbox.scm
+++ b/demo/sandbox.scm
@@ -27,41 +27,7 @@
 
 ;; ── Mutable demo state ──────────────────────────────────────────────────────
 
-(define *demo-t*        0.0)
-(define *shelf-endpoints* #f)
-(define *shelf-tween*     #f)
-(define *shelf-origin*    #f)
-
-;; ── Tween helpers ────────────────────────────────────────────────────────────
-
-(define (other-endpoint x endpoints)
-  (let ((lo (car endpoints))
-        (hi (cdr endpoints)))
-    (if (< (abs (- x lo)) (abs (- x hi))) hi lo)))
-
-(define (make-ping-pong-tween leader endpoints)
-  (make-tween leader
-    props: `((#:x . ,(other-endpoint (entity-ref leader #:x 0) endpoints)))
-    duration: 3500 ease: 'sine-in-out))
-
-(define (scene-replace-group-origin! scene gid new-origin)
-  (scene-entities-set! scene
-    (map (lambda (e)
-           (if (and (entity-ref e #:group-origin? #f)
-                    (eq? (entity-ref e #:group-id) gid))
-               new-origin
-               e))
-         (scene-entities scene))))
-
-(define (advance-shelf-tween! scene dt)
-  (when (and *shelf-tween* *shelf-origin*)
-    (let ((gid (entity-ref *shelf-origin* #:group-id)))
-      (receive (tw2 e0) (tween-step *shelf-tween* *shelf-origin* dt)
-        (set! *shelf-tween* (if (tween-finished? tw2)
-                                (make-ping-pong-tween e0 *shelf-endpoints*)
-                                tw2))
-        (set! *shelf-origin* e0)
-        (scene-replace-group-origin! scene gid e0)))))
+(define *demo-t* 0.0)
 
 ;; ── Tilemap builder ──────────────────────────────────────────────────────────
 
@@ -143,13 +109,16 @@
 
 ;; ── Scene builder ───────────────────────────────────────────────────────────
 
-(define (init-shelf-tween! shelf-list tw)
+(define (attach-shelf-tween! shelf-list tw)
   (let* ((origin  (car shelf-list))
          (x-left  (entity-ref origin #:x 0))
-         (x-right (+ x-left (* 6 tw))))
-    (set! *shelf-origin*    origin)
-    (set! *shelf-endpoints* (cons x-left x-right))
-    (set! *shelf-tween*     (make-ping-pong-tween origin *shelf-endpoints*))))
+         (x-right (+ x-left (* 6 tw)))
+         (tweened (entity-set origin #:tween
+                    (make-tween origin
+                      props: `((#:x . ,x-right))
+                      duration: 3500 ease: 'sine-in-out
+                      repeat: -1 yoyo?: #t))))
+    (cons tweened (cdr shelf-list))))
 
 (define (make-sandbox-scene game)
   (let* ((reg  (load-prefabs "demo/assets/sandbox-groups.scm" (engine-mixins) '()))
@@ -160,14 +129,15 @@
          (gw   (game-width game))
          (gh   (game-height game))
          (tm   (make-sandbox-tilemap ts tw th gw gh))
-         (shelf-list (instantiate-group-prefab reg 'shelf-platform
-                       (* 10 tw) (- gh (* 6 th))))
+         (shelf-list (attach-shelf-tween!
+                       (instantiate-group-prefab reg 'shelf-platform
+                         (* 10 tw) (- gh (* 6 th)))
+                       tw))
          (raft-list  (instantiate-group-prefab reg 'collision-raft
                        120 (- gh (* 14 th))))
          (bots  (list (make-demo-bot  80 80 tw th 0)
                       (make-demo-bot 220 60 tw th 1)
                       (make-demo-bot 380 100 tw th 2))))
-    (init-shelf-tween! shelf-list tw)
     (make-scene
       entities:        (append shelf-list raft-list (spawn-boxes tw th) bots)
       tilemap:         tm
@@ -191,7 +161,7 @@
       (set! *demo-t* (+ *demo-t* dt))
       (let* ((scene (game-scene game))
              (tm    (scene-tilemap scene)))
-        (advance-shelf-tween! scene dt)
+        (scene-update-entities scene (lambda (e) (step-tweens e dt)))
         (scene-update-entities scene (lambda (e) (integrate-entity e dt tm)))
         (scene-sync-groups! scene)
         (scene-resolve-collisions scene)
diff --git a/demo/tweens.scm b/demo/tweens.scm
index 34c7759..a286a49 100644
--- a/demo/tweens.scm
+++ b/demo/tweens.scm
@@ -1,23 +1,17 @@
 (import scheme
         (chicken base)
         (only srfi-1 iota)
-        (only srfi-197 chain)
         (prefix sdl2 "sdl2:")
         (prefix sdl2-ttf "ttf:")
         downstroke-engine
         downstroke-world
         downstroke-renderer
-        downstroke-physics
         downstroke-entity
         downstroke-tween)
 
 ;; ── Constants ────────────────────────────────────────────────────────────────
 
 (define +ease-duration+ 2600)
-(define +knock-cooldown-ms+ 3200)
-(define +knock-distance+ 88)
-(define +knock-duration+ 650)
-(define +knock-skip+ '(jump acceleration gravity velocity-x velocity-y))
 
 (define +ease-syms+
   '(linear quad-in quad-out quad-in-out cubic-in cubic-out cubic-in-out
@@ -30,127 +24,39 @@
 
 ;; ── State ────────────────────────────────────────────────────────────────────
 
-(define *ease-cells*  #f)   ; vector of #(ent tw left right ease-sym to-right?)
-(define *knock-ent*   #f)
-(define *knock-tw*    #f)
-(define *knock-cd*    0)
 (define *label-font*  #f)
 (define *title-font*  #f)
 
 ;; ── Ease grid ────────────────────────────────────────────────────────────────
 
-(define (make-ease-cell ease-sym y rgb)
+(define (make-ease-entity ease-sym y rgb)
   (let* ((left  20)
          (right (+ left 120))
-         (ent   (list #:type 'tween-demo #:x left #:y y
-                      #:width 14 #:height 14
-                      #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:color rgb))
-         (tw    (make-tween ent props: `((#:x . ,right))
-                  duration: +ease-duration+ ease: ease-sym)))
-    (vector ent tw left right ease-sym #t)))
-
-(define (advance-ease-cell! cell dt)
-  (let ((ent      (vector-ref cell 0))
-        (tw       (vector-ref cell 1))
-        (left     (vector-ref cell 2))
-        (right    (vector-ref cell 3))
-        (ease     (vector-ref cell 4))
-        (to-right? (vector-ref cell 5)))
-    (receive (tw2 ent2) (tween-step tw ent dt)
-      (vector-set! cell 0 ent2)
-      (if (tween-finished? tw2)
-          (let* ((next-dir (not to-right?))
-                 (target   (if next-dir right left)))
-            (vector-set! cell 1 (make-tween ent2 props: `((#:x . ,target))
-                                  duration: +ease-duration+ ease: ease))
-            (vector-set! cell 5 next-dir))
-          (vector-set! cell 1 tw2)))))
-
-;; ── Knockback crate ──────────────────────────────────────────────────────────
-
-(define (run-physics e tm)
-  (chain e
-         (apply-jump _ #f)
-         (apply-acceleration _)
-         (apply-gravity _)
-         (apply-velocity-x _)
-         (resolve-tile-collisions-x _ tm)
-         (apply-velocity-y _)
-         (resolve-tile-collisions-y _ tm)
-         (detect-on-solid _ tm)))
-
-(define (clamp-entity-to-screen e gw gh)
-  (let* ((w  (entity-ref e #:width 0))
-         (h  (entity-ref e #:height 0))
-         (x  (entity-ref e #:x 0))
-         (y  (entity-ref e #:y 0))
-         (nx (max 0 (min (- gw w) x)))
-         (ny (max 0 (min (- gh h) y)))
-         (on-floor? (and (entity-ref e #:gravity? #f) (= ny (- gh h)))))
-    (chain e
-           (entity-set _ #:x nx)
-           (entity-set _ #:y ny)
-           (entity-set _ #:vx (if (= nx x) (entity-ref e #:vx 0) 0))
-           (entity-set _ #:vy (if (= ny y) (entity-ref e #:vy 0) 0))
-           (entity-set _ #:on-ground? on-floor?))))
-
-(define (run-physics-no-tilemap e gw gh)
-  (chain e
-         (apply-jump _ #f)
-         (apply-acceleration _)
-         (apply-gravity _)
-         (apply-velocity-x _)
-         (apply-velocity-y _)
-         (clamp-entity-to-screen _ gw gh)))
-
-(define (maybe-start-knockback!)
-  (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* +knock-cooldown-ms+))
-    (set! *knock-cd* 0)
-    (let ((x (entity-ref *knock-ent* #:x 0)))
-      (set! *knock-ent* (entity-set *knock-ent* #:skip-pipelines +knock-skip+))
-      (set! *knock-tw*
-        (make-tween *knock-ent*
-          props: `((#:x . ,(+ x +knock-distance+)))
-          duration: +knock-duration+
-          ease: 'back-out
-          on-complete: (lambda (e)
-                         (set! *knock-ent* (entity-set e #:skip-pipelines '()))))))))
-
-(define (advance-knockback-tween! dt)
-  (when *knock-tw*
-    (receive (t2 e2) (tween-step *knock-tw* *knock-ent* dt)
-      (set! *knock-tw*  (if (tween-finished? t2) #f t2))
-      (set! *knock-ent* e2))))
-
-(define (update-knockback! dt tm gw gh)
-  (set! *knock-cd* (+ *knock-cd* dt))
-  (maybe-start-knockback!)
-  (advance-knockback-tween! dt)
-  (when *knock-ent*
-    (set! *knock-ent*
-      (if tm
-          (run-physics *knock-ent* tm)
-          (run-physics-no-tilemap *knock-ent* gw gh)))))
+         (base  (list #:x left #:y y)))
+    (list #:type 'tween-demo #:x left #:y y
+          #:width 14 #:height 14
+          #:vx 0 #:vy 0 #:gravity? #f #:solid? #f
+          #:color rgb
+          #:ease-name ease-sym
+          #:tween (make-tween base props: `((#:x . ,right))
+                    duration: +ease-duration+ ease: ease-sym
+                    repeat: -1 yoyo?: #t))))
 
 ;; ── Rendering ────────────────────────────────────────────────────────────────
 
-(define (draw-ease-labels! renderer)
+(define (draw-ease-labels! renderer entities)
   (let ((white (sdl2:make-color 255 255 255 255)))
     (draw-ui-text renderer *title-font*
-      "Tween demo - easing rows + knockback / skip-pipelines" white 12 6)
+      "Tween demo - easing curves" white 12 6)
     (draw-ui-text renderer *label-font*
-      "Each box loops on X; bottom crate tweens right with physics skipped, screen bounds only."
-      white 12 32)
-    (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
-      (let* ((cell (vector-ref *ease-cells* i))
-             (ent  (vector-ref cell 0))
-             (lab  (symbol->string (vector-ref cell 4))))
-        (draw-ui-text renderer *label-font* lab white
-          158 (- (entity-ref ent #:y 0) 2))))))
-
-(define (ease-cell-entities)
-  (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0))
-       (iota (vector-length *ease-cells*))))
+      "Each box ping-pongs with repeat: -1 yoyo?: #t" white 12 32)
+    (for-each
+      (lambda (e)
+        (let ((name (entity-ref e #:ease-name #f)))
+          (when name
+            (draw-ui-text renderer *label-font* (symbol->string name) white
+              158 (- (entity-ref e #:y 0) 2)))))
+      entities)))
 
 ;; ── Game ─────────────────────────────────────────────────────────────────────
 
@@ -163,37 +69,24 @@
       (set! *label-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 13)))
 
     create: (lambda (game)
-      (set! *ease-cells*
-        (list->vector
-          (map (lambda (ease i)
-                 (make-ease-cell ease (+ 52 (* i 20)) (list-ref +ease-colors+ i)))
-               +ease-syms+ (iota (length +ease-syms+)))))
-      (set! *knock-ent*
-        (list #:type 'knock-crate #:x 200 #:y 80
-              #:width 18 #:height 18
-              #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f #:solid? #f
-              #:color '(140 110 70)))
-      (set! *knock-tw* #f)
-      (set! *knock-cd* 2500)
       (game-scene-set! game
-        (make-scene entities: (append (ease-cell-entities) (list *knock-ent*))
-                     tilemap: #f
-                     camera: (make-camera x: 0 y: 0)
-                     tileset-texture: #f
-                     camera-target: #f
-                     background: '(26 28 34))))
+        (make-scene
+          entities: (map (lambda (ease i)
+                           (make-ease-entity ease (+ 52 (* i 20))
+                                             (list-ref +ease-colors+ i)))
+                         +ease-syms+ (iota (length +ease-syms+)))
+          tilemap: #f
+          camera: (make-camera x: 0 y: 0)
+          tileset-texture: #f
+          camera-target: #f
+          background: '(26 28 34))))
 
     update: (lambda (game dt)
-      (let ((tm (scene-tilemap (game-scene game)))
-            (gw (game-width game))
-            (gh (game-height game)))
-        (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
-          (advance-ease-cell! (vector-ref *ease-cells* i) dt))
-        (update-knockback! dt tm gw gh)
-        (scene-entities-set! (game-scene game)
-          (append (ease-cell-entities) (list *knock-ent*)))))
+      (scene-update-entities (game-scene game)
+        (lambda (e) (step-tweens e dt))))
 
     render: (lambda (game)
-      (draw-ease-labels! (game-renderer game)))))
+      (draw-ease-labels! (game-renderer game)
+                         (scene-entities (game-scene game))))))
 
 (game-run! *game*)