From 9e8b75f9949259ef01942cd3717b79b044efddf7 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Wed, 8 Apr 2026 01:57:20 +0100 Subject: Refactor update pipelines --- demo/sandbox.scm | 15 ++++++--------- demo/shmup.scm | 2 +- demo/tweens.scm | 2 +- docs/api.org | 42 +++++++++++++++++++++++++++++------------- docs/entities.org | 18 +++++++++--------- docs/physics.org | 38 ++++++++++++++++++++------------------ docs/tweens.org | 2 +- entity.scm | 27 ++++++++++++++++++++++----- physics.scm | 37 +++++++++++++++---------------------- prefabs.scm | 2 +- tests/entity-test.scm | 15 +++++++++++++++ tests/world-test.scm | 42 +++++++++++++++++++++++++----------------- tween.scm | 13 ++++++------- world.scm | 18 +++++++++++------- 14 files changed, 162 insertions(+), 111 deletions(-) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index 6a6030f..a34ebd9 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -162,14 +162,11 @@ (let ((tm (scene-tilemap (game-scene game)))) (game-scene-set! game (chain (game-scene game) - (scene-update-entities _ (cut step-tweens <> dt)) - (scene-update-entities _ (cut integrate-entity <> dt tm)) - (scene-sync-groups _) - (scene-resolve-collisions _) - (scene-update-entities _ - (lambda (e) - (if (entity-ref e #:gravity? #f) - (detect-on-solid e tm (scene-entities _)) - e))))))))) + (scene-map-entities _ (cut step-tweens <> dt)) + (scene-map-entities _ (cut integrate-entity <> dt tm)) + (scene-transform-entities _ sync-groups) + (scene-transform-entities _ resolve-entity-collisions) + (scene-map-entities _ + (lambda (e) (detect-on-solid e tm (scene-entities _)))))))))) (game-run! *game*) diff --git a/demo/shmup.scm b/demo/shmup.scm index ab09957..fdffd71 100644 --- a/demo/shmup.scm +++ b/demo/shmup.scm @@ -147,7 +147,7 @@ (all (cons player (append new-entities spawned others)))) (game-scene-set! game (chain (update-scene scene entities: all) - (scene-update-entities _ + (scene-map-entities _ (lambda (e) (if (eq? (entity-type e) 'player) e (move-projectile e)))) (scene-remove-dead _) (scene-filter-entities _ diff --git a/demo/tweens.scm b/demo/tweens.scm index d036b6b..b2a22cc 100644 --- a/demo/tweens.scm +++ b/demo/tweens.scm @@ -83,7 +83,7 @@ update: (lambda (game dt) (game-scene-set! game - (scene-update-entities (game-scene game) + (scene-map-entities (game-scene game) (cut step-tweens <> dt)))) render: (lambda (game) diff --git a/docs/api.org b/docs/api.org index 15c6e54..e60ef7d 100644 --- a/docs/api.org +++ b/docs/api.org @@ -255,10 +255,10 @@ Returns a new camera centered on an entity, clamping to stay within world bounds Appends an entity to the scene's entity list. Returns a new scene; the original is not modified. -** ~scene-update-entities~ +** ~scene-map-entities~ #+begin_src scheme -(scene-update-entities scene proc1 proc2 ...) +(scene-map-entities scene proc1 proc2 ...) #+end_src Applies each procedure in sequence to all entities in the scene. Each procedure takes a single entity and returns a modified entity. Returns a new scene with the updated entity list; the original is not modified. @@ -272,17 +272,31 @@ Example: (define (apply-gravity entity) (entity-set entity #:vy (+ 1 (entity-ref entity #:vy 0)))) -(scene-update-entities scene increment-x apply-gravity) +(scene-map-entities scene increment-x apply-gravity) ; Each entity is passed through increment-x, then through apply-gravity #+end_src -** ~scene-sync-groups~ +** ~scene-transform-entities~ #+begin_src scheme -(scene-sync-groups scene) +(scene-transform-entities scene proc) #+end_src -For every entity with ~#:group-id~ that is not an origin (~#:group-origin?~ is false), sets ~#:x~ and ~#:y~ to the corresponding origin’s position plus that entity’s ~#:group-local-x~ and ~#:group-local-y~. Origins are read from ~scene-entities~, so after a tween or other motion that returns a *new* origin plist, replace that origin in the scene’s list (match on ~#:group-id~ / ~#:group-origin?~) before calling ~scene-sync-groups~. Call after updating origin positions and before per-entity physics so platforms and collisions see a consistent pose. Returns a new scene; the original is not modified. +Applies ~proc~ to the scene’s full entity list. ~proc~ must have signature ~(entities → entities)~: it receives the current list and returns a new list. Returns a new scene with that entity list; the original is not modified. Use this to run whole-list steps such as ~sync-groups~ or ~resolve-entity-collisions~ after ~scene-map-entities~ (or in any order your game needs). + +** ~sync-groups~ + +#+begin_src scheme +(sync-groups entities) +#+end_src + +For every entity with ~#:group-id~ that is not an origin (~#:group-origin?~ is false), sets ~#:x~ and ~#:y~ to the corresponding origin’s position plus that entity’s ~#:group-local-x~ and ~#:group-local-y~. Origins are read from the **entity list** argument (typically ~(scene-entities scene)~ when you compose with ~scene-transform-entities~), so after a tween or other motion that returns a *new* origin plist, replace that origin in the list (match on ~#:group-id~ / ~#:group-origin?~) before calling ~sync-groups~. Call after updating origin positions and before per-entity physics so platforms and collisions see a consistent pose. Returns a new entity list. + +Typical usage: + +#+begin_src scheme +(scene-transform-entities scene sync-groups) +#+end_src ** ~scene-filter-entities~ @@ -411,10 +425,14 @@ Returns true if ~step-symbol~ appears in the entity’s ~#:skip-pipelines~ list ** ~define-pipeline~ #+begin_src scheme -(define-pipeline (procedure-name skip-symbol) (entity-formal extra-formal ...) body ...) +(define-pipeline (procedure-name skip-symbol) (entity-formal extra-formal ...) + guard: guard-expr + body ...) #+end_src -Syntax for authors of per-entity pipeline steps: expands to a ~define~ that returns the **first** formal (the entity) unchanged when ~skip-symbol~ is listed in ~#:skip-pipelines~; otherwise runs ~body ...~ inside ~(let () ...)~. Used throughout ~downstroke-physics~; other modules can use it for consistent skip behavior. The procedure name and skip symbol differ when needed (e.g. ~detect-on-solid~ vs ~on-solid~). +The ~guard:~ clause is optional. When present, ~guard-expr~ is evaluated first; if it is false, the entity is returned unchanged and ~body ...~ does not run. When absent, the body applies to all entities (subject only to the skip-symbol check below). + +Syntax for authors of per-entity pipeline steps: expands to a ~define~ that returns the **first** formal (the entity) unchanged when ~skip-symbol~ is listed in ~#:skip-pipelines~; otherwise, if a guard is present and fails, returns the entity unchanged; otherwise runs ~body ...~ inside ~(let () ...)~. Used throughout ~downstroke-physics~; other modules can use it for consistent skip behavior. The procedure name and skip symbol differ when needed (e.g. ~detect-on-solid~ vs ~on-solid~). ** Shared Entity Keys @@ -547,14 +565,12 @@ If the jump button is pressed and the entity is on ground, sets ~#:ay~ to ~(- #: Detects and resolves AABB collisions between all pairs of entities with ~#:solid?~ true. Pushes overlapping entities apart along the axis of minimum penetration and sets their velocities in the push direction. Returns a new entity list. -** ~scene-resolve-collisions~ +There is no scene-level wrapper; apply ~resolve-entity-collisions~ to the entity list via ~scene-transform-entities~: #+begin_src scheme -(scene-resolve-collisions scene) +(scene-transform-entities scene resolve-entity-collisions) #+end_src -Applies ~resolve-entity-collisions~ to the scene's entity list. Returns the modified scene. - ** Physics Constants - ~*gravity*~ = 1 (pixels per frame per frame) @@ -1333,7 +1349,7 @@ Looks up a prefab by type symbol in the registry and returns a fresh entity plis (instantiate-group-prefab registry type origin-x origin-y) #+end_src -Looks up a *group prefab* by type symbol and returns a list ~(origin member ...)~: one origin entity plus one entity per part. Optional group-level flags ~#:pose-only-origin?~ and ~#:static-parts?~ select origin/part profiles (see ~docs/entities.org~); defaults are ~#f~ (physics-driving origin, non-static parts). Each instance receives a fresh gensym ~#:group-id~ shared by the origin and all members. Returns ~#f~ if the type is not in ~group-prefabs~. After moving origins (tween and/or physics), ensure updated origins are stored in the scene’s entity list, then call ~scene-sync-groups~ so member ~#:x~ / ~#:y~ match ~origin + #:group-local-x/y~. +Looks up a *group prefab* by type symbol and returns a list ~(origin member ...)~: one origin entity plus one entity per part. Optional group-level flags ~#:pose-only-origin?~ and ~#:static-parts?~ select origin/part profiles (see ~docs/entities.org~); defaults are ~#f~ (physics-driving origin, non-static parts). Each instance receives a fresh gensym ~#:group-id~ shared by the origin and all members. Returns ~#f~ if the type is not in ~group-prefabs~. After moving origins (tween and/or physics), ensure updated origins are stored in the scene’s entity list, then ~(scene-transform-entities scene sync-groups)~ so member ~#:x~ / ~#:y~ match ~origin + #:group-local-x/y~. ** ~tilemap-objects->entities~ diff --git a/docs/entities.org b/docs/entities.org index 3766522..9f8e9ee 100644 --- a/docs/entities.org +++ b/docs/entities.org @@ -20,7 +20,7 @@ This minimal approach keeps the engine lean: your game defines whatever keys it * Pipeline skips (~#:skip-pipelines~) -The optional key ~#:skip-pipelines~ holds a list of **symbols** naming frame pipeline steps that should be skipped for that entity. The physics module defines the built-in step names (see ~docs/physics.org~). The predicate ~entity-skips-pipeline?~ and the syntax ~define-pipeline~ live in ~downstroke-entity~ so any subsystem (physics now; rendering or animation later if you extend the engine) can use the same mechanism without a separate “core pipeline” module. +The optional key ~#:skip-pipelines~ holds a list of **symbols** naming frame pipeline steps that should be skipped for that entity. The physics module defines the built-in step names (see ~docs/physics.org~). The predicate ~entity-skips-pipeline?~ and the syntax ~define-pipeline~ (with optional ~guard:~ clause per step) live in ~downstroke-entity~ so any subsystem (physics now; rendering or animation later if you extend the engine) can use the same mechanism without a separate “core pipeline” module. * Creating Entities @@ -126,19 +126,19 @@ The engine recognizes these standard keys. Use them to integrate with the physic | ~#:anim-tick~ | integer | Tick counter for frame timing (0 to ~#:duration - 1~). Incremented by ~animate-entity~; resets when frame advances. | | ~#:group-id~ | symbol | Shared id for one rigid assembly (from ~instantiate-group-prefab~). All parts and the origin share the same symbol. | | ~#:group-origin?~ | boolean | When ~#t~, this entity is the assembly’s pose origin; world ~#:x~ / ~#:y~ drive the group. Members should not set this. | -| ~#:group-local-x~, ~#:group-local-y~ | number | Offset from the origin’s top-left corner; members’ world position is origin + local (updated by ~scene-sync-groups~). | +| ~#:group-local-x~, ~#:group-local-y~ | number | Offset from the origin’s top-left corner; members’ world position is origin + local (updated by ~sync-groups~ on the entity list, e.g. ~(scene-transform-entities scene sync-groups)~). | | ~#:skip-render~ | boolean | When ~#t~, ~render-scene!~ skips drawing this entity (used for invisible origins). | * Entity groups (prefab assemblies) A **group prefab** describes one *origin* entity plus several *parts* with local offsets. Data lives in the optional ~group-prefabs~ section of the prefab file (alongside ~mixins~ and ~prefabs~). Each group entry has the shape ~(name #:type-members SYMBOL #:parts (part ...) ...)~ with two optional flags: -- ~#:pose-only-origin?~ — when ~#t~ (typical for tweened platforms), the origin is invisible, does not run physics pipelines, and is driven by tweens or scripts. When ~#f~ (default), the origin uses a small *physics-driving* profile (~#:gravity? #t~, no ~#:skip-pipelines~): integrate the origin like a mover, then call ~scene-sync-groups~ so parts stay glued as a rigid body. For that case, set ~#:origin-width~ and ~#:origin-height~ to the full assembly size (same box as the combined parts); otherwise the origin stays 0×0 and tile collision only sees a point at the reference corner, which can leave the raft overlapping solid floor tiles. +- ~#:pose-only-origin?~ — when ~#t~ (typical for tweened platforms), the origin is invisible, does not run physics pipelines, and is driven by tweens or scripts. When ~#f~ (default), the origin uses a small *physics-driving* profile (~#:gravity? #t~, no ~#:skip-pipelines~): integrate the origin like a mover, then ~(scene-transform-entities scene sync-groups)~ so parts stay glued as a rigid body. For that case, set ~#:origin-width~ and ~#:origin-height~ to the full assembly size (same box as the combined parts); otherwise the origin stays 0×0 and tile collision only sees a point at the reference corner, which can leave the raft overlapping solid floor tiles. - ~#:static-parts?~ — when ~#t~, each part gets static rigid-body defaults (no gravity on parts; pose comes from the origin). When ~#f~ (default), parts only have what you put in each part plist. Each ~part~ is a plist using ~#:local-x~ / ~#:local-y~ (or ~#:group-local-x~ / ~#:group-local-y~) and the usual ~#:width~, ~#:height~, ~#:tile-id~, physics keys, etc. -Use ~(instantiate-group-prefab registry 'name origin-x origin-y)~ from ~downstroke-prefabs~ to obtain ~(origin member ...)~. Append all of them to the scene. After moving origins (tweens and/or physics), ensure updated origins are in ~scene-entities~, then call ~(scene-sync-groups scene)~ so every part’s ~#:x~ / ~#:y~ matches the origin plus local offsets (see ~docs/api.org~ for ordering). +Use ~(instantiate-group-prefab registry 'name origin-x origin-y)~ from ~downstroke-prefabs~ to obtain ~(origin member ...)~. Append all of them to the scene. After moving origins (tweens and/or physics), ensure updated origins are in ~scene-entities~, then ~(scene-transform-entities scene sync-groups)~ so every part’s ~#:x~ / ~#:y~ matches the origin plus local offsets (see ~docs/api.org~ for ordering). * Entities in Scenes @@ -168,13 +168,13 @@ Returns a new scene with the entity appended to the entity list. (scene-add-entity scene new-enemy) #+end_src -** ~scene-update-entities scene proc1 proc2 ...~ +** ~scene-map-entities scene proc1 proc2 ...~ Maps each procedure over the scene's entities, applying them in sequence. Each proc must be a function of one entity, returning a new entity. #+begin_src scheme ;; Apply physics pipeline to all entities: -(scene-update-entities scene +(scene-map-entities scene apply-gravity apply-velocity-x apply-velocity-y) @@ -184,9 +184,9 @@ The result is equivalent to: #+begin_src scheme (chain scene - (scene-update-entities _ apply-gravity) - (scene-update-entities _ apply-velocity-x) - (scene-update-entities _ apply-velocity-y)) + (scene-map-entities _ apply-gravity) + (scene-map-entities _ apply-velocity-x) + (scene-map-entities _ apply-velocity-y)) #+end_src ** ~scene-filter-entities scene pred~ diff --git a/docs/physics.org b/docs/physics.org index 8401a38..e5b3749 100644 --- a/docs/physics.org +++ b/docs/physics.org @@ -76,7 +76,7 @@ Helper: ~(entity-skips-pipeline? entity step-symbol)~ (from ~downstroke-entity~) ** ~define-pipeline~ (~downstroke-entity~) -Physics steps are defined with ~(define-pipeline (procedure-name skip-symbol) (formals ...) body ...)~ from the entity module. The first formal must be the entity. The procedure name and skip symbol are separate (e.g. ~detect-on-solid~ vs ~on-solid~). ~apply-velocity~ is still written by hand because it consults ~velocity-x~ and ~velocity-y~ independently. +Physics steps are defined with ~(define-pipeline (procedure-name skip-symbol) (formals ...) body ...)~ from the entity module, optionally with ~guard: expr~ before ~body ...~: when the guard is false, the entity is returned unchanged before the body runs. The first formal must be the entity. The procedure name and skip symbol are separate (e.g. ~detect-on-solid~ vs ~on-solid~). ~apply-velocity~ is still written by hand because it consults ~velocity-x~ and ~velocity-y~ independently. The renderer and other subsystems do **not** use ~#:skip-pipelines~ today; they run after your ~update:~ hook. If you add render-phase or animation-phase skips later, reuse the same plist key and helpers from ~downstroke-entity~ and document the new symbols alongside physics. @@ -225,13 +225,15 @@ Entities without =#:solid?= or with =#:solid? #f= are skipped. Returns a new ent This is relatively expensive: O(n²) for n entities. Use only when entity count is low (< 100) or for game objects where push-apart is desired. -** scene-resolve-collisions +** Using =resolve-entity-collisions= on a scene + +Apply the pure list function via =scene-transform-entities= (from =downstroke-world=): #+begin_src scheme -(scene-resolve-collisions scene) +(scene-transform-entities scene resolve-entity-collisions) #+end_src -**Description**: Convenience wrapper. Extracts all entities from the scene, passes them to =resolve-entity-collisions=, and updates the scene in place. Modifies the scene. +Returns a new scene with the updated entity list; the original scene is not modified. ** aabb-overlap? @@ -397,27 +399,27 @@ Multiple entities falling and colliding with each other: update: (lambda (game dt) (let* ((scene (game-scene game)) (tm (scene-tilemap scene))) - ;; Apply physics to all entities in one pass - (scene-update-entities scene - apply-gravity - apply-velocity-x - (lambda (e) (resolve-tile-collisions-x e tm)) - apply-velocity-y - (lambda (e) (resolve-tile-collisions-y e tm)) - (lambda (e) (detect-on-solid e tm))) - ;; Then resolve entity-entity collisions - (scene-resolve-collisions scene))) + ;; Apply physics to all entities in one pass, then resolve entity-entity collisions + (scene-transform-entities + (scene-map-entities scene + apply-gravity + apply-velocity-x + (lambda (e) (resolve-tile-collisions-x e tm)) + apply-velocity-y + (lambda (e) (resolve-tile-collisions-y e tm)) + (lambda (e) (detect-on-solid e tm))) + resolve-entity-collisions))) #+end_src ** step-by-step -1. **scene-update-entities**: applies each step to all entities in order +1. **scene-map-entities**: applies each step to all entities in order - =apply-gravity= (all entities fall) - =apply-velocity-x=, =resolve-tile-collisions-x= (move and collide on x-axis) - =apply-velocity-y=, =resolve-tile-collisions-y= (move and collide on y-axis) - =detect-on-solid= (set #:on-ground? for next frame) -2. **scene-resolve-collisions**: after all entities are moved and collided with tiles, resolve entity-entity overlaps (boxes pushing apart) +2. **scene-transform-entities** with **resolve-entity-collisions**: after all entities are moved and collided with tiles, resolve entity-entity overlaps (boxes pushing apart) This pattern is efficient for sandbox simulations: apply the same pipeline to all entities, then resolve inter-entity collisions once. @@ -429,7 +431,7 @@ Notice that =resolve-tile-collisions-x= needs the tilemap argument, so it's wrap (lambda (e) (resolve-tile-collisions-x e tm)) #+end_src -Same for other functions that take tilemap. The =scene-update-entities= macro applies each function to all entities, so you wrap single-argument functions in a lambda to capture the tilemap. +Same for other functions that take tilemap. The =scene-map-entities= macro applies each function to all entities, so you wrap single-argument functions in a lambda to capture the tilemap. * Common Patterns @@ -514,7 +516,7 @@ For large games, consider spatial partitioning (grid, quadtree) to cull entity p ** Entities Get Stuck Overlapping -- Use =scene-resolve-collisions= after all physics steps +- Use =(scene-transform-entities scene resolve-entity-collisions)= after all physics steps - Verify both entities have =#:solid? #t= - Reduce =*gravity*= or max velocity if entities are moving too fast (can cause multi-frame overlap) diff --git a/docs/tweens.org b/docs/tweens.org index 213b3ee..c278814 100644 --- a/docs/tweens.org +++ b/docs/tweens.org @@ -71,7 +71,7 @@ Auto-advances ~#:tween~ on an entity. If the entity has no ~#:tween~ key, return This is the recommended way to run tweens in most games. Attach a tween to an entity and include ~step-tweens~ in your per-entity pipeline: #+begin_src scheme -(scene-update-entities scene +(scene-map-entities scene (lambda (e) (step-tweens e dt))) #+end_src diff --git a/entity.scm b/entity.scm index e4b3937..891fbde 100644 --- a/entity.scm +++ b/entity.scm @@ -38,6 +38,11 @@ ;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the ;; binding from THIS module — works across compiled unit boundaries. + ;; + ;; Syntax: + ;; (define-pipeline (name skip-sym) (entity-formal ...) + ;; guard: guard-expr ;; optional — entity returned unchanged when #f + ;; body ...) (define-syntax define-pipeline (er-macro-transformer (lambda (form rename _compare) @@ -46,16 +51,28 @@ (skip (cadr name-skip)) (formals (caddr form)) (f1 (car formals)) - (body (cdddr form)) + (rest (cdddr form)) + (has-guard? (and (pair? rest) (pair? (cdr rest)) + (eq? (car rest) guard:))) + (guard-expr (and has-guard? (cadr rest))) + (body (if has-guard? (cddr rest) rest)) (%define (rename 'define)) (%if (rename 'if)) (%let (rename 'let)) + (%not (rename 'not)) (%quote (rename 'quote)) (%skip? (rename 'entity-skips-pipeline?))) - `(,%define (,name ,@formals) - (,%if (,%skip? ,f1 (,%quote ,skip)) - ,f1 - (,%let () ,@body))))))) + (if has-guard? + `(,%define (,name ,@formals) + (,%if (,%skip? ,f1 (,%quote ,skip)) + ,f1 + (,%if (,%not ,guard-expr) + ,f1 + (,%let () ,@body)))) + `(,%define (,name ,@formals) + (,%if (,%skip? ,f1 (,%quote ,skip)) + ,f1 + (,%let () ,@body)))))))) (define (make-player-entity x y width height) (list #:type 'player diff --git a/physics.scm b/physics.scm index 24ded09..773d922 100644 --- a/physics.scm +++ b/physics.scm @@ -1,5 +1,5 @@ (module downstroke-physics - (scene-resolve-collisions resolve-entity-collisions resolve-pair + (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-on-solid @@ -33,17 +33,15 @@ ;; Consume #:ay into #:vy and clear it (one-shot acceleration) (define-pipeline (apply-acceleration acceleration) (entity) - (if (not (entity-ref entity #:gravity? #f)) - entity - (let ((ay (entity-ref entity #:ay 0)) - (vy (entity-ref entity #:vy 0))) - (entity-set (entity-set entity #:vy (+ vy ay)) #:ay 0)))) + guard: (entity-ref entity #:gravity? #f) + (let ((ay (entity-ref entity #:ay 0)) + (vy (entity-ref entity #:vy 0))) + (entity-set (entity-set entity #:vy (+ vy ay)) #:ay 0))) ;; Apply gravity to an entity if it has gravity enabled (define-pipeline (apply-gravity gravity) (entity) - (if (entity-ref entity #:gravity? #f) - (entity-set entity #:vy (+ (entity-ref entity #:vy) *gravity*)) - entity)) + guard: (entity-ref entity #:gravity? #f) + (entity-set entity #:vy (+ (entity-ref entity #:vy) *gravity*))) ;; Update entity's x by its vx velocity (define-pipeline (apply-velocity-x velocity-x) (entity) @@ -179,18 +177,16 @@ (define-pipeline (detect-on-solid on-solid) (entity tilemap #!optional (other-entities #f)) - (if (not (entity-ref entity #:gravity? #f)) - entity - (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?))))) + guard: (entity-ref entity #:gravity? #f) + (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?) - (if (and jump-pressed? (entity-ref entity #:on-ground? #f)) - (entity-set entity #:ay (- (entity-ref entity #:jump-force *jump-force*))) - entity)) + guard: (and jump-pressed? (entity-ref entity #:on-ground? #f)) + (entity-set entity #:ay (- (entity-ref entity #:jump-force *jump-force*)))) ;; Replace element at idx in lst with val (define (list-set lst idx val) @@ -318,7 +314,4 @@ entities (index-pairs (length entities)))) - ;; Returns a new scene with entity-entity collisions resolved. - (define (scene-resolve-collisions scene) - (update-scene scene - entities: (resolve-entity-collisions (scene-entities scene))))) +) diff --git a/prefabs.scm b/prefabs.scm index ef9b556..585d4b5 100644 --- a/prefabs.scm +++ b/prefabs.scm @@ -61,7 +61,7 @@ #:skip-pipelines '(jump acceleration gravity velocity-x velocity-y tile-collisions-x tile-collisions-y on-solid entity-collisions))) - ;; Physics-driving origin: invisible point mass; members follow via scene-sync-groups. + ;; Physics-driving origin: invisible point mass; members follow via sync-groups. (define +physics-group-origin-defaults+ (list #:solid? #f #:gravity? #t #:skip-render #t #:vx 0 #:vy 0 #:on-ground? #f)) diff --git a/tests/entity-test.scm b/tests/entity-test.scm index 988d1c9..795aa1c 100644 --- a/tests/entity-test.scm +++ b/tests/entity-test.scm @@ -132,4 +132,19 @@ (let ((e '(#:type t #:x 0 #:skip-pipelines (fixture-skip)))) (test-equal "skipped" 0 (entity-ref (fixture-pipeline e) #:x)))) +(define-pipeline (guarded-pipeline guarded-skip) (ent) + guard: (entity-ref ent #:active? #f) + (entity-set ent #:x 99)) + +(test-group "define-pipeline with guard:" + (let ((e '(#:type t #:x 0 #:active? #t))) + (test-equal "runs body when guard passes" 99 + (entity-ref (guarded-pipeline e) #:x))) + (let ((e '(#:type t #:x 0))) + (test-equal "returns entity unchanged when guard fails" 0 + (entity-ref (guarded-pipeline e) #:x))) + (let ((e '(#:type t #:x 0 #:active? #t #:skip-pipelines (guarded-skip)))) + (test-equal "skip-pipelines takes precedence over guard" 0 + (entity-ref (guarded-pipeline e) #:x)))) + (test-end "entity") diff --git a/tests/world-test.scm b/tests/world-test.scm index 1b368c0..48f492a 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -154,8 +154,8 @@ '(a b c) (map entity-type (scene-entities scene))))) -;; Test: scene-update-entities applies function to all entities -(test-group "scene-update-entities" +;; Test: scene-map-entities applies function to all entities +(test-group "scene-map-entities" (let* ((e1 '(#:type player #:x 100 #:y 100)) (e2 '(#:type enemy #:x 200 #:y 200)) (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) @@ -164,7 +164,7 @@ (y (entity-ref entity #:y)) (type (entity-ref entity #:type))) (list #:type type #:x (+ x 10) #:y y)))) - (scene2 (scene-update-entities scene move-right))) + (scene2 (scene-map-entities scene move-right))) (test-equal "original scene unchanged" 100 @@ -179,12 +179,12 @@ 100 (entity-ref (car (scene-entities scene2)) #:y)))) -;; Test: scene-update-entities with identity function -(test-group "scene-update-entities-identity" +;; Test: scene-map-entities with identity function +(test-group "scene-map-entities-identity" (let* ((e1 '(#:type player #:x 100)) (e2 '(#:type enemy #:x 200)) (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) - (scene2 (scene-update-entities scene (lambda (e) e)))) + (scene2 (scene-map-entities scene (lambda (e) e)))) (test-equal "entity count unchanged" 2 (length (scene-entities scene2))) (test-equal "first entity unchanged" @@ -199,7 +199,7 @@ (test-equal "entity added" 1 (length (scene-entities scene))) - (let ((scene (scene-update-entities scene + (let ((scene (scene-map-entities scene (lambda (e) (let ((x (entity-ref e #:x)) (y (entity-ref e #:y)) @@ -274,7 +274,7 @@ (test-equal "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) (test-equal "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) - (test-group "scene-sync-groups" + (test-group "sync-groups" (let* ((gid 'g1) (origin (list #:type 'group-origin #:group-origin? #t #:group-id gid #:x 100 #:y 200 #:width 0 #:height 0)) @@ -282,14 +282,22 @@ #:x 0 #:y 0 #:width 8 #:height 8)) (m2 (list #:type 'part #:group-id gid #:group-local-x 0 #:group-local-y 7 #:x 0 #:y 0 #:width 8 #:height 8)) - (s (make-scene entities: (list origin m1 m2) tilemap: #f - camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f)) - (s2 (scene-sync-groups s))) - (test-equal "original scene members unchanged" 0 (entity-ref (list-ref (scene-entities s) 1) #:x)) - (let ((es (scene-entities s2))) - (test-equal "member 1 follows origin" 105 (entity-ref (list-ref es 1) #:x)) - (test-equal "member 1 y" 200 (entity-ref (list-ref es 1) #:y)) - (test-equal "member 2 x" 100 (entity-ref (list-ref es 2) #:x)) - (test-equal "member 2 y" 207 (entity-ref (list-ref es 2) #:y))))) + (entities (list origin m1 m2)) + (result (sync-groups entities))) + (test-equal "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x)) + (test-equal "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x)) + (test-equal "member 1 y" 200 (entity-ref (list-ref result 1) #:y)) + (test-equal "member 2 x" 100 (entity-ref (list-ref result 2) #:x)) + (test-equal "member 2 y" 207 (entity-ref (list-ref result 2) #:y)))) + + (test-group "scene-transform-entities" + (let* ((e1 '(#:type a #:x 1)) + (e2 '(#:type b #:x 2)) + (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) + (scene2 (scene-transform-entities scene reverse))) + (test-equal "transforms entity list" 'b + (entity-type (car (scene-entities scene2)))) + (test-equal "original scene unchanged" 'a + (entity-type (car (scene-entities scene)))))) (test-end "world-module") diff --git a/tween.scm b/tween.scm index 3475a83..eb8fbd8 100644 --- a/tween.scm +++ b/tween.scm @@ -197,12 +197,11 @@ ;; when the tween finishes. (define-pipeline (step-tweens tweens) (entity dt) - (let ((tw (entity-ref entity #:tween #f))) - (if (not tw) - entity - (receive (tw2 ent2) (tween-step tw entity dt) - (if (tween-finished? tw2) - (entity-set ent2 #:tween #f) - (entity-set ent2 #:tween tw2)))))) + guard: (entity-ref entity #:tween #f) + (let ((tw (entity-ref entity #:tween))) + (receive (tw2 ent2) (tween-step tw entity dt) + (if (tween-finished? tw2) + (entity-set ent2 #:tween #f) + (entity-set ent2 #:tween tw2))))) ) ;; end module diff --git a/world.scm b/world.scm index 14840c8..de9027c 100644 --- a/world.scm +++ b/world.scm @@ -45,7 +45,7 @@ (update-scene scene entities: (append (scene-entities scene) (list entity)))) - (define (scene-update-entities scene . procs) + (define (scene-map-entities scene . procs) "Apply each proc in sequence to the scene's entities; returns a new scene." (update-scene scene entities: (fold (lambda (proc es) (map proc es)) @@ -57,6 +57,11 @@ (update-scene scene entities: (filter pred (scene-entities scene)))) + (define (scene-transform-entities scene proc) + "Apply proc to the full entity list (entities → entities); returns a new scene." + (update-scene scene + entities: (proc (scene-entities scene)))) + ;; Center camera on entity. Clamps to >= 0 on both axes. ;; Returns a new camera struct. (define (camera-follow camera entity viewport-w viewport-h) @@ -105,10 +110,9 @@ (entity-ref e #:group-local-y 0)))) e))) - ;; Snap member #:x/#:y to origin + #:group-local-x/y. Returns a new scene. - (define (scene-sync-groups scene) - (let ((origins (group-origin-alist (scene-entities scene)))) - (update-scene scene - entities: (map (cut sync-member-to-origin <> origins) - (scene-entities scene))))) + ;; Snap member #:x/#:y to origin + #:group-local-x/y. + ;; Pure entities → entities function; use with scene-transform-entities. + (define (sync-groups entities) + (let ((origins (group-origin-alist entities))) + (map (cut sync-member-to-origin <> origins) entities))) ) -- cgit v1.2.3