aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGene Pasquet <dev@etenil.net>2026-04-07 19:30:08 +0100
committerGene Pasquet <dev@etenil.net>2026-04-07 19:30:08 +0100
commit618ed5fd6f5ae9c9f275c1e3cfb74762d7d51a01 (patch)
tree0d634d79f27b97067d423c0ec1a8f62d3cd4b467
parent78a924defabc862a7cfa5476091152c1ef5333ee (diff)
Added tweens
-rw-r--r--.gitignore3
-rw-r--r--Makefile10
-rw-r--r--demo/tweens.scm139
-rw-r--r--docs/api.org75
-rw-r--r--docs/entities.org5
-rw-r--r--docs/guide.org4
-rw-r--r--docs/physics.org57
-rw-r--r--docs/tweens.org90
-rw-r--r--downstroke.egg3
-rw-r--r--entity.scm30
-rw-r--r--physics.scm52
-rw-r--r--tests/entity-test.scm19
-rw-r--r--tests/physics-test.scm20
-rw-r--r--tests/renderer-test.scm28
-rw-r--r--tests/tween-test.scm82
-rw-r--r--tween.scm168
16 files changed, 739 insertions, 46 deletions
diff --git a/.gitignore b/.gitignore
index 1f0692c..e452598 100644
--- a/.gitignore
+++ b/.gitignore
@@ -15,4 +15,5 @@ logs
/.agent-shell/
CLAUDE.md
superpowers/*
-/public \ No newline at end of file
+/public
+superpowers
diff --git a/Makefile b/Makefile
index 2729d94..b8b6a94 100644
--- a/Makefile
+++ b/Makefile
@@ -1,10 +1,10 @@
.DEFAULT_GOAL := engine
# Modules listed in dependency order
-MODULE_NAMES := entity tilemap world input physics renderer assets engine mixer sound animation ai prefabs scene-loader
+MODULE_NAMES := entity tween tilemap world input physics renderer assets engine mixer sound animation ai prefabs scene-loader
OBJECT_FILES := $(patsubst %,bin/%.o,$(MODULE_NAMES))
-DEMO_NAMES := platformer shmup topdown audio sandbox spritefont menu
+DEMO_NAMES := platformer shmup topdown audio sandbox spritefont menu tweens
DEMO_BINS := $(patsubst %,bin/demo-%,$(DEMO_NAMES))
UNIT_NAMES := $(patsubst %,downstroke-%,$(MODULE_NAMES))
@@ -18,6 +18,7 @@ bin:
# Explicit inter-module dependencies
bin/entity.o:
+bin/tween.o: bin/entity.o
bin/tilemap.o:
bin/world.o: bin/entity.o bin/tilemap.o
bin/input.o: bin/entity.o
@@ -40,8 +41,8 @@ bin/%.o: %.scm | bin
.PHONY: clean test engine demos
clean:
- rm -rf bin
- rm -f *.import.scm
+ rm -rf bin downstroke/
+ rm -f *.import.scm *.import.so *.so
rm -f *.log
test:
@@ -58,6 +59,7 @@ test:
@csi -s tests/ai-test.scm
@csi -s tests/prefabs-test.scm
@csi -s tests/scene-loader-test.scm
+ @csi -s tests/tween-test.scm
demos: engine $(DEMO_BINS)
diff --git a/demo/tweens.scm b/demo/tweens.scm
new file mode 100644
index 0000000..e9e40f3
--- /dev/null
+++ b/demo/tweens.scm
@@ -0,0 +1,139 @@
+(import scheme
+ (chicken base)
+ (only srfi-1 iota map)
+ (prefix sdl2 "sdl2:")
+ (prefix sdl2-ttf "ttf:")
+ (prefix sdl2-image "img:")
+ downstroke-engine
+ downstroke-world
+ downstroke-tilemap
+ downstroke-renderer
+ downstroke-physics
+ downstroke-entity
+ downstroke-tween
+ downstroke-scene-loader)
+
+;; One row per easing symbol: #(entity tween left-x right-x ease-sym to-right?)
+(define *ease-cells* #f)
+
+(define *knock-ent* #f)
+(define *knock-tw* #f)
+(define *knock-cd* 0)
+
+(define +knock-skip+
+ '(jump acceleration gravity velocity-x velocity-y))
+
+(define *ease-syms*
+ '(linear quad-in quad-out quad-in-out cubic-in cubic-out cubic-in-out
+ sine-in-out expo-in expo-out expo-in-out back-out))
+
+(define *label-font* #f)
+(define *title-font* #f)
+
+(define +tile-ids+ '#(24 73 122 171 220))
+
+(define (make-ease-cell ease-sym y tile-id)
+ (let* ((left 20)
+ (right (+ left 120))
+ (ent (list #:type 'tween-demo #:x left #:y y #:width 14 #:height 14
+ #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:tile-id tile-id))
+ (tw (make-tween ent props: `((#:x . ,right)) duration: 2600 ease: ease-sym)))
+ (vector ent tw left right ease-sym #t)))
+
+(define (advance-ease-cell! cell dt)
+ (let ((ent (vector-ref cell 0))
+ (tw (vector-ref cell 1))
+ (left (vector-ref cell 2))
+ (right (vector-ref cell 3))
+ (ease (vector-ref cell 4))
+ (to-right? (vector-ref cell 5)))
+ (receive (tw2 ent2) (tween-step tw ent dt)
+ (vector-set! cell 0 ent2)
+ (cond ((tween-finished? tw2)
+ (let* ((next-to-right? (not to-right?))
+ (target-x (if next-to-right? right left))
+ (tw3 (make-tween ent2 props: `((#:x . ,target-x))
+ duration: 2600 ease: ease)))
+ (vector-set! cell 1 tw3)
+ (vector-set! cell 5 next-to-right?)))
+ (else (vector-set! cell 1 tw2))))))
+
+(define (update-knockback! dt tm)
+ (set! *knock-cd* (+ *knock-cd* dt))
+ (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* 3200))
+ (set! *knock-cd* 0)
+ (let ((x (entity-ref *knock-ent* #:x 0)))
+ (set! *knock-ent* (entity-set *knock-ent* #:skip-pipelines +knock-skip+))
+ (set! *knock-tw* (make-tween *knock-ent*
+ props: `((#:x . ,(+ x 88)))
+ duration: 650
+ ease: 'back-out
+ on-complete: (lambda (e)
+ (set! *knock-ent* (entity-set e #:skip-pipelines '())))))))
+ (when *knock-tw*
+ (receive (t2 e2) (tween-step *knock-tw* *knock-ent* dt)
+ (set! *knock-tw* (if (tween-finished? t2) #f t2))
+ (set! *knock-ent* e2)))
+ (when *knock-ent*
+ (set! *knock-ent*
+ (let* ((e *knock-ent*)
+ (e (apply-jump e #f))
+ (e (apply-acceleration e))
+ (e (apply-gravity e))
+ (e (apply-velocity-x e))
+ (e (resolve-tile-collisions-x e tm))
+ (e (apply-velocity-y e))
+ (e (resolve-tile-collisions-y e tm))
+ (e (detect-ground e tm)))
+ e))))
+
+(define (tweens-demo-render-labels! renderer)
+ (let ((white (sdl2:make-color 255 255 255 255)))
+ (draw-ui-text renderer *title-font*
+ "Tween demo — easing rows + knockback / skip-pipelines" white 12 6)
+ (draw-ui-text renderer *label-font*
+ "Each box loops on X; bottom crate tweens right with physics integration skipped, tiles still collide."
+ white 12 32)
+ (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
+ (let* ((cell (vector-ref *ease-cells* i))
+ (ent (vector-ref cell 0))
+ (lab (symbol->string (vector-ref cell 4))))
+ (draw-ui-text renderer *label-font* lab white 158 (- (entity-ref ent #:y 0) 2))))))
+
+(define *game*
+ (make-game
+ title: "Demo: Tweens" width: 640 height: 480
+ preload: (lambda (_game)
+ (set! *title-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 22))
+ (set! *label-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 13)))
+ create: (lambda (game)
+ (let ((scene (game-load-scene! game "demo/assets/level-0.tmx")))
+ (set! *ease-cells*
+ (list->vector
+ (map (lambda (ease i)
+ (make-ease-cell ease (+ 52 (* i 20))
+ (vector-ref +tile-ids+ (modulo i (vector-length +tile-ids+)))))
+ *ease-syms*
+ (iota (length *ease-syms*)))))
+ (set! *knock-ent*
+ (list #:type 'knock-crate #:x 200 #:y 80 #:width 18 #:height 18
+ #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f #:solid? #f #:tile-id 220))
+ (set! *knock-tw* #f)
+ (set! *knock-cd* 2500)
+ (scene-entities-set! scene
+ (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0))
+ (iota (vector-length *ease-cells*)))
+ (list *knock-ent*)))))
+ update: (lambda (game dt)
+ (let* ((scene (game-scene game)) (tm (scene-tilemap scene)))
+ (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
+ (advance-ease-cell! (vector-ref *ease-cells* i) dt))
+ (update-knockback! dt tm)
+ (scene-entities-set! scene
+ (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0))
+ (iota (vector-length *ease-cells*)))
+ (list *knock-ent*)))))
+ render: (lambda (game)
+ (tweens-demo-render-labels! (game-renderer game)))))
+
+(game-run! *game*)
diff --git a/docs/api.org b/docs/api.org
index f18b80a..f6cfe50 100644
--- a/docs/api.org
+++ b/docs/api.org
@@ -287,7 +287,7 @@ Returns the tile ID at grid position ~(col, row)~ across all layers. Returns ~0~
(import downstroke-entity)
#+end_src
-The entity module provides property list (plist) accessors for game objects. Entities are immutable plists, never modified in place.
+The entity module provides property list (plist) accessors for game objects. Entities are immutable plists, never modified in place. It also defines ~entity-skips-pipeline?~ and the ~define-pipeline~ macro for frame pipeline steps that respect ~#:skip-pipelines~ (see ~docs/physics.org~ for the built-in physics step names).
** ~entity-ref~
@@ -344,6 +344,22 @@ Example:
; Equivalent to (entity-set player #:x (+ 10 (entity-ref player #:x 0)))
#+end_src
+** ~entity-skips-pipeline?~
+
+#+begin_src scheme
+(entity-skips-pipeline? entity step-symbol)
+#+end_src
+
+Returns true if ~step-symbol~ appears in the entity’s ~#:skip-pipelines~ list (and that list is non-empty). The built-in physics step names are documented in ~docs/physics.org~; other engine modules may reserve additional symbols for their own frame phases (rendering, animation, etc.) using the same plist key.
+
+** ~define-pipeline~
+
+#+begin_src scheme
+(define-pipeline (procedure-name skip-symbol) (entity-formal extra-formal ...) 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-ground~ vs ~ground-detection~).
+
** Shared Entity Keys
All entities can have these keys. Not all are required:
@@ -363,6 +379,7 @@ All entities can have these keys. Not all are required:
| ~#:on-ground?~ | boolean | Is entity touching a solid tile below? |
| ~#:facing~ | integer | 1 (right) or -1 (left) |
| ~#:solid?~ | boolean | Participate in AABB entity collisions? |
+| ~#:skip-pipelines~ | list | Symbols naming pipeline steps to skip; physics defines the built-in set (~docs/physics.org~) |
| ~#:anim-name~ | symbol | Current animation name |
| ~#:anim-frame~ | integer | Current frame index |
| ~#:anim-tick~ | integer | Ticks in current frame |
@@ -377,15 +394,19 @@ The physics module provides functions for movement, collision detection, and gro
** Physics Pipeline Order
-The built-in physics runs in this order each frame:
+The built-in physics functions are normally run in this order each frame (after reading input, before rendering):
-1. ~apply-acceleration~ — consume ~#:ay~ into ~#:vy~
-2. ~apply-gravity~ — add gravity to ~#:vy~
-3. ~apply-velocity-x~ — move by ~#:vx~
-4. ~resolve-tile-collisions-x~ — snap against horizontal tile collisions
-5. ~apply-velocity-y~ — move by ~#:vy~
-6. ~resolve-tile-collisions-y~ — snap against vertical tile collisions
-7. ~detect-ground~ — set ~#:on-ground?~ if standing on a tile
+1. ~apply-jump~ — if jump pressed and on ground, set ~#:ay~
+2. ~apply-acceleration~ — consume ~#:ay~ into ~#:vy~
+3. ~apply-gravity~ — add gravity to ~#:vy~
+4. ~apply-velocity-x~ — move by ~#:vx~
+5. ~resolve-tile-collisions-x~ — snap against horizontal tile collisions
+6. ~apply-velocity-y~ — move by ~#:vy~
+7. ~resolve-tile-collisions-y~ — snap against vertical tile collisions
+8. ~detect-ground~ — set ~#:on-ground?~ if standing on a tile
+9. ~resolve-entity-collisions~ — push apart solid entities (whole list)
+
+Entities may list ~#:skip-pipelines~ to omit specific steps; see ~entity-skips-pipeline?~ under ~downstroke-entity~ and ~docs/physics.org~.
(This separation ensures smooth sliding along walls.)
@@ -963,6 +984,42 @@ Changes the music volume while it is playing. ~volume~ is 0.0 to 1.0.
Releases all audio resources. Call at shutdown or in a cleanup hook.
+* Tweens (~downstroke-tween~)
+
+#+begin_src scheme
+(import downstroke-tween)
+#+end_src
+
+Time-based interpolation of numeric entity properties. Library-only — call from ~update:~; see ~docs/tweens.org~ for patterns with ~#:skip-pipelines~.
+
+** ~make-tween~
+
+#+begin_src scheme
+(make-tween entity #!key props duration (delay 0) ease (on-complete #f))
+#+end_src
+
+| Keyword | Description |
+|---------+-------------|
+| ~props~ | Alist ~((#:key . target-number) ...)~ |
+| ~duration~ | Milliseconds of interpolation after ~delay~ |
+| ~delay~ | Initial wait in ms (default 0) |
+| ~ease~ | Symbol (e.g. ~quad-in-out~) or ~(lambda (t) ...)~ with ~t~ in [0,1] |
+| ~on-complete~ | Optional ~(lambda (entity) ...)~ once at completion |
+
+** ~tween-step~
+
+#+begin_src scheme
+(tween-step tween entity dt)
+#+end_src
+
+Returns two values: updated tween struct and updated entity. ~dt~ is elapsed milliseconds for this frame.
+
+** ~tween-finished?~ / ~tween-active?~
+
+** Easing exports
+
+~ease-linear~, ~ease-quad-in~, ~ease-quad-out~, ~ease-quad-in-out~, ~ease-cubic-in~, ~ease-cubic-out~, ~ease-cubic-in-out~, ~ease-sine-in-out~, ~ease-expo-in~, ~ease-expo-out~, ~ease-expo-in-out~, ~ease-back-out~, ~ease-named~, ~ease-resolve~.
+
* Animation (~downstroke-animation~)
#+begin_src scheme
diff --git a/docs/entities.org b/docs/entities.org
index db5663d..f6e870c 100644
--- a/docs/entities.org
+++ b/docs/entities.org
@@ -18,6 +18,10 @@ Entities in Downstroke are plain Scheme **plists** (property lists) — alternat
This minimal approach keeps the engine lean: your game defines whatever keys it needs. The shared keys listed below are *conventions* for physics, rendering, and animation — use them to integrate with the engine's built-in systems. Custom keys are always allowed.
+* 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.
+
* Creating Entities
There is no ~make-entity~ constructor. Create an entity as a plain list:
@@ -109,6 +113,7 @@ The engine recognizes these standard keys. Use them to integrate with the physic
| ~#: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 touching a solid tile below (set by ~detect-ground~). Use this to gate jump input: only allow jumping if ~#:on-ground?~ is true. |
| ~#:solid?~ | boolean | Whether this entity participates in entity-entity collision. If ~#t~, ~resolve-entity-collisions~ will check it against other solid entities. |
+| ~#:skip-pipelines~ | list of symbols | Optional. Each symbol names a physics step to skip for this entity (e.g. ~gravity~, ~velocity-x~). See ~docs/physics.org~. |
| ~#:tile-id~ | integer | Sprite index in the tileset (1-indexed). Required for rendering with ~draw-sprite~. Updated automatically by animation (~animate-entity~). |
| ~#: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. |
diff --git a/docs/guide.org b/docs/guide.org
index ca9cfbf..de07c82 100644
--- a/docs/guide.org
+++ b/docs/guide.org
@@ -240,7 +240,7 @@ This is invaluable for tuning collision geometry and understanding why entities
* Demo Overview
-Downstroke includes seven complete demo games that showcase different features:
+Downstroke includes several demo games that showcase different features:
| Demo | File | What it shows |
|------|------|--------------|
@@ -251,6 +251,7 @@ Downstroke includes seven complete demo games that showcase different features:
| Audio | =demo/audio.scm= | Sound effects, music toggle, text rendering |
| Sprite Font | =demo/spritefont.scm= | Bitmap text rendering using non-contiguous tileset ranges |
| Menu | =demo/menu.scm= | State machine menus, keyboard navigation, TTF text rendering |
+| Tweens | =demo/tweens.scm= | Easing curves, =tween-step=, =#:skip-pipelines= with tile collision |
Each demo is self-contained and serves as a working reference for a particular game mechanic.
@@ -283,5 +284,6 @@ For more details:
- **Full API reference**: See =docs/api.org= for all functions and keyword arguments.
- **Entity model**: See =docs/entities.org= to learn about plist keys, tags, prefabs, and mixins.
- **Physics pipeline**: See =docs/physics.org= for the full physics specification and collision model.
+- **Tweens**: See =docs/tweens.org= for time-based property interpolation and combining tweens with physics.
Happy coding!
diff --git a/docs/physics.org b/docs/physics.org
index a267d6d..2a82210 100644
--- a/docs/physics.org
+++ b/docs/physics.org
@@ -22,38 +22,69 @@ The =tilemap= argument is required by collision functions, since collision data
* Physics Pipeline
-The canonical 9-step physics pipeline is:
+The canonical **per-entity** physics pipeline (what you typically call from =update:=) is:
#+begin_src
-input
+apply-jump (set #:ay if jump pressed and on-ground)
-apply-jump (set #:ay if jump pressed and on-ground)
+apply-acceleration (consume #:ay into #:vy)
-apply-acceleration (consume #:ay into #:vy)
+apply-gravity (add gravity constant to #:vy)
-apply-gravity (add gravity constant to #:vy)
+apply-velocity-x (add #:vx to #:x)
-apply-velocity-x (add #:vx to #:x)
+resolve-tile-collisions-x (snap off horizontal tiles, zero #:vx)
-resolve-tile-collisions-x (snap off horizontal tiles, zero #:vx)
- ↓
-apply-velocity-y (add #:vy to #:y)
+apply-velocity-y (add #:vy to #:y)
resolve-tile-collisions-y (snap off vertical tiles, zero #:vy)
-detect-ground (probe 1px below feet, set #:on-ground?)
- ↓
-resolve-entity-collisions (push apart overlapping solid entities)
+detect-ground (probe 1px below feet, set #:on-ground?)
-render
+resolve-entity-collisions (push apart overlapping solid entities; whole list)
#+end_src
+Input and rendering live **outside** this list — you read input first, then run the steps you need, then render.
+
**Not all steps are needed for all game types.** See the examples section for three different patterns:
- **Platformer**: uses all 9 steps
- **Top-down**: skips gravity, acceleration, jump, ground detection
- **Physics Sandbox**: uses all steps, applies them to multiple entities
+* Skipping steps (~#:skip-pipelines~)
+
+An entity may include ~#:skip-pipelines=, a list of **symbols** naming steps to **omit** for that entity only. Absent or empty means no steps are skipped.
+
+| Symbol | Skipped call |
+|--------+----------------|
+| ~jump~ | ~apply-jump~ |
+| ~acceleration~ | ~apply-acceleration~ |
+| ~gravity~ | ~apply-gravity~ |
+| ~velocity-x~ | ~apply-velocity-x~ |
+| ~velocity-y~ | ~apply-velocity-y~ |
+| ~tile-collisions-x~ | ~resolve-tile-collisions-x~ |
+| ~tile-collisions-y~ | ~resolve-tile-collisions-y~ |
+| ~ground-detection~ | ~detect-ground~ |
+| ~entity-collisions~ | participation in ~resolve-entity-collisions~ / ~resolve-pair~ |
+
+**Entity–entity collisions:** if *either* entity in a pair lists ~entity-collisions~ in ~#:skip-pipelines=, that pair is not resolved (no push-apart). Use this for “ghost” actors or scripted motion that should not participate in mutual solid resolution.
+
+**Legacy ~apply-velocity~:** skips each axis independently if ~velocity-x~ or ~velocity-y~ is listed.
+
+Helper: ~(entity-skips-pipeline? entity step-symbol)~ (from ~downstroke-entity~) returns ~#t~ if ~step-symbol~ is in the entity’s skip list.
+
+** ~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 so names like ~detect-ground~ can use the skip key ~ground-detection~. ~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.
+
+Use cases:
+
+- **Tweens / knockback:** skip ~jump~, ~acceleration~, ~gravity~, ~velocity-x~, ~velocity-y~ while a tween drives ~#:x~ / ~#:y~, but keep tile resolution so the body does not rest inside walls.
+- **Top-down:** omit gravity, jump, acceleration, ground detection from your *call order*; you usually do not need ~#:skip-pipelines= unless some entities differ from others.
+
* Pipeline Steps
** apply-jump
diff --git a/docs/tweens.org b/docs/tweens.org
new file mode 100644
index 0000000..9ac87cd
--- /dev/null
+++ b/docs/tweens.org
@@ -0,0 +1,90 @@
+#+title: Tweens
+#+author: Downstroke Contributors
+
+* Overview
+
+The =downstroke-tween= module interpolates **numeric** entity properties over wall-clock time. It is **decoupled** from the engine: you create tween values, call =tween-step= each frame from your =update:= hook, and store the returned entity back into the scene.
+
+Durations and delays are in **milliseconds**, matching the =dt= argument to =update:=.
+
+* Import
+
+#+begin_src scheme
+(import downstroke-tween)
+#+end_src
+
+* Core API
+
+** ~make-tween~
+
+#+begin_src scheme
+(make-tween entity #!key props duration (delay 0) ease (on-complete #f))
+#+end_src
+
+| Keyword | Meaning |
+|---------+---------|
+| ~props~ | Alist =((#:x . 200) (#:y . 40))= — keyword keys, numeric targets |
+| ~duration~ | Positive integer, milliseconds of interpolation (after ~delay~) |
+| ~delay~ | Non-negative integer ms before interpolation starts |
+| ~ease~ | Easing symbol (see table below) or ~(lambda (t) ...)= with ~t~ in $[0,1]$ |
+| ~on-complete~ | Optional ~(lambda (entity) ...)=, called **once** when the tween reaches its targets |
+
+Start values are captured from ~entity~ at construction time. While the tween runs, intermediate values may be **inexact** (flonums) even if starts and ends are integers.
+
+** ~tween-step~
+
+#+begin_src scheme
+(tween-step tween entity dt)
+#+end_src
+
+Returns ~(values new-tween new-entity)~. Advance time by ~dt~ (ms). Before ~delay~ elapses, ~entity~ is unchanged. After completion, further steps return the same values (idempotent). When the tween completes, ~on-complete~ runs with the **final** entity (targets applied), then the callback slot is cleared.
+
+** ~tween-finished?~ / ~tween-active?~
+
+Predicates on the tween struct.
+
+* Easing
+
+Each ease maps normalized time ~t ∈ [0,1]~ to an interpolation factor (usually in ~[0,1]~; ~back-out~ may exceed ~1~ briefly).
+
+| Symbol | Procedure |
+|--------|-----------|
+| ~linear~ | ~ease-linear~ |
+| ~quad-in~, ~quad-out~, ~quad-in-out~ | quadratic |
+| ~cubic-in~, ~cubic-out~, ~cubic-in-out~ | cubic |
+| ~sine-in-out~ | smooth sine |
+| ~expo-in~, ~expo-out~, ~expo-in-out~ | exponential |
+| ~back-out~ | overshoot then settle (Robert Penner–style) |
+
+** ~ease-named~ / ~ease-resolve~
+
+~ease-named~ turns a symbol into a procedure. ~ease-resolve~ accepts a symbol or procedure (identity for procedures) for use in custom tooling.
+
+All easing procedures are exported if you want to compose curves manually.
+
+* Order of operations with physics
+
+Tweens usually **fight** velocity and gravity if both update ~#:x~ / ~#:y~. Typical pattern:
+
+1. Set the entity’s ~#:skip-pipelines~ to skip integration steps you do not want (see [[physics.org][Physics]]).
+2. Run ~tween-step~ for that entity.
+3. Run your normal physics pipeline (collisions can still run).
+
+Clear ~#:skip-pipelines~ in ~on-complete~ when the tween ends.
+
+Example skip list for “kinematic shove” while keeping tile collisions:
+
+#+begin_src scheme
+(entity-set player #:skip-pipelines
+ '(jump acceleration gravity velocity-x velocity-y))
+#+end_src
+
+* Demo
+
+=bin/demo-tweens= (source =demo/tweens.scm=) shows one row per easing and a crate that tweens horizontally while integration is skipped and tile resolution still runs.
+
+* Limitations (current version)
+
+- Single segment per tween (no built-in chains or yoyo).
+- Numeric properties only.
+- No engine integration — you wire ~tween-step~ yourself.
diff --git a/downstroke.egg b/downstroke.egg
index 3572d66..000328c 100644
--- a/downstroke.egg
+++ b/downstroke.egg
@@ -7,6 +7,9 @@
(components
(extension downstroke-entity
(source "entity.scm"))
+ (extension downstroke-tween
+ (source "tween.scm")
+ (component-dependencies downstroke-entity))
(extension downstroke-tilemap
(source "tilemap.scm"))
(extension downstroke-world
diff --git a/entity.scm b/entity.scm
index 8e8011f..e4b3937 100644
--- a/entity.scm
+++ b/entity.scm
@@ -27,6 +27,36 @@
(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
+ ;; subsystems (e.g. animation, rendering) may reserve additional symbols later and
+ ;; use the same predicate and define-pipeline macro.
+
+ (define (entity-skips-pipeline? entity step)
+ (let ((skips (entity-ref entity #:skip-pipelines '())))
+ (and (pair? skips) (memq step skips))))
+
+ ;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the
+ ;; binding from THIS module — works across compiled unit boundaries.
+ (define-syntax define-pipeline
+ (er-macro-transformer
+ (lambda (form rename _compare)
+ (let* ((name-skip (cadr form))
+ (name (car name-skip))
+ (skip (cadr name-skip))
+ (formals (caddr form))
+ (f1 (car formals))
+ (body (cdddr form))
+ (%define (rename 'define))
+ (%if (rename 'if))
+ (%let (rename 'let))
+ (%quote (rename 'quote))
+ (%skip? (rename 'entity-skips-pipeline?)))
+ `(,%define (,name ,@formals)
+ (,%if (,%skip? ,f1 (,%quote ,skip))
+ ,f1
+ (,%let () ,@body)))))))
+
(define (make-player-entity x y width height)
(list #:type 'player
#:x x
diff --git a/physics.scm b/physics.scm
index 627dbea..f3cc3bb 100644
--- a/physics.scm
+++ b/physics.scm
@@ -1,4 +1,12 @@
-(module downstroke-physics *
+(module downstroke-physics
+ (scene-resolve-collisions resolve-entity-collisions resolve-pair
+ aabb-overlap? push-apart push-along-axis aabb-overlap-on-axis
+ entity-center-on-axis push-entity axis->velocity axis->dimension
+ index-pairs list-set apply-jump detect-ground
+ resolve-tile-collisions-y resolve-tile-collisions-x resolve-tile-collisions-axis
+ tile-push-pos entity-tile-cells pixel->tile build-cell-list
+ apply-velocity apply-velocity-y apply-velocity-x apply-gravity apply-acceleration
+ *jump-force* *gravity*)
(import scheme
(chicken base)
(chicken keyword)
@@ -15,8 +23,11 @@
;; Jump force: vertical acceleration applied on jump (one frame)
(define *jump-force* 15)
+ ;; Per-entity steps use define-pipeline from downstroke-entity (see docs/physics.org
+ ;; for #:skip-pipelines symbol names).
+
;; Consume #:ay into #:vy and clear it (one-shot acceleration)
- (define (apply-acceleration entity)
+ (define-pipeline (apply-acceleration acceleration) (entity)
(if (not (entity-ref entity #:gravity? #f))
entity
(let ((ay (entity-ref entity #:ay 0))
@@ -24,21 +35,19 @@
(entity-set (entity-set entity #:vy (+ vy ay)) #:ay 0))))
;; Apply gravity to an entity if it has gravity enabled
- (define (apply-gravity entity)
+ (define-pipeline (apply-gravity gravity) (entity)
(if (entity-ref entity #:gravity? #f)
(entity-set entity #:vy (+ (entity-ref entity #:vy) *gravity*))
entity))
;; Update entity's x by its vx velocity
- (define (apply-velocity-x entity)
- "Update entity's x by its vx velocity."
+ (define-pipeline (apply-velocity-x velocity-x) (entity)
(let ((x (entity-ref entity #:x 0))
(vx (entity-ref entity #:vx 0)))
(entity-set entity #:x (+ x vx))))
;; Update entity's y by its vy velocity
- (define (apply-velocity-y entity)
- "Update entity's y by its vy velocity."
+ (define-pipeline (apply-velocity-y velocity-y) (entity)
(let ((y (entity-ref entity #:y 0))
(vy (entity-ref entity #:vy 0)))
(entity-set entity #:y (+ y vy))))
@@ -46,11 +55,17 @@
;; Legacy function: update both x and y by velocities
(define (apply-velocity entity)
"Legacy function: update both x and y by velocities."
- (let ((x (entity-ref entity #:x 0))
- (y (entity-ref entity #:y 0))
- (vx (entity-ref entity #:vx 0))
- (vy (entity-ref entity #:vy 0)))
- (entity-set (entity-set entity #:x (+ x vx)) #:y (+ y vy))))
+ (let* ((x (entity-ref entity #:x 0))
+ (y (entity-ref entity #:y 0))
+ (vx (entity-ref entity #:vx 0))
+ (vy (entity-ref entity #:vy 0))
+ (e (if (downstroke-entity#entity-skips-pipeline? entity 'velocity-x)
+ entity
+ (entity-set entity #:x (+ x vx))))
+ (e (if (downstroke-entity#entity-skips-pipeline? entity 'velocity-y)
+ e
+ (entity-set e #:y (+ (entity-ref e #:y 0) vy)))))
+ e))
;; Build list of (col . row) pairs to check for collisions
(define (build-cell-list col-start col-end row-start row-end)
@@ -110,21 +125,21 @@
(entity-tile-cells entity tilemap)))))
;; Resolve horizontal collisions with solid tiles
- (define (resolve-tile-collisions-x entity tilemap)
+ (define-pipeline (resolve-tile-collisions-x tile-collisions-x) (entity tilemap)
(let ((w (entity-ref entity #:width 0))
(tw (tilemap-tilewidth tilemap)))
(resolve-tile-collisions-axis entity tilemap #:vx #:x
(lambda (v col row) (tile-push-pos v col tw w)))))
;; Resolve vertical collisions with solid tiles
- (define (resolve-tile-collisions-y entity tilemap)
+ (define-pipeline (resolve-tile-collisions-y tile-collisions-y) (entity tilemap)
(let ((h (entity-ref entity #:height 0))
(th (tilemap-tileheight tilemap)))
(resolve-tile-collisions-axis entity tilemap #:vy #:y
(lambda (v col row) (tile-push-pos v row th h)))))
;; Detect if entity is standing on ground by probing 1px below feet
- (define (detect-ground entity tilemap)
+ (define-pipeline (detect-ground ground-detection) (entity tilemap)
(if (not (entity-ref entity #:gravity? #f))
entity
(let* ((x (entity-ref entity #:x 0))
@@ -140,8 +155,7 @@
(entity-set entity #:on-ground? on-ground?))))
;; Set vertical acceleration for jump (consumed next frame by apply-acceleration)
- (define (apply-jump entity jump-pressed?)
- "Set #:ay to jump force if jump pressed and entity is on ground."
+ (define-pipeline (apply-jump jump) (entity jump-pressed?)
(if (and jump-pressed? (entity-ref entity #:on-ground? #f))
(entity-set entity #:ay (- (entity-ref entity #:jump-force *jump-force*)))
entity))
@@ -215,7 +229,9 @@
;; Resolve AABB collision between two solid entities.
;; Returns (a2 . b2) with positions/velocities adjusted, or #f if no collision.
(define (resolve-pair a b)
- (and (entity-ref a #:solid? #f)
+ (and (not (downstroke-entity#entity-skips-pipeline? a 'entity-collisions))
+ (not (downstroke-entity#entity-skips-pipeline? b 'entity-collisions))
+ (entity-ref a #:solid? #f)
(entity-ref b #:solid? #f)
(aabb-overlap? (entity-ref a #:x 0) (entity-ref a #:y 0)
(entity-ref a #:width 0) (entity-ref a #:height 0)
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
index 5df8e76..988d1c9 100644
--- a/tests/entity-test.scm
+++ b/tests/entity-test.scm
@@ -113,4 +113,23 @@
(test-equal "right dvx" 2 (car (cdr (assq 'right imap))))
(test-equal "right dvy" 0 (cdr (cdr (assq 'right imap))))))
+(test-group "entity-skips-pipeline?"
+ (test-assert "absent skip list"
+ (not (entity-skips-pipeline? '(#:type a) 'gravity)))
+ (test-assert "empty skip list"
+ (not (entity-skips-pipeline? '(#:skip-pipelines ()) 'gravity)))
+ (test-assert "member"
+ (entity-skips-pipeline? '(#:skip-pipelines (gravity velocity-x)) 'gravity))
+ (test-assert "not member"
+ (not (entity-skips-pipeline? '(#:skip-pipelines (gravity)) 'velocity-x))))
+
+(define-pipeline (fixture-pipeline fixture-skip) (ent)
+ (entity-set ent #:x 42))
+
+(test-group "define-pipeline"
+ (let ((e '(#:type t #:x 0)))
+ (test-equal "runs body" 42 (entity-ref (fixture-pipeline e) #:x)))
+ (let ((e '(#:type t #:x 0 #:skip-pipelines (fixture-skip))))
+ (test-equal "skipped" 0 (entity-ref (fixture-pipeline e) #:x))))
+
(test-end "entity")
diff --git a/tests/physics-test.scm b/tests/physics-test.scm
index 67c8377..b40f8d1 100644
--- a/tests/physics-test.scm
+++ b/tests/physics-test.scm
@@ -592,6 +592,26 @@
(test-equal "a pushed up" -3 (entity-ref (car result) #:y 0))
(test-equal "b pushed down" 13 (entity-ref (cdr result) #:y 0)))))
+(test-group "skip-pipelines"
+ (test-group "apply-gravity"
+ (let* ((e '(#:type t #:vy 0 #:gravity? #t #:skip-pipelines (gravity)))
+ (r (apply-gravity e)))
+ (test-equal "skipped: vy unchanged" 0 (entity-ref r #:vy))))
+ (test-group "apply-velocity-x"
+ (let* ((e '(#:type t #:x 10 #:vx 5 #:skip-pipelines (velocity-x)))
+ (r (apply-velocity-x e)))
+ (test-equal "skipped: x unchanged" 10 (entity-ref r #:x))))
+ (test-group "apply-jump"
+ (let* ((e '(#:type t #:on-ground? #t #:skip-pipelines (jump)))
+ (r (apply-jump e #t)))
+ (test-assert "skipped: no ay" (not (memq #:ay r)))))
+ (test-group "resolve-pair with entity-collisions skip"
+ (define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t))
+ (let* ((a (list #:type 'ghost #:x 0 #:y 0 #:width 16 #:height 16 #:solid? #t
+ #:skip-pipelines '(entity-collisions)))
+ (b (make-solid 10 0)))
+ (test-assert "no resolution" (not (resolve-pair a b))))))
+
(test-group "resolve-pair"
(define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t))
diff --git a/tests/renderer-test.scm b/tests/renderer-test.scm
index 1a8f7df..8ebeedf 100644
--- a/tests/renderer-test.scm
+++ b/tests/renderer-test.scm
@@ -266,4 +266,32 @@
(test-assert "does not crash with full scene"
(begin (render-debug-scene! renderer scene) #t)))))
+(test-group "scene-entities must be plists"
+ (let* ((cam (make-camera x: 0 y: 0))
+ (tileset (make-tileset tilewidth: 16 tileheight: 16
+ spacing: 0 tilecount: 100 columns: 10
+ image-source: "" image: #f))
+ (layer (make-layer name: "ground" width: 1 height: 1 map: '((0))))
+ (tilemap (make-tilemap width: 1 height: 1 tilewidth: 16 tileheight: 16
+ tileset-source: "" tileset: tileset
+ layers: (list layer) objects: '()))
+ (tex 'mock-texture)
+ (entity (list #:type 'box #:x 10 #:y 20 #:width 16 #:height 16 #:tile-id 1))
+ (cell (vector entity 'extra-data 0 100 'linear #t))
+ (scene-ok (make-scene entities: (list entity)
+ tilemap: tilemap camera: cam
+ tileset-texture: tex camera-target: #f))
+ (scene-bad (make-scene entities: (list cell)
+ tilemap: tilemap camera: cam
+ tileset-texture: tex camera-target: #f)))
+ (test-assert "render-scene! works with plist entities"
+ (begin (render-scene! #f scene-ok) #t))
+ (test-error "render-scene! errors when entity list contains a vector"
+ #t (render-scene! #f scene-bad))
+ (test-assert "extracting entity from cell vector fixes the issue"
+ (let ((scene-fixed (make-scene entities: (list (vector-ref cell 0))
+ tilemap: tilemap camera: cam
+ tileset-texture: tex camera-target: #f)))
+ (begin (render-scene! #f scene-fixed) #t)))))
+
(test-end "renderer")
diff --git a/tests/tween-test.scm b/tests/tween-test.scm
new file mode 100644
index 0000000..ebe62e0
--- /dev/null
+++ b/tests/tween-test.scm
@@ -0,0 +1,82 @@
+(import srfi-64
+ (chicken base))
+(include "entity.scm")
+(include "tween.scm")
+(import downstroke-entity downstroke-tween)
+
+(test-begin "tween")
+
+(test-group "ease functions"
+ (test-equal "linear mid" 0.5 (ease-linear 0.5))
+ (test-equal "quad-in mid" 0.25 (ease-quad-in 0.5))
+ (test-equal "quad-out mid" 0.75 (ease-quad-out 0.5))
+ (test-equal "quad-in-out mid" 0.5 (ease-quad-in-out 0.5))
+ (test-equal "cubic-in mid" 0.125 (ease-cubic-in 0.5))
+ (test-assert "sine-in-out endpoints"
+ (and (= 0.0 (ease-sine-in-out 0)) (= 1.0 (ease-sine-in-out 1))))
+ (test-equal "expo-in at 0" 0.0 (ease-expo-in 0))
+ (test-equal "expo-out at 1" 1.0 (ease-expo-out 1))
+ (test-equal "expo-in-out mid" 0.5 (ease-expo-in-out 0.5))
+ (test-equal "cubic-in-out mid" 0.5 (ease-cubic-in-out 0.5))
+ (test-equal "cubic-out mid" 0.875 (ease-cubic-out 0.5))
+ (test-assert "cubic-in-out stays in [0,1]"
+ (let loop ((i 0) (ok #t))
+ (if (> i 100) ok
+ (let* ((t (/ i 100))
+ (v (ease-cubic-in-out t)))
+ (loop (+ i 1) (and ok (>= v 0) (<= v 1))))))))
+
+(test-group "ease-named"
+ (test-equal "quad-in-out proc" ease-quad-in-out (ease-named 'quad-in-out)))
+
+(test-group "ease-resolve"
+ (test-equal "symbol" ease-cubic-out (ease-resolve 'cubic-out))
+ (test-equal "procedure passthrough" ease-linear (ease-resolve ease-linear)))
+
+(test-group "make-tween / tween-step"
+ (test-group "linear completes to target"
+ (let* ((ent (list #:type 'a #:x 0 #:y 10))
+ (tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
+ (receive (tw2 e2) (tween-step tw ent 100)
+ (test-assert "finished" (tween-finished? tw2))
+ (test-equal "x at end" 100.0 (entity-ref e2 #:x))
+ (test-equal "y preserved" 10 (entity-ref e2 #:y)))))
+
+ (test-group "delay holds props"
+ (let* ((ent (list #:type 'a #:x 0))
+ (tw (make-tween ent props: '((#:x . 50)) duration: 100 delay: 40 ease: 'linear)))
+ (receive (tw2 e2) (tween-step tw ent 30)
+ (test-assert "not finished" (not (tween-finished? tw2)))
+ (test-equal "x unchanged during delay" 0 (entity-ref e2 #:x))
+ (receive (tw3 e3) (tween-step tw2 e2 9)
+ (test-assert "still in delay at 39ms" (not (tween-finished? tw3)))
+ (test-equal "x still 0" 0 (entity-ref e3 #:x))
+ (receive (_tw4 e4) (tween-step tw3 e3 50)
+ (test-assert "past delay, moved" (> (entity-ref e4 #:x) 0)))))))
+
+ (test-group "midpoint linear"
+ (let* ((ent (list #:type 'a #:x 0))
+ (tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
+ (receive (_ e2) (tween-step tw ent 50)
+ (test-equal "halfway x" 50.0 (entity-ref e2 #:x)))))
+
+ (test-group "on-complete runs once"
+ (let ((calls 0))
+ (let* ((ent (list #:type 'a #:x 0))
+ (tw (make-tween ent props: '((#:x . 10)) duration: 10 delay: 0 ease: 'linear
+ on-complete: (lambda (_) (set! calls (+ calls 1))))))
+ (receive (tw2 e2) (tween-step tw ent 10)
+ (test-equal "one call" 1 calls)
+ (receive (tw3 e3) (tween-step tw2 e2 5)
+ (test-equal "still one call" 1 calls)
+ (test-equal "entity stable" e3 e2))))))
+
+ (test-group "idempotent after finish"
+ (let* ((ent (list #:type 'a #:x 0))
+ (tw (make-tween ent props: '((#:x . 20)) duration: 10 delay: 0 ease: 'linear)))
+ (receive (tw2 e2) (tween-step tw ent 10)
+ (receive (tw3 e3) (tween-step tw2 e2 999)
+ (test-assert (tween-finished? tw3))
+ (test-equal "x stays" 20.0 (entity-ref e3 #:x)))))))
+
+(test-end "tween")
diff --git a/tween.scm b/tween.scm
new file mode 100644
index 0000000..eb8abc3
--- /dev/null
+++ b/tween.scm
@@ -0,0 +1,168 @@
+(module downstroke-tween *
+ (import scheme
+ (chicken base)
+ (chicken keyword)
+ (only srfi-1 fold)
+ defstruct
+ downstroke-entity)
+
+ ;; ── Easing: t in [0,1] → eased factor in [0,1] for linear interpolation ──
+
+ (define (ease-linear t) t)
+
+ (define (ease-quad-in t) (* t t))
+
+ (define (ease-quad-out t)
+ (- 1 (* (- 1 t) (- 1 t))))
+
+ (define (ease-quad-in-out t)
+ (if (< t 0.5)
+ (* 2 t t)
+ (- 1 (* 2 (- 1 t) (- 1 t)))))
+
+ (define (ease-cubic-in t) (* t t t))
+
+ (define (ease-cubic-out t)
+ (- 1 (expt (- 1 t) 3)))
+
+ (define (ease-cubic-in-out t)
+ (if (< t 0.5)
+ (* 4 t t t)
+ (- 1.0 (/ (expt (- 2 (* 2 t)) 3) 2))))
+
+ (define (ease-sine-in-out t)
+ (- 0.5 (* 0.5 (cos (* 3.14159265358979323846 t)))))
+
+ (define (ease-expo-in t)
+ (if (zero? t) 0.0 (expt 2 (* 10 (- t 1)))))
+
+ (define (ease-expo-out t)
+ (if (>= t 1) 1.0 (- 1.0 (expt 2 (* -10 t)))))
+
+ (define (ease-expo-in-out t)
+ (cond ((<= t 0) 0.0)
+ ((>= t 1) 1.0)
+ ((< t 0.5) (/ (expt 2 (- (* 20 t) 10)) 2))
+ (else (- 1 (/ (expt 2 (+ (* -20 t) 10)) 2)))))
+
+ ;; Overshoots past 1 then settles (Robert Penner back-out, s ≈ 1.70158)
+ (define (ease-back-out t)
+ (let ((s 1.70158)
+ (u (- t 1)))
+ (+ 1 (* (+ 1 s) (expt u 3)) (* s (expt u 2)))))
+
+ ;; ── Symbol → ease procedure ───────────────────────────────────────────────
+
+ (define *ease-table*
+ `((linear . ,ease-linear)
+ (quad-in . ,ease-quad-in)
+ (quad-out . ,ease-quad-out)
+ (quad-in-out . ,ease-quad-in-out)
+ (cubic-in . ,ease-cubic-in)
+ (cubic-out . ,ease-cubic-out)
+ (cubic-in-out . ,ease-cubic-in-out)
+ (sine-in-out . ,ease-sine-in-out)
+ (expo-in . ,ease-expo-in)
+ (expo-out . ,ease-expo-out)
+ (expo-in-out . ,ease-expo-in-out)
+ (back-out . ,ease-back-out)))
+
+ (define (ease-named sym)
+ (cond ((assq sym *ease-table*) => cdr)
+ (else (error "ease-named: unknown ease symbol" sym))))
+
+ (define (ease-resolve ease)
+ (cond ((procedure? ease) ease)
+ ((symbol? ease) (ease-named ease))
+ (else (error "ease-resolve: expected symbol or procedure" ease))))
+
+ ;; ── Tween struct (internal) ───────────────────────────────────────────────
+
+ (defstruct tw
+ starts ;; alist: (key . start-num)
+ ends ;; alist: (key . end-num)
+ duration ;; ms, > 0
+ delay ;; ms, >= 0
+ ease-fn ;; number → number
+ elapsed ;; ms since tween started (includes delay period)
+ done? ;; boolean
+ callback) ;; (entity → unspecified) or #f; invoked once at completion
+
+ ;; ── Public API ────────────────────────────────────────────────────────────
+
+ (define (tween-finished? t) (tw-done? t))
+
+ (define (tween-active? t) (not (tw-done? t)))
+
+ ;; props: alist of (keyword . target-number), e.g. ((#:x . 200) (#:y . 40))
+ (define (make-tween entity #!key props (duration 500) (delay 0) (ease 'linear)
+ (on-complete #f))
+ (unless (and (integer? duration) (> duration 0))
+ (error "make-tween: duration must be a positive integer (ms)" duration))
+ (unless (and (integer? delay) (>= delay 0))
+ (error "make-tween: delay must be a non-negative integer (ms)" delay))
+ (unless (pair? props)
+ (error "make-tween: props must be a non-empty alist" props))
+ (let ((ease-fn (ease-resolve ease))
+ (starts (map (lambda (p)
+ (let ((k (car p)))
+ (unless (keyword? k)
+ (error "make-tween: property keys must be keywords" k))
+ (cons k (entity-ref entity k 0))))
+ props)))
+ (make-tw starts: starts
+ ends: props
+ duration: duration
+ delay: delay
+ ease-fn: ease-fn
+ elapsed: 0
+ done?: #f
+ callback: on-complete)))
+
+ ;; Linear interpolation with eased factor u in [0,1]
+ (define (lerp a b u)
+ (+ a (* (- b a) u)))
+
+ (define (apply-props entity starts ends u)
+ (fold (lambda (end-pair ent)
+ (let* ((k (car end-pair))
+ (end (cdr end-pair))
+ (start (cdr (assq k starts))))
+ (entity-set ent k (lerp start end u))))
+ entity
+ ends))
+
+ (define (tween-step tw entity dt)
+ (unless (tw? tw) (error "tween-step: expected tween struct" tw))
+ (if (tw-done? tw)
+ (values tw entity)
+ (let* ((elapsed (+ (tw-elapsed tw) dt))
+ (delay (tw-delay tw))
+ (duration (tw-duration tw))
+ (ease-fn (tw-ease-fn tw))
+ (starts (tw-starts tw))
+ (ends (tw-ends tw)))
+ (cond ((< elapsed delay)
+ (values (make-tw starts: starts ends: ends duration: duration
+ delay: delay ease-fn: ease-fn
+ elapsed: elapsed done?: #f callback: (tw-callback tw))
+ entity))
+ (else
+ (let* ((t0 (- elapsed delay))
+ (u-raw (/ t0 duration))
+ (u (min 1.0 (max 0.0 u-raw)))
+ (eased (ease-fn u))
+ (ent2 (apply-props entity starts ends eased)))
+ (if (>= u 1.0)
+ (let* ((final (apply-props entity starts ends 1.0))
+ (cb (tw-callback tw))
+ (_ (when cb (cb final)))
+ (tw2 (make-tw starts: starts ends: ends duration: duration
+ delay: delay ease-fn: ease-fn
+ elapsed: elapsed done?: #t callback: #f)))
+ (values tw2 final))
+ (values (make-tw starts: starts ends: ends duration: duration
+ delay: delay ease-fn: ease-fn
+ elapsed: elapsed done?: #f callback: (tw-callback tw))
+ ent2))))))))
+) ;; end module