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
type tween_node =
{
start_val: float;
end_val: float;
ease_func: float -> float;
mutable progress: float;
repeat: int;
mutable cur_repeat: int;
duration: float;
obj: float ref;
mutable callback : unit -> unit;
}
type tween = Node of tween_node
| Nested of {
tween_left: tween;
tween_right: tween;
repeat: int;
mutable cur_repeat : int;
mutable callback: unit -> unit
}
type tween_manager = tween list ref
let make_tween_node (obj: float ref) ?(sv: float = !obj) (ev: float) ?(ef: float -> float = (fun x -> x)) (d: float) = {
start_val = sv;
end_val = ev;
progress = 0.0;
ease_func = ef;
obj = obj;
repeat = 1;
cur_repeat = 0;
duration = d;
callback = fun () -> ();
}
let make_tween (obj: float ref) ?(sv: float = !obj) (ev: float) ?(ef: float -> float = (fun x -> x)) (d: float) : tween =
let tween_node = make_tween_node obj ~sv:sv ev ~ef:ef d in
Node tween_node
let repeat (t: tween) (count: int) = match t with
| Node t -> Node {
repeat = count;
cur_repeat = 0;
start_val = t.start_val;
end_val = t.end_val;
ease_func = t.ease_func;
progress = 0.0;
duration = t.duration;
obj = t.obj;
callback = t.callback;
}
| Nested t -> Nested {
repeat = count;
cur_repeat = 0;
tween_left = t.tween_left;
tween_right = t.tween_right;
callback = t.callback;
}
let should_restart_node (tn: tween_node) =
tn.progress >= 1.0 && (tn.cur_repeat < tn.repeat - 1 || tn.repeat = -1)
let node_finished (tn: tween_node) = tn.progress >= 1.0
&& tn.cur_repeat = tn.repeat - 1
let update_node (node: tween_node) (dt: float) : unit =
match should_restart_node node with
| true -> node.progress <- 0.0;
node.cur_repeat <- node.cur_repeat + 1;
node.obj := node.start_val;
if node_finished node then node.callback () else ()
| false -> let dur = node.duration in
let p = node.ease_func (node.progress +. (dt /. dur)) in
let sv = node.start_val in
let ev = node.end_val in
node.progress <- node.progress +. (dt /. dur);
node.obj := (1.0 -. p) *. sv +. p *. ev;
if node_finished node then node.callback () else ()
let rec reset_tween (t: tween) = match t with
| Node t -> t.cur_repeat <- 0;
t.progress <- 0.0;
| Nested t -> t.cur_repeat <- 0;
reset_tween t.tween_left;
reset_tween t.tween_right
let rec is_finished (t: tween) : bool = match t with
| Node t -> node_finished t
| Nested t -> (t.cur_repeat = t.repeat && t.repeat <> ~-1)
&& is_finished t.tween_right
let rec update_tween (t: tween) (dt: float) : unit = match t with
| Node t -> update_node t dt
| Nested t -> if not (is_finished t.tween_left) then
update_tween t.tween_left dt
else if not (is_finished t.tween_right) then
update_tween t.tween_right dt
else if (t.cur_repeat < t.repeat - 1 || t.repeat = -1) then begin
t.cur_repeat <- t.cur_repeat + 1;
reset_tween (Nested t)
end
else t.callback ()
let extend (t1: tween) (t2: tween) =
Nested {
tween_left = t1;
tween_right = t2;
repeat = 1;
cur_repeat = 0;
callback = fun () -> ()
}
let ( $> ) = extend
let dummy = ref 0.0
let empty_tween =
{
start_val = 0.0;
end_val = 0.0;
ease_func = (fun x -> x);
progress = 0.0;
repeat = 1;
cur_repeat = 0;
duration = 0.0;
obj = dummy;
callback = (fun () -> ());
}
let rec combine (tweens: tween list) : tween = match tweens with
| [] -> Node empty_tween
| [a] -> a
| h::t -> Nested {
tween_left = h;
tween_right = combine t;
repeat = 1;
cur_repeat = 0;
callback = fun () -> ();
}
let set_callback (t: tween) (f: unit -> unit) = match t with
| Node t -> t.callback <- f
| Nested t -> t.callback <- f
let ( $+ ) = set_callback
let update (tm: tween_manager) (dt: float) : unit =
List.iter (fun x -> update_tween x dt) !tm;
tm := List.filter (fun x -> not (is_finished x)) !tm
let new_manager () : tween_manager = ref []
let add (t: tween) (tm: tween_manager) : unit =
tm := !tm @ [t]