diff options
Diffstat (limited to 'physics.scm')
| -rw-r--r-- | physics.scm | 52 |
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) |