Source file packer.ml
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
type t = {
min: int ;
max: int ;
mutable expand: int ;
mutable current: int;
mutable fixed: bool;
}
module type Elt = sig
type t
val to_string : t -> string
module Map : Map.S with type key = t
end
module Make (E:Elt) = struct
let init get_constraints get_expand children =
List.fold_left
(fun (parts, acc) elt ->
let t =
let expand = max 0 (get_expand elt) in
let (constraints : Widget.size_constraints) = get_constraints elt in
let min = constraints.min in
let max = match constraints.max_used with
| Some n -> n
| None -> Option.value ~default:max_int constraints.max_abs
in
{
min ; max ; expand ;
current = 0 ; fixed = false ;
}
in
(parts + t.expand, E.Map.add elt t acc)
)
(0, E.Map.empty) children
let fix elt t =
[%debug "Box.Box.r: fix %s at %d"
(E.to_string elt) t.current];
t.fixed <- true
let shrink_or_expand ~parts ~remain m =
let space_by_part = if parts = 0 then 0 else remain / parts in
let = ref
(if parts = 0 then 0 else ((abs remain) mod parts))
in
let bound t = if remain >= 0 then t.max else t.min in
let (incr_current, decr_remain) =
if remain >= 0
then ((+), (-))
else ((-), (+))
in
E.Map.fold (fun elt t (all_fixed, remainparts, remain) ->
if t.fixed then
(all_fixed, remainparts, remain)
else
(
let diff = space_by_part * t.expand in
let c = max t.min (min t.max (t.current + diff)) in
let remain = remain - c + t.current in
t.current <- c ;
if t.current = bound t && remain >= 0 then
(
fix elt t ;
(all_fixed, remainparts, remain)
)
else
(
if space_by_part = 0 && !extra_space <> 0 then
(
t.current <- incr_current t.current 1;
decr extra_space ;
let remain = decr_remain remain 1 in
if t.current = bound t then
( fix elt t ;
(all_fixed, remainparts, remain)
)
else
(false, remainparts + t.expand, remain)
)
else
(false, remainparts + t.expand, remain)
)
)
)
m (true, 0, remain)
let debug_m m =
E.Map.iter
(fun elt t ->
[%debug "%s: min=%d, max=%d, expand=%d, current=%d, fixed=%b"
(E.to_string elt)
t.min t.max t.expand t.current t.fixed]
) m
let compute_remain avail m = E.Map.fold
(fun _oid t (all_fixed, parts, remain) ->
let remain = remain - t.current in
if t.fixed then
(all_fixed, parts, remain)
else
(false, parts + t.expand, remain)
) m (true, 0, avail)
let compute avail get_contraints get_expand (children : E.t list) =
let (parts, m) = init get_contraints get_expand children in
let (all_fixed, parts, remain) = compute_remain avail m in
let rec iter loops all_fixed parts remain =
[%debug "Box.Box.r.compute: parts=%d, remain=%d" parts remain];
debug_m m;
if loops <= 0 || remain = 0 || (parts = 0 && all_fixed) then
m
else
let (all_fixed, parts, remain) = shrink_or_expand ~parts ~remain m in
iter (loops - 1) all_fixed parts remain
in
iter (max 10 (List.length children)) all_fixed parts remain
end