Added tweens

1 files changed, 82 insertions, 0 deletions

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")