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
155
156
157
158
159
160
(** {1 Pretty-Printing of Boxes} *)
type position = { x:int ; y: int }
type view =
| Empty
| Text of string list
| Frame of t
| Pad of position * t
| Grid of [`Bars | `None] * t array array
| Tree of int * t * t array
and t = view
let empty = Empty
let[@inline] view (t:t) : view = t
let[@inline] line_ s = Text [s]
let line s =
if String.contains s '\n' then invalid_arg "PrintBox.line";
line_ s
let text s = Text [s]
let sprintf format =
let buffer = Buffer.create 64 in
Printf.kbprintf
(fun _ -> Text [Buffer.contents buffer])
buffer
format
let asprintf format =
Format.kasprintf (fun s -> Text [s]) format
let[@inline] lines l = Text l
let int x = line_ (string_of_int x)
let float x = line_ (string_of_float x)
let bool x = line_ (string_of_bool x)
let int_ = int
let float_ = float
let bool_ = bool
let[@inline] frame b = Frame b
let pad' ~col ~lines b =
assert (col >=0 || lines >= 0);
if col=0 && lines=0
then b
else Pad ({x=col;y=lines}, b)
let pad b = pad' ~col:1 ~lines:1 b
let hpad col b = pad' ~col ~lines:0 b
let vpad lines b = pad' ~col:0 ~lines b
let map_matrix f m =
Array.map (Array.map f) m
let grid ?(pad=fun b->b) ?(bars=true) m =
let m = map_matrix pad m in
Grid ((if bars then `Bars else `None), m)
let init_grid ?bars ~line ~col f =
let m = Array.init line (fun j-> Array.init col (fun i -> f ~line:j ~col:i)) in
grid ?bars m
let vlist ?pad ?bars l =
let a = Array.of_list l in
grid ?pad ?bars (Array.map (fun line -> [| line |]) a)
let hlist ?pad ?bars l =
grid ?pad ?bars [| Array.of_list l |]
let hlist_map ?bars f l = hlist ?bars (List.map f l)
let vlist_map ?bars f l = vlist ?bars (List.map f l)
let grid_map ?bars f m = grid ?bars (Array.map (Array.map f) m)
let grid_text ?(pad=fun x->x) ?bars m =
grid_map ?bars (fun x -> pad (text x)) m
let dim_matrix m =
if Array.length m = 0 then {x=0;y=0}
else {y=Array.length m; x=Array.length m.(0); }
let transpose m =
let dim = dim_matrix m in
Array.init dim.x
(fun i -> Array.init dim.y (fun j -> m.(j).(i)))
let tree ?(indent=1) node children =
if indent <= 0 then invalid_arg "tree: need strictly positive indent";
let children =
List.filter
(function
| Empty -> false
| _ -> true)
children
in
match children with
| [] -> node
| _::_ ->
let children = Array.of_list children in
Tree (indent, node, children)
let mk_tree ?indent f root =
let rec make x = match f x with
| b, [] -> b
| b, children -> tree ?indent b (List.map make children)
in
make root
(** {2 Simple Structural Interface} *)
type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
type box = t
module Simple = struct
type t =
[ `Empty
| `Pad of t
| `Text of string
| `Vlist of t list
| `Hlist of t list
| `Table of t array array
| `Tree of t * t list
]
let rec to_box = function
| `Empty -> empty
| `Pad b -> pad (to_box b)
| `Text t -> text t
| `Vlist l -> vlist (List.map to_box l)
| `Hlist l -> hlist (List.map to_box l)
| `Table a -> grid (map_matrix to_box a)
| `Tree (b,l) -> tree (to_box b) (List.map to_box l)
let rec of_ktree t = match t () with
| `Nil -> `Empty
| `Node (x, l) -> `Tree (x, List.map of_ktree l)
let rec map_ktree f t = match t () with
| `Nil -> `Empty
| `Node (x, l) -> `Tree (f x, List.map (map_ktree f) l)
let sprintf format =
let buffer = Buffer.create 64 in
Printf.kbprintf
(fun _ -> `Text (Buffer.contents buffer))
buffer
format
let asprintf format =
Format.kasprintf (fun s -> `Text s) format
end