1 files changed, 33 insertions, 41 deletions

diff --git a/physics.scm b/physics.scm
index 083046d..56966c2 100644
--- a/physics.scm
+++ b/physics.scm
@@ -163,33 +163,28 @@
                               (<= (abs (- bottom oy)) *entity-ground-contact-tolerance*)))))
                 others))))
 
-  ;; Standing on ground = solid tile 1px below feet and/or feet on top of another solid.
-  ;; Optional ~other-entities~: when non-#f, must be a list of scene entities (include movers).
-  ;; Call after tile and entity-entity collision so positions and ~#:vy~ are settled.
-  ;; Name ends in ~?~ for call-site readability; it still returns an updated entity (not a boolean).
+  (define (tile-ground-below? entity tilemap)
+    (let* ((x       (entity-ref entity #:x 0))
+           (w       (entity-ref entity #:width 0))
+           (tw      (tilemap-tilewidth tilemap))
+           (th      (tilemap-tileheight tilemap))
+           (probe-y (+ (entity-ref entity #:y 0)
+                       (entity-ref entity #:height 0)
+                       1))
+           (row       (pixel->tile probe-y th))
+           (col-left  (pixel->tile x tw))
+           (col-right (pixel->tile (- (+ x w) 1) tw)))
+      (or (not (zero? (tilemap-tile-at tilemap col-left row)))
+          (not (zero? (tilemap-tile-at tilemap col-right row))))))
+
   (define-pipeline (detect-on-solid on-solid)
       (entity tilemap #!optional (other-entities #f))
     (if (not (entity-ref entity #:gravity? #f))
         entity
-        (let* ((tile-ground?
-                 (and tilemap
-                      (let* ((x       (entity-ref entity #:x 0))
-                             (w       (entity-ref entity #:width 0))
-                             (tw      (tilemap-tilewidth tilemap))
-                             (th      (tilemap-tileheight tilemap))
-                             (probe-y (+ (entity-ref entity #:y 0)
-                                         (entity-ref entity #:height 0)
-                                         1))
-                             (row     (pixel->tile probe-y th))
-                             (col-left  (pixel->tile x tw))
-                             (col-right (pixel->tile (- (+ x w) 1) tw)))
-                        (or (not (zero? (tilemap-tile-at tilemap col-left row)))
-                            (not (zero? (tilemap-tile-at tilemap col-right row)))))))
-               (entity-ground?
-                 (and other-entities
-                      (entity-solid-support-below? entity other-entities)))
-               (on-ground? (or tile-ground? entity-ground?)))
-          (entity-set entity #:on-ground? on-ground?))))
+        (let* ((on-tile?   (and tilemap (tile-ground-below? entity tilemap)))
+               (on-entity? (and other-entities
+                                (entity-solid-support-below? entity other-entities))))
+          (entity-set entity #:on-ground? (or on-tile? on-entity?)))))
 
   ;; Set vertical acceleration for jump (consumed next frame by apply-acceleration)
   (define-pipeline (apply-jump jump) (entity jump-pressed?)
@@ -262,27 +257,24 @@
   ;; 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 (push-movable-along-axis m s axis overlap)
+    (let* ((mc  (entity-center-on-axis m axis))
+           (sc  (entity-center-on-axis s axis))
+           (dir (if (< mc sc) -1 1))
+           (pos (entity-ref m axis 0))
+           (vel (axis->velocity axis)))
+      (entity-set (entity-set m axis (+ pos (* dir overlap))) vel 0)))
+
   (define (separate-movable-from-static m s)
     (let* ((ovx (aabb-overlap-on-axis #:x m s))
            (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))
-          (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))))))
+           (land-on-top? (and (< (entity-center-on-axis m #:y)
+                                 (entity-center-on-axis s #:y))
+                              (> ovy 0))))
+      (cond
+        (land-on-top?  (push-movable-along-axis m s #:y ovy))
+        ((<= ovx ovy)  (push-movable-along-axis m s #:x ovx))
+        (else          (push-movable-along-axis m s #:y ovy)))))
 
   ;; Check if two axis-aligned bounding boxes overlap.
   ;; Returns #t if they overlap, #f if they don't (including edge-touching).