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
|
(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
|
