Added tweens

1 files changed, 34 insertions, 18 deletions

diff --git a/physics.scm b/physics.scm
index 627dbea..f3cc3bb 100644
--- a/physics.scm
+++ b/physics.scm
@@ -1,4 +1,12 @@
-(module downstroke-physics *
+(module downstroke-physics
+    (scene-resolve-collisions resolve-entity-collisions resolve-pair
+     aabb-overlap? push-apart push-along-axis aabb-overlap-on-axis
+     entity-center-on-axis push-entity axis->velocity axis->dimension
+     index-pairs list-set apply-jump detect-ground
+     resolve-tile-collisions-y resolve-tile-collisions-x resolve-tile-collisions-axis
+     tile-push-pos entity-tile-cells pixel->tile build-cell-list
+     apply-velocity apply-velocity-y apply-velocity-x apply-gravity apply-acceleration
+     *jump-force* *gravity*)
   (import scheme
       (chicken base)
       (chicken keyword)
@@ -15,8 +23,11 @@
   ;; Jump force: vertical acceleration applied on jump (one frame)
   (define *jump-force* 15)
 
+  ;; Per-entity steps use define-pipeline from downstroke-entity (see docs/physics.org
+  ;; for #:skip-pipelines symbol names).
+
   ;; Consume #:ay into #:vy and clear it (one-shot acceleration)
-  (define (apply-acceleration entity)
+  (define-pipeline (apply-acceleration acceleration) (entity)
     (if (not (entity-ref entity #:gravity? #f))
         entity
         (let ((ay (entity-ref entity #:ay 0))
@@ -24,21 +35,19 @@
           (entity-set (entity-set entity #:vy (+ vy ay)) #:ay 0))))
 
   ;; Apply gravity to an entity if it has gravity enabled
-  (define (apply-gravity entity)
+  (define-pipeline (apply-gravity gravity) (entity)
     (if (entity-ref entity #:gravity? #f)
         (entity-set entity #:vy (+ (entity-ref entity #:vy) *gravity*))
         entity))
 
   ;; Update entity's x by its vx velocity
-  (define (apply-velocity-x entity)
-    "Update entity's x by its vx velocity."
+  (define-pipeline (apply-velocity-x velocity-x) (entity)
     (let ((x (entity-ref entity #:x 0))
           (vx (entity-ref entity #:vx 0)))
       (entity-set entity #:x (+ x vx))))
 
   ;; Update entity's y by its vy velocity
-  (define (apply-velocity-y entity)
-    "Update entity's y by its vy velocity."
+  (define-pipeline (apply-velocity-y velocity-y) (entity)
     (let ((y (entity-ref entity #:y 0))
           (vy (entity-ref entity #:vy 0)))
       (entity-set entity #:y (+ y vy))))
@@ -46,11 +55,17 @@
   ;; Legacy function: update both x and y by velocities
   (define (apply-velocity entity)
     "Legacy function: update both x and y by velocities."
-    (let ((x  (entity-ref entity #:x 0))
-          (y  (entity-ref entity #:y 0))
-          (vx (entity-ref entity #:vx 0))
-          (vy (entity-ref entity #:vy 0)))
-      (entity-set (entity-set entity #:x (+ x vx)) #:y (+ y vy))))
+    (let* ((x  (entity-ref entity #:x 0))
+           (y  (entity-ref entity #:y 0))
+           (vx (entity-ref entity #:vx 0))
+           (vy (entity-ref entity #:vy 0))
+           (e (if (downstroke-entity#entity-skips-pipeline? entity 'velocity-x)
+                  entity
+                  (entity-set entity #:x (+ x vx))))
+           (e (if (downstroke-entity#entity-skips-pipeline? entity 'velocity-y)
+                  e
+                  (entity-set e #:y (+ (entity-ref e #:y 0) vy)))))
+      e))
 
   ;; Build list of (col . row) pairs to check for collisions
   (define (build-cell-list col-start col-end row-start row-end)
@@ -110,21 +125,21 @@
                 (entity-tile-cells entity tilemap)))))
 
   ;; Resolve horizontal collisions with solid tiles
-  (define (resolve-tile-collisions-x entity tilemap)
+  (define-pipeline (resolve-tile-collisions-x tile-collisions-x) (entity tilemap)
     (let ((w  (entity-ref entity #:width 0))
           (tw (tilemap-tilewidth tilemap)))
       (resolve-tile-collisions-axis entity tilemap #:vx #:x
         (lambda (v col row) (tile-push-pos v col tw w)))))
 
   ;; Resolve vertical collisions with solid tiles
-  (define (resolve-tile-collisions-y entity tilemap)
+  (define-pipeline (resolve-tile-collisions-y tile-collisions-y) (entity tilemap)
     (let ((h  (entity-ref entity #:height 0))
           (th (tilemap-tileheight tilemap)))
       (resolve-tile-collisions-axis entity tilemap #:vy #:y
         (lambda (v col row) (tile-push-pos v row th h)))))
 
   ;; Detect if entity is standing on ground by probing 1px below feet
-  (define (detect-ground entity tilemap)
+  (define-pipeline (detect-ground ground-detection) (entity tilemap)
     (if (not (entity-ref entity #:gravity? #f))
         entity
         (let* ((x       (entity-ref entity #:x 0))
@@ -140,8 +155,7 @@
           (entity-set entity #:on-ground? on-ground?))))
 
   ;; Set vertical acceleration for jump (consumed next frame by apply-acceleration)
-  (define (apply-jump entity jump-pressed?)
-    "Set #:ay to jump force if jump pressed and entity is on ground."
+  (define-pipeline (apply-jump jump) (entity jump-pressed?)
     (if (and jump-pressed? (entity-ref entity #:on-ground? #f))
         (entity-set entity #:ay (- (entity-ref entity #:jump-force *jump-force*)))
         entity))
@@ -215,7 +229,9 @@
   ;; Resolve AABB collision between two solid entities.
   ;; Returns (a2 . b2) with positions/velocities adjusted, or #f if no collision.
   (define (resolve-pair a b)
-    (and (entity-ref a #:solid? #f)
+    (and (not (downstroke-entity#entity-skips-pipeline? a 'entity-collisions))
+         (not (downstroke-entity#entity-skips-pipeline? b 'entity-collisions))
+         (entity-ref a #:solid? #f)
          (entity-ref b #:solid? #f)
          (aabb-overlap? (entity-ref a #:x 0) (entity-ref a #:y 0)
                         (entity-ref a #:width 0) (entity-ref a #:height 0)