Rework animations and entities - somewhat

5 files changed, 145 insertions, 79 deletions

diff --git a/animation.scm b/animation.scm
index 4caf1fe..468f7f0 100644
--- a/animation.scm
+++ b/animation.scm
@@ -2,54 +2,75 @@
   (import scheme
           (chicken base)
           (chicken keyword)
+	  (only srfi-1 filter)
           downstroke-entity
           downstroke-world)
 
   ;; ---- Animation data accessors ----
 
-  (define (animation-frames anim) (get-keyword #:frames anim))
-  (define (animation-duration anim) (get-keyword #:duration anim))
-
-  ;; ---- frame->tile-id ----
-  ;; Given a frames list and frame index, return the tile ID (1-indexed).
-
-  (define (frame->tile-id frames frame-idx)
-    (+ 1 (list-ref frames (modulo frame-idx (length frames)))))
-
-  ;; ---- set-animation ----
-  ;; Switch to a new animation, resetting frame and tick counters.
-  ;; No-op if the animation is already active (avoids restart mid-loop).
-
-  (define (set-animation entity name)
-    (if (eq? (entity-ref entity #:anim-name #f) name)
-        entity
-        (entity-set (entity-set (entity-set entity #:anim-name name)
-                                #:anim-frame 0)
-                    #:anim-tick 0)))
-
-  ;; ---- animate-entity ----
-  ;; Advance the animation tick/frame counter for one game tick.
-  ;; Pass the animation table for this entity's type.
-  ;; Entities without #:anim-name are returned unchanged.
-
-  (define (advance-animation entity anim)
-    (let* ((tick     (+ 1 (entity-ref entity #:anim-tick 0)))
-           (duration (animation-duration anim))
-           (frames   (animation-frames anim))
-           (frame    (entity-ref entity #:anim-frame 0)))
-      (if (>= tick duration)
-          (let ((new-frame (modulo (+ frame 1) (length frames))))
-            (entity-set (entity-set (entity-set entity
-                                                #:anim-tick 0)
-                                    #:anim-frame new-frame)
-                        #:tile-id (frame->tile-id frames new-frame)))
-          (entity-set (entity-set entity #:anim-tick tick)
-                      #:tile-id (frame->tile-id frames frame)))))
+  (define (animation-frames anim)
+    (get-keyword #:frames anim))
+  (define (animation-duration anim)
+    (get-keyword #:duration anim))
+
+(define (frame-by-idx frames frame-idx)
+  (list-ref frames (modulo frame-idx (length frames))))
+
+;; The tile ID is 1-indexed.
+(define (frame->tile-id frames frame-idx)
+  (let ((frame-def (frame-by-idx frames frame-idx)))
+    (+ 1 (if (list? frame-def)
+	     (car frame-def)
+	     frame-def))))
+
+(define (frame->duration frames frame-idx)
+  (let ((frame-def (frame-by-idx frames frame-idx)))
+    (if (list? frame-def)
+	(cadr frame-def)
+	10)))
+
+;; ---- set-animation ----
+;; Switch to a new animation, resetting frame and tick counters.
+;; No-op if the animation is already active (avoids restart mid-loop).
+
+(define (set-animation entity name)
+  (if (eq? (entity-ref entity #:anim-name #f) name)
+      entity
+      (entity-set (entity-set (entity-set entity #:anim-name name)
+                              #:anim-frame 0)
+                  #:anim-tick 0)))
+
+
+(define (animation-by-name animations name)
+  (let ((matching-anims (filter (lambda (anim) (eq? (get-keyword #:name anim) 'walk)) animations)))
+    (if matching-anims
+	(car matching-anims)
+	#f)))
+
+;; ---- animate-entity ----
+;; Advance the animation tick/frame counter for one game tick.
+;; Pass the animation table for this entity's type.
+;; Entities without #:anim-name are returned unchanged.
+
+(define (advance-animation entity anim)
+  (let* ((tick     (+ 1 (entity-ref entity #:anim-tick 0)))
+         (duration (animation-duration anim))
+         (frames   (animation-frames anim))
+         (frame    (entity-ref entity #:anim-frame 0)))
+    (if (>= tick duration)
+        (let ((new-frame-id (modulo (+ frame 1) (length frames))))
+          (entity-set-many entity
+			   (list (cons #:anim-tick 0)
+				 (cons #:anim-frame new-frame-id)
+				 (cons #:tile-id (frame->tile-id frames new-frame-id))
+				 (cons #:duration (frame->duration frames new-frame-id)))))
+        (entity-set-many entity
+			 (list (cons #:anim-tick tick)
+			       (cons #:tile-id (frame->tile-id frames frame)))))))
 
   (define (animate-entity entity animations)
     (let* ((anim-name (entity-ref entity #:anim-name #f))
-           (entry     (and anim-name (assq anim-name animations)))
-           (anim      (and entry (cdr entry))))
+           (anim      (and anim-name (animation-by-name animations anim-name))))
       (if anim
           (advance-animation entity anim)
           entity)))
diff --git a/docs/entities.org b/docs/entities.org
index 06b1831..4e451d3 100644
--- a/docs/entities.org
+++ b/docs/entities.org
@@ -24,7 +24,14 @@ The optional key ~#:skip-pipelines~ holds a list of **symbols** naming frame pip
 
 * Creating Entities
 
-There is no ~make-entity~ constructor. Create an entity as a plain list:
+There is a basic ~make-entity~ constructor, which carries positional data (x y w h); its type is ='none=:
+
+#+begin_src scheme
+  (define my-entity (make-entity 200 150 16 16))
+#+end_src
+
+
+However creating an entity is as simple as a plain list:
 
 #+begin_src scheme
 (define my-entity
@@ -77,6 +84,19 @@ Returns a **new** plist with the key/value pair set (or replaced). The original
 (entity-ref updated-player #:vx)  ; → 5
 #+end_src
 
+** ~entity-set-many entity pairs~
+
+Sets multiple attributes of an entity at once.
+
+#+begin_src scheme
+  (define updated-player (entity-set-many player '((#:vx 5) (#:vy 10))))
+  ;; original player is still unchanged:
+  (entity-ref player #:vx)          ; → 0
+  (entity-ref player #:vy)          ; → 0
+  (entity-ref updated-player #:vx)  ; → 5
+  (entity-ref updated-player #:vy)  ; → 10
+#+end_src
+
 ** ~entity-update entity key proc [default]~
 
 Returns a new entity with ~key~ set to ~(proc (entity-ref entity key default))~. Useful for incrementing or transforming a value:
@@ -87,14 +107,13 @@ Returns a new entity with ~key~ set to ~(proc (entity-ref entity key default))~.
 
 ** Chaining Updates: The let* Pattern
 
-Since each update returns a new entity, chain updates with ~let*~:
+Since each update returns a new entity, chain updates with ~chain~ (srfi-197):
 
 #+begin_src scheme
-(let* ((player (entity-set player #:vx 3))
-       (player (apply-velocity-x player scene dt))
-       (player (resolve-tile-collisions-x player scene dt)))
-  ;; now use the updated player
-  player)
+  (chain player
+         (entity-set _ #:vx 3)
+         (apply-velocity-x _ scene dt)
+         (resolve-tile-collisions-x _ scene dt))
 #+end_src
 
 With the default =engine-update=, you normally set =#:vx= / =#:ay= in =update:= and do not chain physics steps yourself. This =let*= shape is for custom =engine-update= hooks or tests; per-entity steps take =(entity scene dt)=.
@@ -103,31 +122,31 @@ With the default =engine-update=, you normally set =#:vx= / =#:ay= in =update:=
 
 The engine recognizes these standard keys. Use them to integrate with the physics pipeline, rendering, and animation systems. Custom keys are always allowed.
 
-| Key | Type | Description |
-|---|---|---|
-| ~#:type~ | symbol | Entity type, e.g., ~'player~, ~'enemy~, ~'coin~. No built-in enforcement; use for ~entity-type~ checks and scene queries. |
-| ~#:x~, ~#:y~ | number | World position in pixels (top-left corner of bounding box). Updated by ~apply-velocity-x~, ~apply-velocity-y~, and collision resolvers. |
-| ~#:width~, ~#:height~ | number | Bounding box size in pixels. Used for AABB tile collision checks and entity-entity collision. Required for physics. |
-| ~#:vx~, ~#:vy~ | number | Velocity in pixels per frame. ~#:vx~ is updated by ~apply-velocity-x~; ~#:vy~ is updated by ~apply-velocity-y~. Both consumed by collision resolvers. |
-| ~#:ay~ | number | Y acceleration (e.g., from jumping or knockback). Consumed by ~apply-acceleration~, which adds it to ~#:vy~. Optional; default is 0. |
-| ~#:gravity?~ | boolean | Whether gravity applies to this entity. Set to ~#t~ for platformers (gravity pulls down), ~#f~ for top-down or flying entities. Used by ~apply-gravity~. |
-| ~#:on-ground?~ | boolean | Whether the entity is supported from below (set by ~detect-on-solid~ in the default pipeline): solid tile under the feet and/or standing on another solid entity from ~(scene-entities scene)~. Use this in ~update:~ to gate jump input (~#:ay~). |
-| ~#:solid?~ | boolean | Whether this entity participates in entity-entity collision. If ~#t~, ~resolve-entity-collisions~ will check it against other solid entities. |
-| ~#:immovable?~ | boolean | If ~#t~ with ~#:solid? #t~, entity–entity resolution only moves the *other* entity (static platforms). Two overlapping immovable solids are not separated. |
-| ~#:skip-pipelines~ | list of symbols | Optional. Each symbol names a pipeline step to skip (e.g. ~gravity~, ~velocity-x~, ~tweens~). See ~docs/physics.org~ and ~docs/tweens.org~. |
-| ~#:tween~ | tween struct or ~#f~ | Optional. When present, ~step-tweens~ auto-advances the tween each frame. Removed automatically when the tween finishes. See ~docs/tweens.org~. |
-| ~#:tile-id~ | integer | Sprite index in the tileset (1-indexed). Used by ~render-scene!~ when the scene has a tileset texture and tile metadata (from the tilemap or ~scene-tileset~). Updated automatically by animation (~animate-entity~). |
-| ~#:color~ | list | Optional ~(r g b)~ or ~(r g b a)~ (0–255 each). When ~#:tile-id~ is not drawn as a sprite (missing ~#:tile-id~, or no tileset texture), ~render-scene!~ fills the entity rect with this color. |
-| ~#:facing~ | number | Horizontal flip direction: ~1~ = right (default), ~-1~ = left. Used by renderer to flip sprite horizontally. Update when changing direction. |
-| ~#:tags~ | list of symbols | List of tag symbols, e.g., ~'(player solid)~. Used by ~scene-find-tagged~ and ~scene-find-all-tagged~ for fast lookups. |
-| ~#:animations~ | alist | Animation definitions (see Animation section). Keys are animation names (symbols); values are animation specs. |
-| ~#:anim-name~ | symbol | Currently active animation name, e.g., ~'walk~, ~'jump~. Set with ~set-animation~; reset by ~animate-entity~. |
-| ~#:anim-frame~ | integer | Current frame index within the animation (0-indexed). Updated automatically by ~animate-entity~. |
-| ~#: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 ~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). |
+| Key                                  | Type                 | Description                                                                                                                                                                                                                                        |
+|--------------------------------------+----------------------+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
+| ~#:type~                             | symbol               | Entity type, e.g., ~'player~, ~'enemy~, ~'coin~. No built-in enforcement; use for ~entity-type~ checks and scene queries.                                                                                                                          |
+| ~#:x~, ~#:y~                         | number               | World position in pixels (top-left corner of bounding box). Updated by ~apply-velocity-x~, ~apply-velocity-y~, and collision resolvers.                                                                                                            |
+| ~#:width~, ~#:height~                | number               | Bounding box size in pixels. Used for AABB tile collision checks and entity-entity collision. Required for physics.                                                                                                                                |
+| ~#:vx~, ~#:vy~                       | number               | Velocity in pixels per frame. ~#:vx~ is updated by ~apply-velocity-x~; ~#:vy~ is updated by ~apply-velocity-y~. Both consumed by collision resolvers.                                                                                              |
+| ~#:ay~                               | number               | Y acceleration (e.g., from jumping or knockback). Consumed by ~apply-acceleration~, which adds it to ~#:vy~. Optional; default is 0.                                                                                                               |
+| ~#:gravity?~                         | boolean              | Whether gravity applies to this entity. Set to ~#t~ for platformers (gravity pulls down), ~#f~ for top-down or flying entities. Used by ~apply-gravity~.                                                                                           |
+| ~#:on-ground?~                       | boolean              | Whether the entity is supported from below (set by ~detect-on-solid~ in the default pipeline): solid tile under the feet and/or standing on another solid entity from ~(scene-entities scene)~. Use this in ~update:~ to gate jump input (~#:ay~). |
+| ~#:solid?~                           | boolean              | Whether this entity participates in entity-entity collision. If ~#t~, ~resolve-entity-collisions~ will check it against other solid entities.                                                                                                      |
+| ~#:immovable?~                       | boolean              | If ~#t~ with ~#:solid? #t~, entity–entity resolution only moves the *other* entity (static platforms). Two overlapping immovable solids are not separated.                                                                                         |
+| ~#:skip-pipelines~                   | list of symbols      | Optional. Each symbol names a pipeline step to skip (e.g. ~gravity~, ~velocity-x~, ~tweens~). See ~docs/physics.org~ and ~docs/tweens.org~.                                                                                                        |
+| ~#:tween~                            | tween struct or ~#f~ | Optional. When present, ~step-tweens~ auto-advances the tween each frame. Removed automatically when the tween finishes. See ~docs/tweens.org~.                                                                                                    |
+| ~#:tile-id~                          | integer              | Sprite index in the tileset (1-indexed). Used by ~render-scene!~ when the scene has a tileset texture and tile metadata (from the tilemap or ~scene-tileset~). Updated automatically by animation (~animate-entity~).                              |
+| ~#:color~                            | list                 | Optional ~(r g b)~ or ~(r g b a)~ (0–255 each). When ~#:tile-id~ is not drawn as a sprite (missing ~#:tile-id~, or no tileset texture), ~render-scene!~ fills the entity rect with this color.                                                     |
+| ~#:facing~                           | number               | Horizontal flip direction: ~1~ = right (default), ~-1~ = left. Used by renderer to flip sprite horizontally. Update when changing direction.                                                                                                       |
+| ~#:tags~                             | list of symbols      | List of tag symbols, e.g., ~'(player solid)~. Used by ~scene-find-tagged~ and ~scene-find-all-tagged~ for fast lookups.                                                                                                                            |
+| ~#:animations~                       | alist                | Animation definitions (see Animation section). Keys are animation names (symbols); values are animation specs.                                                                                                                                     |
+| ~#:anim-name~                        | symbol               | Currently active animation name, e.g., ~'walk~, ~'jump~. Set with ~set-animation~; reset by ~animate-entity~.                                                                                                                                      |
+| ~#:anim-frame~                       | integer              | Current frame index within the animation (0-indexed). Updated automatically by ~animate-entity~.                                                                                                                                                   |
+| ~#: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 ~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)
 
diff --git a/entity.scm b/entity.scm
index dab2e83..16d28c4 100644
--- a/entity.scm
+++ b/entity.scm
@@ -27,8 +27,14 @@
                                (loop (cddr lst) (cons v (cons k acc)))))))))
       (cons key (cons val cleaned))))
 
-  (define (entity-update entity key proc #!optional default)
-    (entity-set entity key (proc (entity-ref entity key default))))
+(define (entity-set-many entity pairs)
+  (fold (lambda (pair working-ent)
+	 (entity-set working-ent (car pair) (cdr pair)))
+	entity
+	pairs))
+
+(define (entity-update entity key proc #!optional default)
+  (entity-set entity key (proc (entity-ref entity key default))))
 
   ;; #:skip-pipelines — list of symbols naming frame pipeline steps to skip for this
   ;; entity. Physics documents the built-in step names (see docs/physics.org). Other
diff --git a/tests/animation-test.scm b/tests/animation-test.scm
index e12b35b..aaaba41 100644
--- a/tests/animation-test.scm
+++ b/tests/animation-test.scm
@@ -8,9 +8,19 @@
 (test-begin "animation")
 
 (test-group "frame->tile-id"
-  (test-equal "first frame, frames (0)" 1 (frame->tile-id '(0) 0))
-  (test-equal "wraps around" 1 (frame->tile-id '(0 1) 2))
-  (test-equal "frame 1 of (27 28)" 29 (frame->tile-id '(27 28) 1)))
+  (test-group "tile IDs only"
+    (test-equal "first frame, frames (0)" 1 (frame->tile-id '(0) 0))
+    (test-equal "wraps around" 1 (frame->tile-id '(0 1) 2))
+    (test-equal "frame 1 of (27 28)" 29 (frame->tile-id '(27 28) 1)))
+  (test-group "tile IDs and durations"
+    (test-equal "first frame, frames (0)" 1 (frame->tile-id '((0 10)) 0))
+    (test-equal "wraps around" 1 (frame->tile-id '((0 10) (1 10)) 2))
+    (test-equal "frame 1 of (27 28)" 29 (frame->tile-id '((27 10) (28 10)) 1))))
+
+(test-group "frame->duration"
+  (test-equal "first frame, frames (0)" 100 (frame->duration '((0 100)) 0))
+  (test-equal "wraps around" 100 (frame->duration '((0 100) (1 200)) 2))
+  (test-equal "frame 1 of (27 28)" 200 (frame->duration '((27 100) (28 200)) 1)))
 
 (test-group "set-animation"
   (let ((entity (list #:type 'player #:anim-name 'idle #:anim-frame 5 #:anim-tick 8)))
@@ -21,12 +31,12 @@
       (test-equal "resets tick" 0 (entity-ref switched #:anim-tick)))))
 
 (test-group "animate-entity"
-  (let* ((anims '((walk . (#:frames (0 1) #:duration 4))))
+  (let* ((anims '((#:name walk #:frames (0 1) #:duration 4)))
          (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 0))
          (stepped (animate-entity entity anims)))
     (test-equal "increments tick" 1 (entity-ref stepped #:anim-tick))
     (test-equal "sets tile-id on first tick" 1 (entity-ref stepped #:tile-id)))
-  (let* ((anims '((walk . (#:frames (0 1) #:duration 2))))
+  (let* ((anims '((#:name walk #:frames (0 1) #:duration 2)))
          (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 1))
          (advanced (animate-entity entity anims)))
     (test-equal "advances frame when tick reaches duration" 1 (entity-ref advanced #:anim-frame))
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
index 270555c..9c7607c 100644
--- a/tests/entity-test.scm
+++ b/tests/entity-test.scm
@@ -79,6 +79,16 @@
       (test-equal "existing key untouched" 10 (entity-ref e #:x))
       (test-equal "list grows by one pair" 4 (length e)))))
 
+(test-group "entity-set-many"
+  (test-group "Set multiple entities with lists"
+    (let ((e (entity-set-many '(#:x 10 #:y 20) '((#:x 15) (#:y 25)))))
+      (test-equal "value x updated" (entity-ref e #:x) 15)
+      (test-equal "value y updated" (entity-ref e #:y) 25)))
+  (test-group "Set multiple entities with cons"
+    (let ((e (entity-set-many '(#:x 10 #:y 20) (list (cons #:x 15) (cons #:y 25)))))
+      (test-equal "value x updated" (entity-ref e #:x) 15)
+      (test-equal "value y updated" (entity-ref e #:y) 25))))
+
 ;; Test: entity-update applies transformations
 (test-group "entity-update"
   (test-group "transform existing value"