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
|
module Geom = struct
type t = {
mutable x: int;
mutable y: int;
mutable w: int;
mutable h: int;
}
let null () =
{ x = 0; y = 0; w = 0; h = 0 }
let record (x,y,w,h) g =
g.x <- x;
g.y <- y;
g.w <- w;
g.h <- h
end
module State = struct
type t = bool * bool * bool
(* focus, selected, sensitive *)
let normal : t = (false, false, true)
let to_int (f,s,a) =
if a then (if f then 1 else if s then 2 else 0) else 3
let to_int_max = 3
let set_focus (_,s,a) f = (f,s,a)
let set_selected (f,_,a) s = (f,s,a)
let set_sensitive (f,s,_) a = (f,s,a)
let has_focus (f,_,_) = f
let is_selected (_,s,_) = s
let is_sensitive (_,_,a) = a
end
module Direction = struct
type t =
| Previous
| Next
| Left
| Right
| Up
| Down
end
module Class = struct
type t = {
name : string;
parents : t list
}
let all_classes = Hashtbl.create 127
let create n p =
let c = { name = n; parents = p } in
Hashtbl.add all_classes n c;
c
let get = Hashtbl.find all_classes
let rec is_a p c =
(c == p) ||
(List.exists (is_a p) c.parents)
end
module Toplevel = struct
type t =
| Activate
| Desactivate
| Key of int
type 'w m =
| Give_focus of 'w
end
module Cache = struct
type 'a t = 'a Weak.t * (unit -> 'a)
let create f =
let t = Weak.create 1 in
((t,f) : _ t)
let get ((t,f) : _ t) =
match Weak.get t 0 with
| Some v -> v
| None ->
let v = f () in
Weak.set t 0 (Some v);
v
let clear ((t,_) : _ t) =
Weak.set t 0 None
end
module Once = struct
type t = {
mutable already: bool;
queue: (unit -> unit) Queue.t;
func: (unit -> unit)
}
let create q =
{ already = true; queue = q; func = ignore }
let deliver o () =
()
let add o f =
if not o.already then (
o.already <- true;
Queue.add (deliver o) o.queue
)
end
|
