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
type 'a item = {
what : 'a;
row : int;
col : int;
rowspan : int;
colspan : int;
sticky : string;
size : float * float;
}
type 'a t = {
items : 'a item list;
gap : float;
widths : float list;
heights : float list;
col_weights : (int * float) list;
row_weights : (int * float) list;
}
let item ?(rowspan = 1) ?(colspan = 1) ?(sticky = "") ~row ~col what size =
{ what; row; col; rowspan = max 1 rowspan; colspan = max 1 colspan; sticky; size }
let nth l i = match List.nth_opt l i with Some x -> x | None -> 0.
let sum l = List.fold_left ( +. ) 0. l
let set_nth l i v = List.mapi (fun j x -> if j = i then v else x) l
let tracks ~gap ~count ~span ~start ~extent items =
let sizes = ref (List.init count (fun _ -> 0.)) in
items
|> List.iter (fun it ->
if span it = 1 then sizes := set_nth !sizes (start it) (max (nth !sizes (start it)) (extent it)));
items
|> List.iter (fun it ->
if span it > 1 then begin
let first = start it and n = span it in
let covered = ref 0. in
for i = first to first + n - 1 do
covered := !covered +. nth !sizes i
done;
let with_gaps = !covered +. (gap *. float_of_int (n - 1)) in
if with_gaps < extent it then
let last = first + n - 1 in
sizes := set_nth !sizes last (nth !sizes last +. (extent it -. with_gaps))
end);
!sizes
let make ?(gap = 0.) ?(row_weights = []) ?(col_weights = []) items =
let cols = List.fold_left (fun n it -> max n (it.col + it.colspan)) 0 items in
let rows_ = List.fold_left (fun n it -> max n (it.row + it.rowspan)) 0 items in
let widths =
tracks ~gap ~count:cols ~span:(fun it -> it.colspan) ~start:(fun it -> it.col)
~extent:(fun it -> fst it.size) items
in
let heights =
tracks ~gap ~count:rows_ ~span:(fun it -> it.rowspan) ~start:(fun it -> it.row)
~extent:(fun it -> snd it.size) items
in
{ items; gap; widths; heights; col_weights; row_weights }
let extent gap sizes = sum sizes +. (gap *. float_of_int (max 0 (List.length sizes - 1)))
let measure t = (extent t.gap t.widths, extent t.gap t.heights)
let columns t = t.widths
let rows t = t.heights
let grown sizes weights room =
let total = List.fold_left (fun acc (_, w) -> acc +. w) 0. weights in
if total <= 0. || room <= 0. then sizes
else List.mapi (fun i s -> match List.assoc_opt i weights with
| Some w -> s +. (room *. w /. total)
| None -> s) sizes
let starts gap sizes from =
let _, out =
List.fold_left (fun (x, acc) s -> (x +. s +. gap, (x, s) :: acc)) (from, []) sizes
in
List.rev out
let arrange (b : Widget.box) t =
let widths = grown t.widths t.col_weights (b.w -. fst (measure t)) in
let heights = grown t.heights t.row_weights (b.h -. snd (measure t)) in
let w = extent t.gap widths and h = extent t.gap heights in
let left = b.x -. (w /. 2.) and top = b.y +. (h /. 2.) in
let xs = starts t.gap widths left in
let ys = starts t.gap heights (-.top) in
t.items
|> List.map (fun it ->
let x0, _ = List.nth xs it.col in
let y0, _ = List.nth ys it.row in
let cw = ref 0. and ch = ref 0. in
for i = it.col to it.col + it.colspan - 1 do
cw := !cw +. nth widths i
done;
for i = it.row to it.row + it.rowspan - 1 do
ch := !ch +. nth heights i
done;
let cw = !cw +. (t.gap *. float_of_int (it.colspan - 1)) in
let ch = !ch +. (t.gap *. float_of_int (it.rowspan - 1)) in
let cell : Widget.box = { Widget.x = x0 +. (cw /. 2.); y = -.(y0 +. (ch /. 2.)); w = cw; h = ch } in
let has c = String.contains it.sticky c in
let width = if has 'e' && has 'w' then cw else min cw (fst it.size) in
let height = if has 'n' && has 's' then ch else min ch (snd it.size) in
let x =
if has 'w' && not (has 'e') then Widget.left cell +. (width /. 2.)
else if has 'e' && not (has 'w') then Widget.right cell -. (width /. 2.)
else cell.x
in
let y =
if has 'n' && not (has 's') then Widget.top cell -. (height /. 2.)
else if has 's' && not (has 'n') then Widget.bottom cell +. (height /. 2.)
else cell.y
in
(it.what, { Widget.x; y; w = width; h = height }))