diff options
| author | Gene Pasquet <dev@etenil.net> | 2026-04-08 01:32:55 +0100 |
|---|---|---|
| committer | Gene Pasquet <dev@etenil.net> | 2026-04-08 01:32:55 +0100 |
| commit | 84840ede6646ed793b61cdd889d3f57ab05e9311 (patch) | |
| tree | 2b62dd73a7321bc71a368b297ab40b3535bd79fc | |
| parent | 7903180321bf72b344077a8423930ac161872a2c (diff) | |
Refactor to be functional
| -rw-r--r-- | demo/platformer.scm | 10 | ||||
| -rw-r--r-- | demo/sandbox.scm | 23 | ||||
| -rw-r--r-- | demo/scaling.scm | 3 | ||||
| -rw-r--r-- | demo/shmup.scm | 54 | ||||
| -rw-r--r-- | demo/topdown.scm | 10 | ||||
| -rw-r--r-- | demo/tweens.scm | 5 | ||||
| -rw-r--r-- | docs/api.org | 39 | ||||
| -rw-r--r-- | docs/entities.org | 31 | ||||
| -rw-r--r-- | docs/guide.org | 10 | ||||
| -rw-r--r-- | docs/physics.org | 12 | ||||
| -rw-r--r-- | engine.scm | 25 | ||||
| -rw-r--r-- | physics.scm | 7 | ||||
| -rw-r--r-- | prefabs.scm | 2 | ||||
| -rw-r--r-- | tests/engine-test.scm | 9 | ||||
| -rw-r--r-- | tests/scene-loader-test.scm | 4 | ||||
| -rw-r--r-- | tests/world-test.scm | 124 | ||||
| -rw-r--r-- | world.scm | 43 |
17 files changed, 209 insertions, 202 deletions
diff --git a/demo/platformer.scm b/demo/platformer.scm index ff5caf7..3bad9bd 100644 --- a/demo/platformer.scm +++ b/demo/platformer.scm @@ -55,15 +55,17 @@ (load-sounds! '((jump . "demo/assets/jump.wav")))) create: (lambda (game) - (let ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) - (scene-add-entity scene (make-player)) - (scene-camera-target-set! scene 'player))) + (game-scene-set! game + (chain (game-load-scene! game "demo/assets/level-0.tmx") + (scene-add-entity _ (make-player)) + (update-scene _ camera-target: 'player)))) update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) (tm (scene-tilemap scene)) (player (update-player (car (scene-entities scene)) input tm))) - (scene-entities-set! scene (list player)))))) + (game-scene-set! game + (update-scene scene entities: (list player))))))) (game-run! *game*) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index 319ef80..6a6030f 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -159,16 +159,17 @@ update: (lambda (game dt) (set! *demo-t* (+ *demo-t* dt)) - (let* ((scene (game-scene game)) - (tm (scene-tilemap scene))) - (scene-update-entities scene (cut step-tweens <> dt)) - (scene-update-entities scene (cut integrate-entity <> dt tm)) - (scene-sync-groups! scene) - (scene-resolve-collisions scene) - (scene-update-entities scene - (lambda (e) - (if (entity-ref e #:gravity? #f) - (detect-on-solid e tm (scene-entities scene)) - e))))))) + (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))))))))) (game-run! *game*) diff --git a/demo/scaling.scm b/demo/scaling.scm index 983e583..f8bfdfb 100644 --- a/demo/scaling.scm +++ b/demo/scaling.scm @@ -53,7 +53,8 @@ (ny (max 0 (min (- +height+ +box-size+) (+ (entity-ref box #:y 0) vy)))) (box (entity-set (entity-set box #:x nx) #:y ny))) - (scene-entities-set! scene (list box)))) + (game-scene-set! game + (update-scene scene entities: (list box))))) render: (lambda (game) (let* ((renderer (game-renderer game)) diff --git a/demo/shmup.scm b/demo/shmup.scm index 97779a8..ab09957 100644 --- a/demo/shmup.scm +++ b/demo/shmup.scm @@ -61,6 +61,10 @@ (let ((y (entity-ref e #:y 0))) (and (> y -20) (< y (+ +screen-height+ 20))))) +(define (scene-remove-dead scene) + (let ((dead (find-dead (scene-entities scene)))) + (scene-filter-entities scene (lambda (e) (not (memq e dead)))))) + ;; ── Update helpers ─────────────────────────────────────────────────────────── (define (player-vx input) @@ -72,26 +76,27 @@ (entity-set player #:x (max 0 (min (- +screen-width+ 16) (entity-ref player #:x 0))))) -(define (update-player player input scene) +(define (update-player player input) (let ((updated (chain player (entity-set _ #:vx (player-vx input)) (apply-velocity-x _) (clamp-player-x _)))) (when (input-pressed? input 'a) - (play-sound 'shoot) - (scene-add-entity scene - (make-bullet (+ (entity-ref updated #:x 0) 6) 340))) - updated)) + (play-sound 'shoot)) + (if (input-pressed? input 'a) + (values updated + (list (make-bullet (+ (entity-ref updated #:x 0) 6) 340))) + (values updated '())))) (define (move-projectile e) (chain e (entity-set _ #:x (+ (entity-ref e #:x 0) (entity-ref e #:vx 0))) (entity-set _ #:y (+ (entity-ref e #:y 0) (entity-ref e #:vy 0))))) -(define (maybe-spawn-enemy! scene) - (when (zero? (modulo *frame-count* +spawn-interval+)) - (scene-add-entity scene - (make-enemy (+ 20 (* (pseudo-random-integer 28) 20)))))) +(define (maybe-spawn-enemies) + (if (zero? (modulo *frame-count* +spawn-interval+)) + (list (make-enemy (+ 20 (* (pseudo-random-integer 28) 20)))) + '())) ;; ── Render ─────────────────────────────────────────────────────────────────── @@ -132,22 +137,21 @@ update: (lambda (game dt) (set! *frame-count* (+ *frame-count* 1)) - (let* ((input (game-input game)) - (scene (game-scene game)) - (player (car (scene-entities scene))) - (player (update-player player input scene))) - (maybe-spawn-enemy! scene) - ;; Replace player, then move all projectiles - (scene-entities-set! scene - (cons player (filter (lambda (e) (not (eq? (entity-type e) 'player))) - (scene-entities scene)))) - (scene-update-entities scene - (lambda (e) (if (eq? (entity-type e) 'player) e (move-projectile e)))) - ;; Remove bullet/enemy collisions, then out-of-bounds - (let ((dead (find-dead (scene-entities scene)))) - (scene-filter-entities scene (lambda (e) (not (memq e dead))))) - (scene-filter-entities scene - (lambda (e) (or (eq? (entity-type e) 'player) (in-bounds? e)))))) + (let* ((input (game-input game)) + (scene (game-scene game)) + (player (car (scene-entities scene)))) + (receive (player new-entities) (update-player player input) + (let* ((others (filter (lambda (e) (not (eq? (entity-type e) 'player))) + (scene-entities scene))) + (spawned (maybe-spawn-enemies)) + (all (cons player (append new-entities spawned others)))) + (game-scene-set! game + (chain (update-scene scene entities: all) + (scene-update-entities _ + (lambda (e) (if (eq? (entity-type e) 'player) e (move-projectile e)))) + (scene-remove-dead _) + (scene-filter-entities _ + (lambda (e) (or (eq? (entity-type e) 'player) (in-bounds? e)))))))))) render: (lambda (game) (for-each (cut draw-shmup-entity (game-renderer game) <>) diff --git a/demo/topdown.scm b/demo/topdown.scm index 7e5bd62..1bf6536 100644 --- a/demo/topdown.scm +++ b/demo/topdown.scm @@ -43,15 +43,17 @@ title: "Demo: Top-down Explorer" width: 600 height: 400 create: (lambda (game) - (let ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) - (scene-add-entity scene (make-player)) - (scene-camera-target-set! scene 'player))) + (game-scene-set! game + (chain (game-load-scene! game "demo/assets/level-0.tmx") + (scene-add-entity _ (make-player)) + (update-scene _ camera-target: 'player)))) update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) (player (update-player (car (scene-entities scene)) input (scene-tilemap scene)))) - (scene-entities-set! scene (list player)))))) + (game-scene-set! game + (update-scene scene entities: (list player))))))) (game-run! *game*) diff --git a/demo/tweens.scm b/demo/tweens.scm index 7ed2372..d036b6b 100644 --- a/demo/tweens.scm +++ b/demo/tweens.scm @@ -82,8 +82,9 @@ background: '(26 28 34)))) update: (lambda (game dt) - (scene-update-entities (game-scene game) - (cut step-tweens <> dt))) + (game-scene-set! game + (scene-update-entities (game-scene game) + (cut step-tweens <> dt)))) render: (lambda (game) (draw-ease-labels! (game-renderer game) diff --git a/docs/api.org b/docs/api.org index d4dc074..15c6e54 100644 --- a/docs/api.org +++ b/docs/api.org @@ -208,7 +208,7 @@ Creates a scene record representing the current level state. | ~tileset~ | tileset/false | #f | Tileset metadata (from ~load-tileset~) when there is no tilemap; required with ~tileset-texture~ to draw ~#:tile-id~ sprites without a TMX map | | ~camera~ | camera/false | #f | Viewport position | | ~tileset-texture~ | SDL2 texture/false | #f | Rendered tileset image | -| ~camera-target~ | symbol/false | #f | Tag symbol of the entity to follow (see ~scene-camera-target-set!~) | +| ~camera-target~ | symbol/false | #f | Tag symbol of the entity to follow (set via ~update-scene~) | | ~background~ | list/false | #f | Framebuffer clear color: ~(r g b)~ or ~(r g b a)~ (0–255). ~#f~ means opaque black. Set each frame in ~game-run!~ before ~SDL_RenderClear~. | ** ~make-camera~ @@ -239,13 +239,13 @@ Accessors for camera position. Mutate camera position (in-place). -** ~camera-follow!~ +** ~camera-follow~ #+begin_src scheme -(camera-follow! camera entity viewport-w viewport-h) +(camera-follow camera entity viewport-w viewport-h) #+end_src -Centers the camera on an entity, clamping to stay within world bounds (never negative). ~viewport-w~ and ~viewport-h~ are the game window dimensions. +Returns a new camera centered on an entity, clamping to stay within world bounds (never negative). ~viewport-w~ and ~viewport-h~ are the game window dimensions. The original camera is not modified. ** ~scene-add-entity~ @@ -253,7 +253,7 @@ Centers the camera on an entity, clamping to stay within world bounds (never neg (scene-add-entity scene entity) #+end_src -Appends an entity to the scene's entity list. Returns the modified scene. +Appends an entity to the scene's entity list. Returns a new scene; the original is not modified. ** ~scene-update-entities~ @@ -261,7 +261,7 @@ Appends an entity to the scene's entity list. Returns the modified scene. (scene-update-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. The scene's entity list is updated once with the final result. Returns the modified scene. +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. Example: @@ -276,13 +276,13 @@ Example: ; Each entity is passed through increment-x, then through apply-gravity #+end_src -** ~scene-sync-groups!~ +** ~scene-sync-groups~ #+begin_src scheme -(scene-sync-groups! scene) +(scene-sync-groups scene) #+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 the scene. +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. ** ~scene-filter-entities~ @@ -290,7 +290,7 @@ For every entity with ~#:group-id~ that is not an origin (~#:group-origin?~ is f (scene-filter-entities scene predicate) #+end_src -Removes all entities that do not satisfy the predicate. Returns the modified scene. +Keeps only entities that satisfy the predicate. Returns a new scene; the original is not modified. Example: @@ -318,11 +318,16 @@ Returns a list of all entities whose ~#:tags~ list contains the given tag. Retur ** Accessor functions (auto-generated by defstruct) -- ~scene-entities~, ~scene-entities-set!~ -- ~scene-tilemap~, ~scene-tilemap-set!~ -- ~scene-camera~, ~scene-camera-set!~ -- ~scene-tileset-texture~, ~scene-tileset-texture-set!~ -- ~scene-camera-target~, ~scene-camera-target-set!~ +Read accessors: +- ~scene-entities~, ~scene-tilemap~, ~scene-camera~, ~scene-tileset-texture~, ~scene-camera-target~, ~scene-background~ + +Functional updater (returns a new scene with the specified fields changed): + +#+begin_src scheme +(update-scene scene entities: new-entities camera-target: 'player) +#+end_src + +Mutating setters (~scene-entities-set!~, etc.) are also generated but should be avoided in favour of ~update-scene~ and the pure pipeline functions above. Use ~game-scene-set!~ at the boundary to store the final scene back on the game struct. ** ~tilemap-tile-at~ @@ -1328,7 +1333,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 call ~scene-sync-groups~ so member ~#:x~ / ~#:y~ match ~origin + #:group-local-x/y~. ** ~tilemap-objects->entities~ @@ -1343,5 +1348,5 @@ Example: #+begin_src scheme (let* ((registry (load-prefabs "assets/prefabs.scm" '() '())) (entities (tilemap-objects->entities tilemap registry))) - (scene-entities-set! scene entities)) + (update-scene scene entities: entities)) #+end_src diff --git a/docs/entities.org b/docs/entities.org index 048cd8e..3766522 100644 --- a/docs/entities.org +++ b/docs/entities.org @@ -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 ~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 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. - ~#: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 call ~(scene-sync-groups scene)~ so every part’s ~#:x~ / ~#:y~ matches the origin plus local offsets (see ~docs/api.org~ for ordering). * Entities in Scenes @@ -152,17 +152,17 @@ Returns the list of all entities in the scene. (define all-entities (scene-entities scene)) #+end_src -** ~scene-entities-set! scene entities~ +** ~update-scene~ -Mutates the scene to replace the entity list. Use after ~scene-update-entities~ or batch operations. +Returns a new scene with the specified fields changed. Preferred over the mutating ~scene-entities-set!~. #+begin_src scheme -(scene-entities-set! scene (list updated-player updated-enemy)) +(update-scene scene entities: (list updated-player updated-enemy)) #+end_src ** ~scene-add-entity scene entity~ -Adds an entity to the scene and returns the scene. Appends to the entity list. +Returns a new scene with the entity appended to the entity list. #+begin_src scheme (scene-add-entity scene new-enemy) @@ -183,17 +183,15 @@ Maps each procedure over the scene's entities, applying them in sequence. Each p The result is equivalent to: #+begin_src scheme -(let* ((es (scene-entities scene)) - (es (map apply-gravity es)) - (es (map apply-velocity-x es)) - (es (map apply-velocity-y es))) - (scene-entities-set! scene es) - scene) +(chain scene + (scene-update-entities _ apply-gravity) + (scene-update-entities _ apply-velocity-x) + (scene-update-entities _ apply-velocity-y)) #+end_src ** ~scene-filter-entities scene pred~ -Removes all entities that do not satisfy the predicate. Use to despawn dead enemies, collected items, etc. +Keeps only entities satisfying the predicate; returns a new scene. Use to despawn dead enemies, collected items, etc. #+begin_src scheme ;; Remove all entities with #:health <= 0: @@ -392,7 +390,8 @@ Here is a full example showing entity creation, initialization in the scene, and (let ((player (if (< (entity-ref player #:vx 0) 0) (entity-set player #:facing -1) (entity-set player #:facing 1)))) - (scene-entities-set! scene (list player)))))) + (game-scene-set! game + (update-scene scene entities: (list player))))))) #+end_src -Note the let*-chaining pattern: each update builds on the previous result, keeping the data flow clear and each step testable. +Note the let*-chaining pattern: each update builds on the previous result, keeping the data flow clear and each step testable. The single ~game-scene-set!~ at the boundary stores the final scene back on the game struct. diff --git a/docs/guide.org b/docs/guide.org index 1c5a8f3..96663ea 100644 --- a/docs/guide.org +++ b/docs/guide.org @@ -101,7 +101,8 @@ Now let's add an entity you can move with the keyboard. Create =square.scm=: (entity-ref box #:vx 0)))) (box (entity-set box #:y (+ (entity-ref box #:y 0) (entity-ref box #:vy 0))))) - (scene-entities-set! scene (list box)))) + (game-scene-set! game + (update-scene scene entities: (list box))))) render: (lambda (game) (let* ((scene (game-scene game)) @@ -194,11 +195,8 @@ For a real game, you probably want tilemaps, gravity, and collision detection. D (player (apply-velocity-y player)) (player (resolve-tile-collisions-y player tm)) (player (detect-on-solid player tm))) - ;; Update camera to follow player - (let ((cam-x (max 0 (- (entity-ref player #:x 0) 300)))) - (camera-x-set! (scene-camera scene) cam-x)) - ;; Replace entities in scene - (scene-entities-set! scene (list player)))))) + (game-scene-set! game + (update-scene scene entities: (list player))))))) (game-run! *game*) #+end_src diff --git a/docs/physics.org b/docs/physics.org index 9c44718..8401a38 100644 --- a/docs/physics.org +++ b/docs/physics.org @@ -331,11 +331,8 @@ update: (lambda (game dt) (player (resolve-tile-collisions-y player tm)) ;; Check if standing on ground (player (detect-on-solid player tm))) - ;; Update camera to follow player - (let ((cam-x (max 0 (- (entity-ref player #:x 0) 300)))) - (camera-x-set! (scene-camera scene) cam-x)) - ;; Store updated player back in scene - (scene-entities-set! scene (list player)))) + (game-scene-set! game + (update-scene scene entities: (list player))))) #+end_src ** Step-by-Step @@ -378,9 +375,8 @@ update: (lambda (game dt) (player (resolve-tile-collisions-y player tm))) ;; Update camera to follow player (camera-x-set! (scene-camera scene) (max 0 (- (entity-ref player #:x 0) 300))) - (camera-y-set! (scene-camera scene) (max 0 (- (entity-ref player #:y 0) 200))) - ;; Store updated player back in scene - (scene-entities-set! scene (list player)))) + (game-scene-set! game + (update-scene scene entities: (list player))))) #+end_src ** Step-by-Step @@ -133,16 +133,18 @@ (values (or (and state (state-hook state #:update)) (game-update-hook game)) (or (and state (state-hook state #:render)) (game-render-hook game))))) -(define (update-camera-follow! game) - (when (game-scene game) - (let ((target-tag (scene-camera-target (game-scene game)))) - (when target-tag - (let ((target (scene-find-tagged (game-scene game) target-tag))) - (when target - (camera-follow! (scene-camera (game-scene game)) - target - (game-width game) - (game-height game)))))))) +(define (update-camera-follow scene game) + (let ((target-tag (and scene (scene-camera-target scene)))) + (if (not target-tag) + scene + (let ((target (scene-find-tagged scene target-tag))) + (if (not target) + scene + (update-scene scene + camera: (camera-follow (scene-camera scene) + target + (game-width game) + (game-height game)))))))) (define (game-render! game render-fn) (renderer-set-clear-color! (game-renderer game) (game-scene game)) @@ -192,7 +194,8 @@ (unless (input-held? input 'quit) (receive (update-fn render-fn) (resolve-hooks game) (when update-fn (update-fn game dt)) - (update-camera-follow! game) + (when (game-scene game) + (game-scene-set! game (update-camera-follow (game-scene game) game))) (game-render! game render-fn)) (sdl2:delay! (game-frame-delay game)) (loop now)))) diff --git a/physics.scm b/physics.scm index 56966c2..24ded09 100644 --- a/physics.scm +++ b/physics.scm @@ -318,8 +318,7 @@ entities (index-pairs (length entities)))) - ;; Wrapper for scene-resolve-collisions + ;; Returns a new scene with entity-entity collisions resolved. (define (scene-resolve-collisions scene) - (scene-entities-set! scene - (resolve-entity-collisions (scene-entities scene))) - scene)) + (update-scene scene + entities: (resolve-entity-collisions (scene-entities scene))))) diff --git a/prefabs.scm b/prefabs.scm index eda75ad..ef9b556 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 scene-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/engine-test.scm b/tests/engine-test.scm index 9290ad7..2c9d6d5 100644 --- a/tests/engine-test.scm +++ b/tests/engine-test.scm @@ -86,10 +86,11 @@ (import downstroke-entity) (defstruct camera x y) (defstruct scene entities tilemap tileset camera tileset-texture camera-target background) - ;; Mock camera-follow! - just clamps camera position - (define (camera-follow! camera entity viewport-w viewport-h) - (camera-x-set! camera (max 0 (- (entity-ref entity #:x 0) (/ viewport-w 2)))) - (camera-y-set! camera (max 0 (- (entity-ref entity #:y 0) (/ viewport-h 2))))) + ;; Mock camera-follow - returns a new camera + (define (camera-follow camera entity viewport-w viewport-h) + (update-camera camera + x: (max 0 (- (entity-ref entity #:x 0) (/ viewport-w 2))) + y: (max 0 (- (entity-ref entity #:y 0) (/ viewport-h 2))))) ;; Mock scene-find-tagged - finds first entity with matching tag (define (scene-find-tagged scene tag) (let loop ((entities (scene-entities scene))) diff --git a/tests/scene-loader-test.scm b/tests/scene-loader-test.scm index 22de396..5c85ede 100644 --- a/tests/scene-loader-test.scm +++ b/tests/scene-loader-test.scm @@ -45,8 +45,8 @@ (defstruct camera x y) (defstruct scene entities tilemap tileset camera tileset-texture camera-target background) (define (scene-add-entity scene entity) - (scene-entities-set! scene (cons entity (scene-entities scene))) - scene)) + (update-scene scene + entities: (append (scene-entities scene) (list entity))))) (import downstroke-world) ;; Mock assets module diff --git a/tests/world-test.scm b/tests/world-test.scm index dbae9d9..1b368c0 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -134,22 +134,21 @@ (test-equal "initial entity count" 1 (length (scene-entities scene))) - (scene-add-entity scene enemy) - - (test-equal "entity count after add" 2 (length (scene-entities scene))) - (test-equal "second entity is enemy" - 'enemy - (entity-type (cadr (scene-entities scene)))))) + (let ((scene2 (scene-add-entity scene enemy))) + (test-equal "original scene unchanged" 1 (length (scene-entities scene))) + (test-equal "entity count after add" 2 (length (scene-entities scene2))) + (test-equal "second entity is enemy" + 'enemy + (entity-type (cadr (scene-entities scene2))))))) ;; Test: scene-add-entity appends to end (test-group "scene-add-entity-order" (let* ((e1 '(#:type a #:x 1)) (e2 '(#:type b #:x 2)) (e3 '(#:type c #:x 3)) - (scene (make-scene entities: (list e1) tilemap: #f camera-target: #f))) - - (scene-add-entity scene e2) - (scene-add-entity scene e3) + (scene (make-scene entities: (list e1) tilemap: #f camera-target: #f)) + (scene (scene-add-entity scene e2)) + (scene (scene-add-entity scene e3))) (test-equal "entities are in order" '(a b c) @@ -160,66 +159,62 @@ (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)) - ;; Function that moves all entities right by 10 (move-right (lambda (entity) (let ((x (entity-ref entity #:x)) (y (entity-ref entity #:y)) (type (entity-ref entity #:type))) - (list #:type type #:x (+ x 10) #:y y))))) - - (scene-update-entities scene move-right) + (list #:type type #:x (+ x 10) #:y y)))) + (scene2 (scene-update-entities scene move-right))) + (test-equal "original scene unchanged" + 100 + (entity-ref (car (scene-entities scene)) #:x)) (test-equal "first entity moved right" 110 - (entity-ref (car (scene-entities scene)) #:x)) + (entity-ref (car (scene-entities scene2)) #:x)) (test-equal "second entity moved right" 210 - (entity-ref (cadr (scene-entities scene)) #:x)) + (entity-ref (cadr (scene-entities scene2)) #:x)) (test-equal "y values unchanged" 100 - (entity-ref (car (scene-entities scene)) #:y)))) + (entity-ref (car (scene-entities scene2)) #:y)))) ;; Test: scene-update-entities with identity function (test-group "scene-update-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))) - - (scene-update-entities scene (lambda (e) e)) + (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) + (scene2 (scene-update-entities scene (lambda (e) e)))) - (test-equal "entity count unchanged" 2 (length (scene-entities scene))) + (test-equal "entity count unchanged" 2 (length (scene-entities scene2))) (test-equal "first entity unchanged" 100 - (entity-ref (car (scene-entities scene)) #:x)))) + (entity-ref (car (scene-entities scene2)) #:x)))) -;; Test: scene mutation -(test-group "scene-mutation" +;; Test: scene chaining (was mutation test) +(test-group "scene-chaining" (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) - (player (make-player-entity 10 20 16 16))) + (player (make-player-entity 10 20 16 16)) + (scene (scene-add-entity scene player))) - ;; Add entity - (scene-add-entity scene player) (test-equal "entity added" 1 (length (scene-entities scene))) - ;; Update entities - (scene-update-entities scene - (lambda (e) - (let ((x (entity-ref e #:x)) - (y (entity-ref e #:y)) - (type (entity-type e))) - (list #:type type #:x (* x 2) #:y (* y 2) - #:width 16 #:height 16)))) - - (test-equal "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x)) - (test-equal "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y)))) - -;; Test: scene-tilemap-set! -(test-group "scene-tilemap-mutation" - (let ((scene (make-scene entities: '() tilemap: #f camera-target: #f))) + (let ((scene (scene-update-entities scene + (lambda (e) + (let ((x (entity-ref e #:x)) + (y (entity-ref e #:y)) + (type (entity-type e))) + (list #:type type #:x (* x 2) #:y (* y 2) + #:width 16 #:height 16)))))) + (test-equal "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x)) + (test-equal "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y))))) + +;; Test: update-scene for tilemap +(test-group "scene-tilemap-update" + (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) + (scene2 (update-scene scene tilemap: "new-tilemap"))) (test-equal "tilemap initially #f" #f (scene-tilemap scene)) - - (scene-tilemap-set! scene "new-tilemap") - (test-equal "tilemap updated" "new-tilemap" (scene-tilemap scene)))) + (test-equal "tilemap updated in new scene" "new-tilemap" (scene-tilemap scene2)))) ;; Create a test tilemap for the filter test (define test-tilemap @@ -238,25 +233,27 @@ tilemap: test-tilemap camera: (make-camera x: 0 y: 0) tileset-texture: #f - camera-target: #f))) - (scene-filter-entities scene - (lambda (e) (eq? (entity-ref e #:type #f) 'player))) - (test-equal "keeps matching entities" 1 (length (scene-entities scene))) + camera-target: #f)) + (scene2 (scene-filter-entities scene + (lambda (e) (eq? (entity-ref e #:type #f) 'player))))) + (test-equal "original scene unchanged" 2 (length (scene-entities scene))) + (test-equal "keeps matching entities" 1 (length (scene-entities scene2))) (test-equal "kept entity is player" 'player - (entity-ref (car (scene-entities scene)) #:type #f)))) + (entity-ref (car (scene-entities scene2)) #:type #f)))) - (test-group "camera-follow!" + (test-group "camera-follow" (let* ((cam (make-camera x: 0 y: 0)) - (entity (list #:type 'player #:x 400 #:y 300 #:width 16 #:height 16))) - (camera-follow! cam entity 600 400) - (test-equal "centers camera x on entity" 100 (camera-x cam)) - (test-equal "centers camera y on entity" 100 (camera-y cam))) + (entity (list #:type 'player #:x 400 #:y 300 #:width 16 #:height 16)) + (cam2 (camera-follow cam entity 600 400))) + (test-equal "original camera unchanged" 0 (camera-x cam)) + (test-equal "centers camera x on entity" 100 (camera-x cam2)) + (test-equal "centers camera y on entity" 100 (camera-y cam2))) (let* ((cam (make-camera x: 0 y: 0)) - (entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16))) - (camera-follow! cam entity 600 400) - (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam)) - (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam)))) + (entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)) + (cam2 (camera-follow cam entity 600 400))) + (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) + (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) (test-group "scene-find-tagged" (let* ((p (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) @@ -277,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 "scene-sync-groups" (let* ((gid 'g1) (origin (list #:type 'group-origin #:group-origin? #t #:group-id gid #:x 100 #:y 200 #:width 0 #:height 0)) @@ -286,9 +283,10 @@ (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))) - (scene-sync-groups! s) - (let ((es (scene-entities s))) + 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)) @@ -42,31 +42,29 @@ background) ; #f or (r g b) / (r g b a) for framebuffer clear (define (scene-add-entity scene entity) - (scene-entities-set! scene (append (scene-entities scene) (list entity))) - scene) + (update-scene scene + entities: (append (scene-entities scene) (list entity)))) (define (scene-update-entities scene . procs) - "Apply each proc in sequence to the scene's entities; each proc maps over all entities. - The scene's entity list is replaced once with the final result." - (scene-entities-set! scene - (fold (lambda (proc es) (map proc es)) - (scene-entities scene) - procs)) - scene) + "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)) + (scene-entities scene) + procs))) (define (scene-filter-entities scene pred) - "Remove all entities from scene that do not satisfy pred." - (scene-entities-set! scene - (filter pred (scene-entities scene))) - scene) + "Keep only entities satisfying pred; returns a new scene." + (update-scene scene + entities: (filter pred (scene-entities scene)))) ;; Center camera on entity. Clamps to >= 0 on both axes. - ;; viewport-w and viewport-h are the game window dimensions (pixels). - (define (camera-follow! camera entity viewport-w viewport-h) + ;; Returns a new camera struct. + (define (camera-follow camera entity viewport-w viewport-h) (let* ((entity-x (entity-ref entity #:x 0)) (entity-y (entity-ref entity #:y 0))) - (camera-x-set! camera (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2)))))) - (camera-y-set! camera (inexact->exact (floor (max 0 (- entity-y (/ viewport-h 2)))))))) + (update-camera camera + x: (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2))))) + y: (inexact->exact (floor (max 0 (- entity-y (/ viewport-h 2)))))))) ;; Returns the first entity in scene whose #:tags list contains tag, or #f. (define (scene-find-tagged scene tag) @@ -107,11 +105,10 @@ (entity-ref e #:group-local-y 0)))) e))) - ;; Snap member #:x/#:y to origin + #:group-local-x/y. Call after moving origins (tweens, etc.). - (define (scene-sync-groups! scene) + ;; 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)))) - (scene-entities-set! scene - (map (lambda (e) (sync-member-to-origin e origins)) - (scene-entities scene))) - scene)) + (update-scene scene + entities: (map (cut sync-member-to-origin <> origins) + (scene-entities scene))))) ) |
