Use entities as platforms

1 files changed, 23 insertions, 11 deletions

diff --git a/physics.scm b/physics.scm
index 979eb4b..083046d 100644
--- a/physics.scm
+++ b/physics.scm
@@ -257,20 +257,32 @@
 
   ;; Move ~m~ out of ~s~ along the shallow penetration axis; ~s~ is unchanged.
   ;; Used when ~s~ has #:immovable? #t.
+  ;;
+  ;; When ~m~ is falling onto ~s~ from above, the minimum-penetration axis can be
+  ;; horizontal (narrow overlap in X but deeper in Y), which shoves the mover
+  ;; sideways instead of resting it on the platform. Prefer vertical separation
+  ;; whenever ~m~'s center is still above ~s~'s center (landing contact).
   (define (separate-movable-from-static m s)
     (let* ((ovx (aabb-overlap-on-axis #:x m s))
-           (ovy (aabb-overlap-on-axis #:y m s)))
-      (if (<= ovx ovy)
-          (let* ((mc (entity-center-on-axis m #:x))
-                 (sc (entity-center-on-axis s #:x))
-                 (dir (if (< mc sc) -1 1))
-                 (mx (entity-ref m #:x 0)))
-            (entity-set (entity-set m #:x (+ mx (* dir ovx))) #:vx 0))
-          (let* ((mc (entity-center-on-axis m #:y))
-                 (sc (entity-center-on-axis s #:y))
-                 (dir (if (< mc sc) -1 1))
+           (ovy (aabb-overlap-on-axis #:y m s))
+           (m-cy (entity-center-on-axis m #:y))
+           (s-cy (entity-center-on-axis s #:y))
+           (land-on-top? (and (< m-cy s-cy) (> ovy 0))))
+      (if land-on-top?
+          (let* ((dir (if (< m-cy s-cy) -1 1))
                  (my (entity-ref m #:y 0)))
-            (entity-set (entity-set m #:y (+ my (* dir ovy))) #:vy 0)))))
+            (entity-set (entity-set m #:y (+ my (* dir ovy))) #:vy 0))
+          (if (<= ovx ovy)
+              (let* ((mc (entity-center-on-axis m #:x))
+                     (sc (entity-center-on-axis s #:x))
+                     (dir (if (< mc sc) -1 1))
+                     (mx (entity-ref m #:x 0)))
+                (entity-set (entity-set m #:x (+ mx (* dir ovx))) #:vx 0))
+              (let* ((mc (entity-center-on-axis m #:y))
+                     (sc (entity-center-on-axis s #:y))
+                     (dir (if (< mc sc) -1 1))
+                     (my (entity-ref m #:y 0)))
+                (entity-set (entity-set m #:y (+ my (* dir ovy))) #:vy 0))))))
 
   ;; Check if two axis-aligned bounding boxes overlap.
   ;; Returns #t if they overlap, #f if they don't (including edge-touching).