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
[@@@warning "-32-34-37-69"]
type state = {
origin : float;
mutable prev_tick : float;
mutable cur_tick : float;
}
type t = {dt : unit -> float; now : unit -> float; elapsed : unit -> float}
let key : t Capability.key = Capability.create ~name:"Clock"
let set v = Capability.set key v
let get () = Capability.get key
let require () = Capability.require key
let create_state () =
let now = Unix.gettimeofday () in
{origin = now; prev_tick = now; cur_tick = now}
let register (s : state) =
let cap : t =
{
dt = (fun () -> s.cur_tick -. s.prev_tick);
now = (fun () -> s.cur_tick);
elapsed = (fun () -> s.cur_tick -. s.origin);
}
in
set cap
let tick (s : state) =
let now = Unix.gettimeofday () in
s.prev_tick <- s.cur_tick ;
s.cur_tick <- now