diff --git a/misc/printBox.ml b/misc/printBox.ml index b837ee92..8983894a 100644 --- a/misc/printBox.ml +++ b/misc/printBox.ml @@ -32,6 +32,7 @@ let origin = {x=0; y=0;} let _move pos x y = {x=pos.x + x; y=pos.y + y} let _add pos1 pos2 = _move pos1 pos2.x pos2.y +let _minus pos1 pos2 = _move pos1 (- pos2.x) (- pos2.y) let _move_x pos x = _move pos x 0 let _move_y pos y = _move pos 0 y @@ -146,14 +147,13 @@ let rec _lines s i k = match _find s '\n' i with module Box = struct type grid_shape = - | GridBase - | GridFramed + | GridNone + | GridBars type 'a shape = - | Line of string - | Text of string list (* in a box *) + | Text of string list (* list of lines *) | Frame of 'a - | Pad of int * 'a + | Pad of position * 'a (* vertical and horizontal padding *) | Grid of grid_shape * 'a array array type t = { @@ -174,6 +174,9 @@ module Box = struct if Array.length m = 0 then {x=0;y=0} else {y=Array.length m; x=Array.length m.(0); } + let _map_matrix f m = + Array.map (Array.map f) m + (* height of a line composed of boxes *) let _height_line a = _array_foldi @@ -193,27 +196,28 @@ module Box = struct (* from a matrix [m] (line,column), return two arrays [lines] and [columns], with [col.(i)] being the start offset of column [i] and [lines.(j)] being the start offset of line [j]. - Those arrays have one more slot to indicate the end position. *) - let _size_matrix m = + Those arrays have one more slot to indicate the end position. + @param bars if true, leave space for bars between lines/columns *) + let _size_matrix ~bars m = let dim = _dim_matrix m in + (* +1 is for keeping room for the vertical/horizontal line/column *) + let additional_space = if bars then 1 else 0 in (* columns *) let columns = Array.make (dim.x + 1) 0 in for i = 0 to dim.x - 1 do - (* +1 is for keeping room for the vertical/horizontal line/column *) - columns.(i+1) <- columns.(i) + 1 + (_width_column m i) + columns.(i+1) <- columns.(i) + (_width_column m i) + additional_space done; (* lines *) let lines = Array.make (dim.y + 1) 0 in for j = 1 to dim.y do - lines.(j) <- lines.(j-1) + 1 + (_height_line m.(j-1)) + lines.(j) <- lines.(j-1) + (_height_line m.(j-1)) + additional_space done; (* no trailing bars, adjust *) - columns.(dim.x) <- columns.(dim.x) - 1; - lines.(dim.y) <- lines.(dim.y) - 1; + columns.(dim.x) <- columns.(dim.x) - additional_space; + lines.(dim.y) <- lines.(dim.y) - additional_space; lines, columns let _size = function - | Line s -> { x=String.length s; y=1 } | Text l -> let width = List.fold_left (fun acc line -> max acc (String.length line)) 0 l @@ -222,13 +226,16 @@ module Box = struct | Frame t -> let {x;y} = size t in { x=x+2; y=y+2; } - | Pad (n, b') -> - assert (n>0); + | Pad (dim, b') -> let {x;y} = size b' in - { x=x+2*n; y=y+2*n; } - | Grid (_,m) -> + { x=x+2*dim.x; y=y+2*dim.y; } + | Grid (style,m) -> + let bars = match style with + | GridBars -> true + | GridNone -> false + in let dim = _dim_matrix m in - let lines, columns = _size_matrix m in + let lines, columns = _size_matrix ~bars m in { y=lines.(dim.y); x=columns.(dim.x)} let _make shape = @@ -237,7 +244,7 @@ end let line s = assert (_find s '\n' 0 = None); - Box._make (Box.Line s) + Box._make (Box.Text [s]) let text s = let acc = ref [] in @@ -255,32 +262,38 @@ let bool_ x = line (string_of_bool x) let frame b = Box._make (Box.Frame b) -let pad' n b = - assert (n>=0); - if n=0 then b else Box._make (Box.Pad (n, b)) +let pad' ~col ~lines b = + assert (col >=0 || lines >= 0); + if col=0 && lines=0 + then b + else Box._make (Box.Pad ({x=col;y=lines}, b)) -let pad b = pad' 1 b +let pad b = pad' ~col:1 ~lines:1 b -let grid ?(pad=false) ?(framed=true) m = - let b = Box._make (Box.Grid ((if framed then Box.GridFramed else Box.GridBase), m)) in - if pad then pad' 1 b else b +let hpad col b = pad' ~col ~lines:0 b +let vpad lines b = pad' ~col:0 ~lines b -let init_grid ?pad ?framed ~line ~col f = +let grid ?(pad=fun b->b) ?(bars=true) m = + let m = Box._map_matrix pad m in + Box._make (Box.Grid ((if bars then Box.GridBars else Box.GridNone), 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 ?pad ?framed m + grid ?bars m -let vlist ?pad ?framed l = +let vlist ?pad ?bars l = let a = Array.of_list l in - grid ?pad ?framed (Array.map (fun line -> [| line |]) a) + grid ?pad ?bars (Array.map (fun line -> [| line |]) a) -let hlist ?pad ?framed l = - grid ?pad ?framed [| Array.of_list l |] +let hlist ?pad ?bars l = + grid ?pad ?bars [| Array.of_list l |] -let hlist_map ?pad ?framed f l = hlist ?pad ?framed (List.map f l) -let vlist_map ?pad ?framed f l = vlist ?pad ?framed (List.map f l) -let grid_map ?pad ?framed f m = grid ?pad ?framed (Array.map (Array.map f) m) +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 ?framed m = grid_map ?pad ?framed text m +let grid_text ?(pad=fun x->x) ?bars m = + grid_map ?bars (fun x -> pad (text x)) m let transpose m = let dim = Box._dim_matrix m in @@ -299,10 +312,10 @@ let _write_hline ~out pos n = (* render given box on the output, starting with upper left corner at the given position. [expected_size] is the size of the - available surrounding space *) -let rec _render ?expected_size ~out b pos = + available surrounding space. [offset] is the offset of the box + w.r.t the surrounding box *) +let rec _render ?(offset=origin) ?expected_size ~out b pos = match Box.shape b with - | Box.Line s -> Output.put_string out pos s | Box.Text l -> List.iteri (fun i line -> @@ -319,12 +332,16 @@ let rec _render ?expected_size ~out b pos = _write_vline out (_move_y pos 1) y; _write_vline out (_move pos (x+1) 1) y; _render ~out b' (_move pos 1 1) - | Box.Pad (n, b') -> + | Box.Pad (dim, b') -> let expected_size = Box.size b in - _render ~expected_size ~out b' (_move pos n n) - | Box.Grid (grid_shape,m) -> + _render ~offset:(_add dim offset) ~expected_size ~out b' (_add pos dim) + | Box.Grid (style,m) -> let dim = Box._dim_matrix m in - let lines, columns = Box._size_matrix m in + let bars = match style with + | Box.GridNone -> false + | Box.GridBars -> true + in + let lines, columns = Box._size_matrix ~bars m in (* write boxes *) for j = 0 to dim.y - 1 do @@ -344,14 +361,14 @@ let rec _render ?expected_size ~out b pos = in (* write frame if needed *) - begin match grid_shape with - | Box.GridBase -> () - | Box.GridFramed -> + begin match style with + | Box.GridNone -> () + | Box.GridBars -> for j=1 to dim.y - 1 do - _write_hline ~out (_move_y pos (lines.(j)-1)) len_hlines + _write_hline ~out (_move pos (-offset.x) (lines.(j)-1)) len_hlines done; for i=1 to dim.x - 1 do - _write_vline ~out (_move_x pos (columns.(i)-1)) len_vlines + _write_vline ~out (_move pos (columns.(i)-1) (-offset.y)) len_vlines done; for j=1 to dim.y - 1 do for i=1 to dim.x - 1 do diff --git a/misc/printBox.mli b/misc/printBox.mli index 4fd145e5..966f745c 100644 --- a/misc/printBox.mli +++ b/misc/printBox.mli @@ -124,37 +124,45 @@ val frame : Box.t -> Box.t val pad : Box.t -> Box.t (** Pad the given box with some free space *) -val pad' : int -> Box.t -> Box.t -(** Pad with the given number of free cells *) +val pad' : col:int -> lines:int -> Box.t -> Box.t +(** Pad with the given number of free cells for lines and columns *) -val grid : ?pad:bool -> ?framed:bool -> Box.t array array -> Box.t +val vpad : int -> Box.t -> Box.t +(** Pad vertically *) + +val hpad : int -> Box.t -> Box.t +(** Pad horizontally *) + +val grid : ?pad:(Box.t -> Box.t) -> ?bars:bool -> + Box.t array array -> Box.t (** Grid of boxes (no frame between boxes). The matrix is indexed with lines first, then columns. The array must be a proper matrix, that is, all lines must have the same number of columns! @param framed if [true], each item of the grid will be framed. default value is [true] *) -val grid_text : ?pad:bool -> ?framed:bool -> string array array -> Box.t +val grid_text : ?pad:(Box.t -> Box.t) -> ?bars:bool -> + string array array -> Box.t (** Same as {!grid}, but wraps every cell into a {!text} box *) val transpose : 'a array array -> 'a array array (** Transpose a matrix *) -val init_grid : ?pad:bool -> ?framed:bool -> +val init_grid : ?bars:bool -> line:int -> col:int -> (line:int -> col:int -> Box.t) -> Box.t (** Same as {!grid} but takes the matrix as a function *) -val vlist : ?pad:bool -> ?framed:bool -> Box.t list -> Box.t +val vlist : ?pad:(Box.t -> Box.t) -> ?bars:bool -> Box.t list -> Box.t (** Vertical list of boxes *) -val hlist : ?pad:bool -> ?framed:bool -> Box.t list -> Box.t +val hlist : ?pad:(Box.t -> Box.t) -> ?bars:bool -> Box.t list -> Box.t (** Horizontal list of boxes *) -val grid_map : ?pad:bool -> ?framed:bool -> ('a -> Box.t) -> 'a array array -> Box.t +val grid_map : ?bars:bool -> ('a -> Box.t) -> 'a array array -> Box.t -val vlist_map : ?pad:bool -> ?framed:bool -> ('a -> Box.t) -> 'a list -> Box.t +val vlist_map : ?bars:bool -> ('a -> Box.t) -> 'a list -> Box.t -val hlist_map : ?pad:bool -> ?framed:bool -> ('a -> Box.t) -> 'a list -> Box.t +val hlist_map : ?bars:bool -> ('a -> Box.t) -> 'a list -> Box.t val render : Output.t -> Box.t -> unit