blob: 1e19a4b621c2830e9a5d50155be906b159cf5d59 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
(import test
(chicken base))
(include "entity.scm")
(include "tween.scm")
(import (downstroke entity) (downstroke tween))
(import (only (list-utils alist) plist->alist))
;; Test helper: build an alist entity from plist-style keyword args.
(define (entity . kws) (plist->alist kws))
(test-begin "tween")
(test-group "ease functions"
(test "linear mid" 0.5 (ease-linear 0.5))
(test "quad-in mid" 0.25 (ease-quad-in 0.5))
(test "quad-out mid" 0.75 (ease-quad-out 0.5))
(test "quad-in-out mid" 0.5 (ease-quad-in-out 0.5))
(test "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 "expo-in at 0" 0.0 (ease-expo-in 0))
(test "expo-out at 1" 1.0 (ease-expo-out 1))
(test "expo-in-out mid" 0.5 (ease-expo-in-out 0.5))
(test "cubic-in-out mid" 0.5 (ease-cubic-in-out 0.5))
(test "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 "quad-in-out proc" ease-quad-in-out (ease-named 'quad-in-out)))
(test-group "ease-resolve"
(test "symbol" ease-cubic-out (ease-resolve 'cubic-out))
(test "procedure passthrough" ease-linear (ease-resolve ease-linear)))
(test-group "make-tween / tween-step"
(test-group "linear completes to target"
(let* ((ent (entity #: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 "x at end" 100.0 (entity-ref e2 #:x))
(test "y preserved" 10 (entity-ref e2 #:y)))))
(test-group "delay holds props"
(let* ((ent (entity #: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 "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 "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 (entity #: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 "halfway x" 50.0 (entity-ref e2 #:x)))))
(test-group "on-complete runs once"
(let ((calls 0))
(let* ((ent (entity #: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 "one call" 1 (begin calls))
(receive (tw3 e3) (tween-step tw2 e2 5)
(test "still one call" 1 (begin calls))
(test "entity stable" e3 (begin e2)))))))
(test-group "idempotent after finish"
(let* ((ent (entity #: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 "x stays" 20.0 (entity-ref e3 #:x)))))))
(test-group "repeat"
(test-group "repeat: 1 plays twice"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 1)))
(receive (tw2 e2) (tween-step tw ent 100)
(test-assert "not finished after first play" (not (tween-finished? tw2)))
(test "x at target" 100.0 (entity-ref e2 #:x))
(receive (tw3 e3) (tween-step tw2 e2 100)
(test-assert "finished after second play" (tween-finished? tw3))
(test "x at target again" 100.0 (entity-ref e3 #:x))))))
(test-group "repeat: -1 never finishes"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 10)) duration: 10
ease: 'linear repeat: -1)))
(let loop ((tw tw) (ent ent) (i 0))
(if (>= i 5) (test-assert "still active after 5 cycles" (tween-active? tw))
(receive (tw2 e2) (tween-step tw ent 10)
(test-assert "not finished" (not (tween-finished? tw2)))
(loop tw2 e2 (+ i 1)))))))
(test-group "repeat: 0 is default (no repeat)"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 50)) duration: 50 ease: 'linear)))
(receive (tw2 _e2) (tween-step tw ent 50)
(test-assert "finished immediately" (tween-finished? tw2)))))
(test-group "on-complete fires after last repeat"
(let ((calls 0))
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 10)) duration: 10
ease: 'linear repeat: 1
on-complete: (lambda (_) (set! calls (+ calls 1))))))
(receive (tw2 e2) (tween-step tw ent 10)
(test "no call after first play" 0 (begin calls))
(receive (tw3 e3) (tween-step tw2 e2 10)
(test "one call after last repeat" 1 (begin calls)))))))
(test-group "on-complete does not fire with repeat: -1"
(let ((calls 0))
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 10)) duration: 10
ease: 'linear repeat: -1
on-complete: (lambda (_) (set! calls (+ calls 1))))))
(let loop ((tw tw) (ent ent) (i 0))
(if (>= i 5) (test "never called" 0 (begin calls))
(receive (tw2 e2) (tween-step tw ent 10)
(loop tw2 e2 (+ i 1)))))))))
(test-group "yoyo"
(test-group "yoyo: #t with repeat: 1 reverses"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 1 yoyo?: #t)))
(receive (tw2 e2) (tween-step tw ent 100)
(test "x at target after forward" 100.0 (entity-ref e2 #:x))
(receive (tw3 e3) (tween-step tw2 e2 50)
(test "x halfway back" 50.0 (entity-ref e3 #:x))
(receive (tw4 e4) (tween-step tw3 e3 50)
(test-assert "finished after reverse" (tween-finished? tw4))
(test "x back to start" 0.0 (entity-ref e4 #:x)))))))
(test-group "yoyo: #t with repeat: -1 ping-pongs forever"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: -1 yoyo?: #t)))
;; Forward
(receive (tw2 e2) (tween-step tw ent 100)
(test "at target" 100.0 (entity-ref e2 #:x))
;; Reverse
(receive (tw3 e3) (tween-step tw2 e2 100)
(test "back to start" 0.0 (entity-ref e3 #:x))
;; Forward again
(receive (tw4 e4) (tween-step tw3 e3 100)
(test "at target again" 100.0 (entity-ref e4 #:x))
(test-assert "still active" (tween-active? tw4)))))))
(test-group "yoyo: #f with repeat: 1 replays same direction"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 1 yoyo?: #f)))
(receive (tw2 e2) (tween-step tw ent 100)
(test "x at target" 100.0 (entity-ref e2 #:x))
;; Second play starts from same starts (0→100), but entity is at 100
;; The tween replays 0→100 using original start values
(receive (tw3 e3) (tween-step tw2 e2 50)
(test-assert "not finished mid-repeat" (not (tween-finished? tw3)))))))
(test-group "yoyo: #t without repeat has no effect"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 0 yoyo?: #t)))
(receive (tw2 e2) (tween-step tw ent 100)
(test-assert "finishes normally" (tween-finished? tw2))
(test "x at target" 100.0 (entity-ref e2 #:x))))))
(test-group "step-tweens pipeline"
(test-group "advances #:tween on entity"
(let* ((ent (entity #:type 'a #:x 0
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 50)))
(test "x moved to midpoint" 50.0 (entity-ref e2 #:x))
(test-assert "tween still attached" (entity-ref e2 #:tween #f))))
(test-group "removes #:tween when finished"
(let* ((ent (entity #:type 'a #:x 0
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 100)))
(test "x at target" 100.0 (entity-ref e2 #:x))
(test "tween removed" #f (entity-ref e2 #:tween #f))))
(test-group "no-op without #:tween"
(let* ((ent (entity #:type 'a #:x 42))
(e2 (step-tweens #f ent 100)))
(test "x unchanged" 42 (entity-ref e2 #:x))))
(test-group "keeps repeating tween attached"
(let* ((ent (entity #:type 'a #:x 0
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear repeat: -1 yoyo?: #t)))
(e2 (step-tweens #f ent 100)))
(test "x at target" 100.0 (entity-ref e2 #:x))
(test-assert "tween still attached (repeating)" (entity-ref e2 #:tween #f))))
(test-group "respects #:skip-pipelines"
(let* ((ent (entity #:type 'a #:x 0
#:skip-pipelines '(tweens)
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 100)))
(test "x unchanged (skipped)" 0 (entity-ref e2 #:x))
(test-assert "tween still there" (entity-ref e2 #:tween #f)))))
(test-end "tween")
(test-exit)
|
