diff options
Diffstat (limited to 'physics.scm')
| -rw-r--r-- | physics.scm | 93 |
1 files changed, 78 insertions, 15 deletions
diff --git a/physics.scm b/physics.scm index f3cc3bb..979eb4b 100644 --- a/physics.scm +++ b/physics.scm @@ -2,7 +2,7 @@ (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 + index-pairs list-set apply-jump detect-on-solid 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 @@ -10,7 +10,7 @@ (import scheme (chicken base) (chicken keyword) - (only srfi-1 fold iota) + (only srfi-1 any fold iota) defstruct downstroke-tilemap downstroke-entity @@ -23,6 +23,11 @@ ;; Jump force: vertical acceleration applied on jump (one frame) (define *jump-force* 15) + ;; Feet may be this far (pixels) from another solid's top and count as standing on it. + (define *entity-ground-contact-tolerance* 5) + ;; If |vy| is above this, another entity does not count as ground (mid-air / fast fall). + (define *entity-ground-vy-max* 12) + ;; Per-entity steps use define-pipeline from downstroke-entity (see docs/physics.org ;; for #:skip-pipelines symbol names). @@ -138,20 +143,52 @@ (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-pipeline (detect-ground ground-detection) (entity tilemap) + ;; True if ~self~ is supported by another solid's top surface (moving platforms, crates, …). + (define (entity-solid-support-below? self others) + (let* ((bx (entity-ref self #:x 0)) + (bw (entity-ref self #:width 0)) + (by (entity-ref self #:y 0)) + (bh (entity-ref self #:height 0)) + (bottom (+ by bh)) + (vy (abs (entity-ref self #:vy 0)))) + (and (<= vy *entity-ground-vy-max*) + (any (lambda (o) + (and (not (eq? self o)) + (entity-ref o #:solid? #f) + (let* ((ox (entity-ref o #:x 0)) + (oy (entity-ref o #:y 0)) + (ow (entity-ref o #:width 0))) + (and (< bx (+ ox ow)) + (< ox (+ bx bw)) + (<= (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-pipeline (detect-on-solid on-solid) + (entity tilemap #!optional (other-entities #f)) (if (not (entity-ref entity #:gravity? #f)) entity - (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)) - (on-ground? (or (not (zero? (tilemap-tile-at tilemap col-left row))) - (not (zero? (tilemap-tile-at tilemap col-right row)))))) + (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?)))) ;; Set vertical acceleration for jump (consumed next frame by apply-acceleration) @@ -218,6 +255,23 @@ (push-along-axis #:x a b ovx) (push-along-axis #:y a b ovy)))) + ;; Move ~m~ out of ~s~ along the shallow penetration axis; ~s~ is unchanged. + ;; Used when ~s~ has #:immovable? #t. + (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)) + (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). (define (aabb-overlap? x1 y1 w1 h1 x2 y2 w2 h2) @@ -228,6 +282,7 @@ ;; Resolve AABB collision between two solid entities. ;; Returns (a2 . b2) with positions/velocities adjusted, or #f if no collision. + ;; #:immovable? #t marks static geometry; only the other entity is displaced. (define (resolve-pair a b) (and (not (downstroke-entity#entity-skips-pipeline? a 'entity-collisions)) (not (downstroke-entity#entity-skips-pipeline? b 'entity-collisions)) @@ -237,7 +292,15 @@ (entity-ref a #:width 0) (entity-ref a #:height 0) (entity-ref b #:x 0) (entity-ref b #:y 0) (entity-ref b #:width 0) (entity-ref b #:height 0)) - (push-apart a b))) + (let ((ia (entity-ref a #:immovable? #f)) + (ib (entity-ref b #:immovable? #f))) + (cond + ((and ia ib) #f) + (ia (let ((b2 (separate-movable-from-static b a))) + (and b2 (cons a b2)))) + (ib (let ((a2 (separate-movable-from-static a b))) + (and a2 (cons a2 b)))) + (else (push-apart a b)))))) ;; Detect and resolve AABB overlaps between all pairs of solid entities. ;; Returns a new entity list with collisions resolved. |