From cfddc2f180552afdb080968f847018c5a223b41a Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Tue, 7 Apr 2026 23:42:08 +0100 Subject: Use entities as platforms --- demo/sandbox.scm | 42 +++++++++++++++++++++++------------------- docs/physics.org | 2 +- physics.scm | 34 +++++++++++++++++++++++----------- tests/physics-test.scm | 12 ++++++++++++ 4 files changed, 59 insertions(+), 31 deletions(-) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index 2feb69e..ad2e056 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -15,30 +15,33 @@ (define *demo-t* 0.0) -;; Programmatic level: same geometry as the old static-tile floor + mid shelf, -;; but as a real tile layer so tile collisions and detect-on-solid work. +(define +static-skip+ + '(jump acceleration gravity velocity-x velocity-y + tile-collisions-x tile-collisions-y on-solid)) + +;; Mid-level shelf only: immovable solid AABBs (same layout as the old tilemap shelf). +(define (make-shelf-platform gw gh tw th) + (let* ((shelf-tile-id 20) + (shelf-c0 10) + (shelf-n 10) + (x0 (* shelf-c0 tw)) + (y (- gh (* 6 th)))) + (map (lambda (i) + (list #:type 'static-tile + #:x (+ x0 (* i tw)) #:y y #:width tw #:height th + #:tile-id shelf-tile-id #:solid? #t #:immovable? #t + #:gravity? #f #:vx 0 #:vy 0 #:on-ground? #f + #:skip-pipelines +static-skip+)) + (iota shelf-n)))) + +;; Floor only on the tilemap; shelf is entities (see make-shelf-platform). (define (make-sandbox-tilemap ts tw th gw gh) (let* ((ncols (inexact->exact (ceiling (/ gw tw)))) (nrows (inexact->exact (ceiling (/ gh th)))) (floor-tile 20) - (shelf-tile 20) (air (map (lambda (_) (map (lambda (_) 0) (iota ncols))) (iota nrows))) (floor-row (map (lambda (_) floor-tile) (iota ncols))) - (with-floor (append (take air (- nrows 1)) (list floor-row))) - ;; Shelf top at same Y as before: gh - 6*th pixels from top - (shelf-r (inexact->exact (floor (/ (- gh (* 6 th)) th)))) - (shelf-c0 10) - (shelf-n 10) - (row-before (list-ref with-floor shelf-r)) - (shelf-row - (map (lambda (c) - (if (and (>= c shelf-c0) (< c (+ shelf-c0 shelf-n))) - shelf-tile - (list-ref row-before c))) - (iota ncols))) - (map-data (append (take with-floor shelf-r) - (list shelf-row) - (drop with-floor (+ shelf-r 1)))) + (map-data (append (take air (- nrows 1)) (list floor-row))) (layer (make-layer name: "ground" width: ncols height: nrows map: map-data))) @@ -115,11 +118,12 @@ (gw (game-width game)) (gh (game-height game)) (tm (make-sandbox-tilemap ts tw th gw gh)) + (shelf (make-shelf-platform gw gh tw 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))) - (entities (append (spawn-boxes tw th) bots)) + (entities (append shelf (spawn-boxes tw th) bots)) (scene (make-scene entities: entities tilemap: tm diff --git a/docs/physics.org b/docs/physics.org index 0eb9265..9c44718 100644 --- a/docs/physics.org +++ b/docs/physics.org @@ -219,7 +219,7 @@ Used by =apply-jump= (via =#:on-ground?= on the **next** frame). Call **after** **Writes**: For colliding pairs: =#:x=, =#:y=, =#:vx=, =#:vy= (pushed apart, velocities set to ±1) -**Description**: Performs all-pairs AABB overlap detection. For each pair of entities where BOTH have =#:solid? #t=, if they overlap: if one has =#:immovable? #t=, only the other entity is displaced along the shallow overlap axis (and its velocity on that axis is zeroed); if both are immovable, the pair is skipped. Otherwise the two bodies are pushed apart along the smaller overlap axis and their velocities on that axis are set to ±1. +**Description**: Performs all-pairs AABB overlap detection. For each pair of entities where BOTH have =#:solid? #t=, if they overlap: if one has =#:immovable? #t=, only the other entity is displaced (its velocity on that axis is zeroed). For movable vs immovable, separation prefers **vertical** resolution when the movable’s center is still **above** the immovable’s center (typical landing on a platform), so narrow horizontal overlap does not shove the mover sideways through the edge. Otherwise the shallow overlap axis is used. If both are immovable, the pair is skipped. If neither is immovable, the two bodies are pushed apart along the smaller overlap axis and their velocities on that axis are set to ±1. Entities without =#:solid?= or with =#:solid? #f= are skipped. Returns a new entity list with collisions resolved. 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). diff --git a/tests/physics-test.scm b/tests/physics-test.scm index 04ec6bb..a5b40e9 100644 --- a/tests/physics-test.scm +++ b/tests/physics-test.scm @@ -376,6 +376,18 @@ (test-equal "a pushed up by 3" -3 (entity-ref ra #:y 0)) (test-equal "b pushed down by 3" 13 (entity-ref rb #:y 0)))) + (test-group "immovable: landing uses vertical separation when horizontal overlap is shallower" + ;; Without the landing rule, ovx < ovy would pick horizontal separation and shove the + ;; mover sideways off a narrow platform. Box center remains above shelf center → snap on top. + (let* ((shelf (list #:type 'static #:x 100 #:y 200 #:width 16 #:height 16 + #:solid? #t #:immovable? #t)) + (box (list #:type 'box #:x 92 #:y 196 #:width 16 #:height 16 + #:solid? #t #:immovable? #f #:vx 0 #:vy 0)) + (result (resolve-entity-collisions (list shelf box))) + (box2 (list-ref result 1))) + (test-equal "box rests on shelf top (y = shelf_y - height)" 184 (entity-ref box2 #:y 0)) + (test-equal "vy zeroed" 0 (entity-ref box2 #:vy 0)))) + (test-group "non-solid entity ignored" (let* ((a (make-solid 0 0 16 16)) (b (list #:type 'goal #:x 5 #:y 5 #:width 16 #:height 16)) -- cgit v1.2.3