Move the engine-update to the scene

1 files changed, 47 insertions, 72 deletions

diff --git a/tests/physics-test.scm b/tests/physics-test.scm
index a5b40e9..6d1da86 100644
--- a/tests/physics-test.scm
+++ b/tests/physics-test.scm
@@ -67,22 +67,26 @@
                   tileset-source: "" tileset: #f
                   layers: (list layer) objects: '())))
 
+;; Helper to wrap a tilemap (and optional entities) in a scene for pipeline functions
+(define (test-scene #!key (entities '()) (tilemap #f))
+  (make-scene entities: entities tilemap: tilemap camera-target: #f))
+
 ;; Integration helper: simulate one frame of physics
 (define (tick e tm held?)
   (let* ((e (apply-input-to-entity e held?))
-         (e (apply-gravity e))
-         (e (apply-velocity-x e))
-         (e (resolve-tile-collisions-x e tm))
-         (e (apply-velocity-y e))
-         (e (resolve-tile-collisions-y e tm))
-         (e (detect-on-solid e tm)))
+         (e (apply-gravity e #f 0))
+         (e (apply-velocity-x e #f 0))
+         (e (resolve-tile-collisions-x e (test-scene tilemap: tm) 0))
+         (e (apply-velocity-y e #f 0))
+         (e (resolve-tile-collisions-y e (test-scene tilemap: tm) 0))
+         (e (detect-on-solid e (test-scene tilemap: tm) 0)))
     e))
 
 ;; Test: apply-gravity
 (test-group "apply-gravity"
   (test-group "gravity? true, vy starts at 0"
     (let* ((e '(#:type rock #:x 0 #:y 0 #:vx 0 #:vy 0 #:gravity? #t))
-           (result (apply-gravity e)))
+           (result (apply-gravity e #f 0)))
       (test-equal "vy increased by gravity" *gravity* (entity-ref result #:vy))
       (test-equal "x unchanged" 0 (entity-ref result #:x))
       (test-equal "y unchanged" 0 (entity-ref result #:y))
@@ -90,44 +94,44 @@
 
   (test-group "gravity? true, vy already has value"
     (let* ((e '(#:type rock #:x 0 #:y 0 #:vx 0 #:vy 3 #:gravity? #t))
-           (result (apply-gravity e)))
+           (result (apply-gravity e #f 0)))
       (test-equal "vy increased by gravity" 4 (entity-ref result #:vy))))
 
   (test-group "gravity? false"
     (let* ((e '(#:type static #:x 0 #:y 0 #:vx 0 #:vy 0 #:gravity? #f))
-           (result (apply-gravity e)))
+           (result (apply-gravity e #f 0)))
       (test-equal "vy unchanged" 0 (entity-ref result #:vy))))
 
   (test-group "no gravity? field at all"
     (let* ((e '(#:type static #:x 5 #:y 5))
-           (result (apply-gravity e)))
+           (result (apply-gravity e #f 0)))
       (test-equal "entity unchanged" e result))))
 
 (test-group "apply-velocity-x"
   (test-group "basic horizontal movement"
     (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 5 #:vy -2))
-           (result (apply-velocity-x e)))
+           (result (apply-velocity-x e #f 0)))
       (test-equal "x moved by vx" 15 (entity-ref result #:x))
       (test-equal "y unchanged" 20 (entity-ref result #:y))
       (test-equal "vy unchanged" -2 (entity-ref result #:vy))))
 
   (test-group "zero vx"
     (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 0 #:vy 3))
-           (result (apply-velocity-x e)))
+           (result (apply-velocity-x e #f 0)))
       (test-equal "x unchanged" 10 (entity-ref result #:x))
       (test-equal "y unchanged" 20 (entity-ref result #:y)))))
 
 (test-group "apply-velocity-y"
   (test-group "basic vertical movement"
     (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 3 #:vy -5))
-           (result (apply-velocity-y e)))
+           (result (apply-velocity-y e #f 0)))
       (test-equal "x unchanged" 10 (entity-ref result #:x))
       (test-equal "y moved by vy" 15 (entity-ref result #:y))
       (test-equal "vx unchanged" 3 (entity-ref result #:vx))))
 
   (test-group "zero vy"
     (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 3 #:vy 0))
-           (result (apply-velocity-y e)))
+           (result (apply-velocity-y e #f 0)))
       (test-equal "x unchanged" 10 (entity-ref result #:x))
       (test-equal "y unchanged" 20 (entity-ref result #:y)))))
 
@@ -198,20 +202,20 @@
   (test-group "no collision: entity unchanged"
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 2 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "x unchanged" 0  (entity-ref result #:x))
         (test-equal "vx unchanged" 2 (entity-ref result #:vx)))))
 
   (test-group "zero vx: skipped entirely"
     (let* ((tm (make-test-tilemap '((0 1 0) (0 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 0)))
-      (test-equal "entity eq? when vx=0" e (resolve-tile-collisions-x e tm))))
+      (test-equal "entity eq? when vx=0" e (resolve-tile-collisions-x e (test-scene tilemap: tm) 0))))
 
   (test-group "collision moving right: push left"
     ;; solid at col=1 (x=16..31); entity at x=20 overlaps it, vx>0
     (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
            (e  '(#:type player #:x 20 #:y 16 #:width 16 #:height 16 #:vx 5 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "pushed left of solid tile" 0 (entity-ref result #:x))
         (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
 
@@ -219,7 +223,7 @@
     ;; solid at col=1 (x=16..31); entity at x=16 overlaps it, vx<0
     (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
            (e  '(#:type player #:x 16 #:y 16 #:width 16 #:height 16 #:vx -5 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "pushed right of solid tile" 32 (entity-ref result #:x))
         (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
 
@@ -227,7 +231,7 @@
     ;; solid at col=1; entity at x=20.5 (float), vx>0
     (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
            (e  '(#:type player #:x 20.5 #:y 16 #:width 16 #:height 16 #:vx 2 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "pushed left of solid tile" 0 (entity-ref result #:x))
         (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
 
@@ -235,12 +239,12 @@
     ;; wall at col=3; 20px-wide entity at x=28 spans cols 1 and 2, no collision
     (let* ((tm (make-test-tilemap '((0 0 0 1) (0 0 0 1) (0 0 0 1))))
            (e  '(#:type player #:x 28 #:y 0 #:width 20 #:height 16 #:vx 3 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "no collision yet" 28 (entity-ref result #:x))))
     ;; entity moved to x=34 now spans cols 2 and 3 (solid), pushed left
     (let* ((tm (make-test-tilemap '((0 0 0 1) (0 0 0 1) (0 0 0 1))))
            (e  '(#:type player #:x 34 #:y 0 #:width 20 #:height 16 #:vx 3 #:vy 0)))
-      (let ((result (resolve-tile-collisions-x e tm)))
+      (let ((result (resolve-tile-collisions-x e (test-scene tilemap: tm) 0)))
         (test-equal "pushed left of wall" 28 (entity-ref result #:x))
         (test-equal "vx zeroed" 0 (entity-ref result #:vx))))))
 
@@ -248,20 +252,20 @@
   (test-group "no collision: entity unchanged"
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "y unchanged" 0  (entity-ref result #:y))
         (test-equal "vy unchanged" 2 (entity-ref result #:vy)))))
 
   (test-group "zero vy: skipped entirely"
     (let* ((tm (make-test-tilemap '((1 0 0) (0 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 0)))
-      (test-equal "entity eq? when vy=0" e (resolve-tile-collisions-y e tm))))
+      (test-equal "entity eq? when vy=0" e (resolve-tile-collisions-y e (test-scene tilemap: tm) 0))))
 
   (test-group "collision moving down: push up"
     ;; solid at row=1 (y=16..31); entity at y=20 overlaps it, vy>0
     (let* ((tm (make-test-tilemap '((0 0 0) (1 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 20 #:width 16 #:height 16 #:vx 0 #:vy 5)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "pushed above solid tile" 0 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
 
@@ -269,7 +273,7 @@
     ;; solid at row=1 (y=16..31); entity at y=16 overlaps it from below, vy<0
     (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
            (e  '(#:type player #:x 16 #:y 16 #:width 16 #:height 16 #:vx 0 #:vy -5)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "pushed below solid tile" 32 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
 
@@ -277,7 +281,7 @@
     ;; solid at row=1; entity at y=20.5 (float), vy>0
     (let* ((tm (make-test-tilemap '((0 0 0) (1 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 20.5 #:width 16 #:height 16 #:vx 0 #:vy 3)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "pushed above solid tile" 0 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
 
@@ -285,12 +289,12 @@
     ;; floor at row=3; 20px-tall entity at y=28 spans rows 1 and 2, no collision
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0) (1 1 1))))
            (e  '(#:type player #:x 0 #:y 28 #:width 16 #:height 20 #:vx 0 #:vy 3)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "no collision yet" 28 (entity-ref result #:y))))
     ;; entity at y=34 now spans rows 2 and 3 (solid), pushed up
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0) (1 1 1))))
            (e  '(#:type player #:x 0 #:y 34 #:width 16 #:height 20 #:vx 0 #:vy 3)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "pushed above floor" 28 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy))))))
 
@@ -301,7 +305,7 @@
     ;; Correct: snap to top of row 2 → y=16. Bug was: fold overwrote row 2 snap with row 3 snap → y=32 (inside row 2).
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 0 0) (1 0 0) (0 0 0))))
            (e  '(#:type player #:x 0 #:y 34 #:width 16 #:height 16 #:vx 0 #:vy 20)))
-      (let ((result (resolve-tile-collisions-y e tm)))
+      (let ((result (resolve-tile-collisions-y e (test-scene tilemap: tm) 0)))
         (test-equal "snapped to first solid row" 16 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
 
@@ -395,7 +399,7 @@
       (test-equal "a x unchanged" 0 (entity-ref (list-ref result 0) #:x 0))
       (test-equal "b x unchanged" 5 (entity-ref (list-ref result 1) #:x 0)))))
 
-;; New tests for detect-on-solid and apply-jump
+;; Tests for detect-on-solid
 (test-group "detect-on-solid"
   (test-group "entity standing on solid tile"
     ;; Tilemap: 3 rows, row 2 is solid (tile=1), rows 0-1 empty (tile=0)
@@ -404,7 +408,7 @@
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 1 1))))
            (e (list #:type 'player #:x 0 #:y 16 #:width 16 #:height 16
                     #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
-           (result (detect-on-solid e tm)))
+           (result (detect-on-solid e (test-scene tilemap: tm) 0)))
       (test-assert "on-ground? is #t" (entity-ref result #:on-ground? #f))))
 
   (test-group "entity in mid-air"
@@ -412,7 +416,7 @@
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 1 1))))
            (e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
                     #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #t))
-           (result (detect-on-solid e tm)))
+           (result (detect-on-solid e (test-scene tilemap: tm) 0)))
       (test-assert "on-ground? is #f" (not (entity-ref result #:on-ground? #f)))))
 
   (test-group "entity probe spans two tiles, left is solid"
@@ -421,7 +425,7 @@
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 0 0))))
            (e (list #:type 'player #:x 0 #:y 16 #:width 16 #:height 16
                     #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
-           (result (detect-on-solid e tm)))
+           (result (detect-on-solid e (test-scene tilemap: tm) 0)))
       (test-assert "on-ground? is #t (left foot on solid)" (entity-ref result #:on-ground? #f))))
 
   (test-group "entity probe spans two tiles, right is solid"
@@ -430,7 +434,7 @@
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 1 0))))
            (e (list #:type 'player #:x 8 #:y 16 #:width 16 #:height 16
                     #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
-           (result (detect-on-solid e tm)))
+           (result (detect-on-solid e (test-scene tilemap: tm) 0)))
       (test-assert "on-ground? is #t (right foot on solid)" (entity-ref result #:on-ground? #f))))
 
   (test-group "standing on solid entity (no tile): moving platform / crate"
@@ -441,58 +445,33 @@
            (player (list #:type 'player #:x 8 #:y 16 #:width 16 #:height 16
                          #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
            (ents (list platform player))
-           (result (detect-on-solid player tm ents)))
+           (result (detect-on-solid player (test-scene tilemap: tm entities: ents) 0)))
       (test-assert "on-ground? from entity top" (entity-ref result #:on-ground? #f))))
 
-  (test-group "two-arg detect-on-solid skips entity list (backward compatible)"
+  (test-group "scene with empty entity list: no entity below"
     (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
            (platform (list #:type 'platform #:x 0 #:y 32 #:width 64 #:height 16 #:solid? #t))
            (player (list #:type 'player #:x 8 #:y 16 #:width 16 #:height 16
                          #:gravity? #t #:on-ground? #f))
-           (result (detect-on-solid player tm)))
-      (test-assert "no third arg → not on ground" (not (entity-ref result #:on-ground? #f))))))
-
-(test-group "apply-jump"
-  (test-group "on-ground and pressed → impulse applied"
-    (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
-                    #:vx 0 #:vy 0 #:on-ground? #t))
-           (result (apply-jump e #t)))
-      (test-equal "ay is -jump-force" (- *jump-force*) (entity-ref result #:ay 0))))
-
-  (test-group "on-ground but not pressed → unchanged"
-    (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
-                    #:vx 0 #:vy 0 #:on-ground? #t))
-           (result (apply-jump e #f)))
-      (test-equal "vy unchanged" 0 (entity-ref result #:vy 0))))
-
-  (test-group "in-air and pressed → no double jump"
-    (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
-                    #:vx 0 #:vy -5 #:on-ground? #f))
-           (result (apply-jump e #t)))
-      (test-equal "vy unchanged (no double jump)" -5 (entity-ref result #:vy 0))))
-
-  (test-group "in-air and not pressed → unchanged"
-    (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
-                    #:vx 0 #:vy -5 #:on-ground? #f))
-           (result (apply-jump e #f)))
-      (test-equal "vy unchanged" -5 (entity-ref result #:vy 0)))))
+           (result (detect-on-solid player (test-scene tilemap: tm) 0)))
+      (test-assert "empty entity list → not on ground" (not (entity-ref result #:on-ground? #f))))))
 
 (test-group "apply-acceleration"
   (test-group "gravity? #t, ay set: consumed into vy and cleared"
     (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 5 #:gravity? #t))
-           (result (apply-acceleration e)))
+           (result (apply-acceleration e #f 0)))
       (test-equal "vy += ay" 8 (entity-ref result #:vy 0))
       (test-equal "ay cleared" 0 (entity-ref result #:ay 0))))
 
   (test-group "gravity? #t, ay is 0: vy unchanged"
     (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 0 #:gravity? #t))
-           (result (apply-acceleration e)))
+           (result (apply-acceleration e #f 0)))
       (test-equal "vy unchanged" 3 (entity-ref result #:vy 0))
       (test-equal "ay still 0" 0 (entity-ref result #:ay 0))))
 
   (test-group "gravity? #f: entity unchanged"
     (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 5 #:gravity? #f))
-           (result (apply-acceleration e)))
+           (result (apply-acceleration e #f 0)))
       (test-equal "entity unchanged" e result))))
 
 (test-group "pixel->tile"
@@ -626,16 +605,12 @@
 (test-group "skip-pipelines"
   (test-group "apply-gravity"
     (let* ((e '(#:type t #:vy 0 #:gravity? #t #:skip-pipelines (gravity)))
-           (r (apply-gravity e)))
+           (r (apply-gravity e #f 0)))
       (test-equal "skipped: vy unchanged" 0 (entity-ref r #:vy))))
   (test-group "apply-velocity-x"
     (let* ((e '(#:type t #:x 10 #:vx 5 #:skip-pipelines (velocity-x)))
-           (r (apply-velocity-x e)))
+           (r (apply-velocity-x e #f 0)))
       (test-equal "skipped: x unchanged" 10 (entity-ref r #:x))))
-  (test-group "apply-jump"
-    (let* ((e '(#:type t #:on-ground? #t #:skip-pipelines (jump)))
-           (r (apply-jump e #t)))
-      (test-assert "skipped: no ay" (not (memq #:ay r)))))
   (test-group "resolve-pair with entity-collisions skip"
     (define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t))
     (let* ((a (list #:type 'ghost #:x 0 #:y 0 #:width 16 #:height 16 #:solid? #t