moved box constructors into PrintBoxs toplevel;

more convenience constructors;
more accurate printing of nested boxs bars
This commit is contained in:
Simon Cruanes 2014-06-15 23:10:51 +02:00
parent ebb8310f84
commit 6ef51a5717
2 changed files with 128 additions and 66 deletions

View file

@ -137,7 +137,8 @@ let rec _find s c i =
else _find s c (i+1) else _find s c (i+1)
let rec _lines s i k = match _find s '\n' i with let rec _lines s i k = match _find s '\n' i with
| None -> () | None ->
if i<String.length s then k (String.sub s i (String.length s-i))
| Some j -> | Some j ->
let s' = String.sub s i (j-i) in let s' = String.sub s i (j-i) in
k s'; k s';
@ -227,36 +228,52 @@ module Box = struct
let _make shape = let _make shape =
{ shape; size=(lazy (_size shape)); } { shape; size=(lazy (_size shape)); }
end
let line s = let line s =
assert (_find s '\n' 0 = None); assert (_find s '\n' 0 = None);
_make (Line s) Box._make (Box.Line s)
let text s = let text s =
let acc = ref [] in let acc = ref [] in
_lines s 0 (fun x -> acc := x :: !acc); _lines s 0 (fun x -> acc := x :: !acc);
_make (Text (List.rev !acc)) Box._make (Box.Text (List.rev !acc))
let lines l = let lines l =
assert (List.for_all (fun s -> _find s '\n' 0 = None) l); assert (List.for_all (fun s -> _find s '\n' 0 = None) l);
_make (Text l) Box._make (Box.Text l)
let frame b = _make (Frame b) 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 grid ?(framed=true) m = let frame b =
_make (Grid ((if framed then GridFramed else GridBase), m)) Box._make (Box.Frame b)
let init_grid ?framed ~line ~col f = let grid ?(framed=true) m =
Box._make (Box.Grid ((if framed then Box.GridFramed else Box.GridBase), m))
let init_grid ?framed ~line ~col f =
let m = Array.init line (fun j-> Array.init col (fun i -> f ~line:j ~col:i)) in let m = Array.init line (fun j-> Array.init col (fun i -> f ~line:j ~col:i)) in
grid ?framed m grid ?framed m
let vlist ?framed l = let vlist ?framed l =
let a = Array.of_list l in let a = Array.of_list l in
grid ?framed (Array.map (fun line -> [| line |]) a) grid ?framed (Array.map (fun line -> [| line |]) a)
let hlist ?framed l = let hlist ?framed l =
grid ?framed [| Array.of_list l |] grid ?framed [| Array.of_list l |]
end
let hlist_map ?framed f l = hlist ?framed (List.map f l)
let vlist_map ?framed f l = vlist ?framed (List.map f l)
let grid_map ?framed f m = grid ?framed (Array.map (Array.map f) m)
let grid_text ?framed m = grid_map ?framed text m
let transpose m =
let dim = Box._dim_matrix m in
Array.init dim.x
(fun i -> Array.init dim.y (fun j -> m.(j).(i)))
let _write_vline ~out pos n = let _write_vline ~out pos n =
for j=0 to n-1 do for j=0 to n-1 do
@ -269,8 +286,9 @@ let _write_hline ~out pos n =
done done
(* render given box on the output, starting with upper left corner (* render given box on the output, starting with upper left corner
at the given position. *) at the given position. [expected_size] is the size of the
let rec _render ~out b pos = available surrounding space *)
let rec _render ?expected_size ~out b pos =
match Box.shape b with match Box.shape b with
| Box.Line s -> Output.put_string out pos s | Box.Line s -> Output.put_string out pos s
| Box.Text l -> | Box.Text l ->
@ -296,22 +314,35 @@ let rec _render ~out b pos =
(* write boxes *) (* write boxes *)
for j = 0 to dim.y - 1 do for j = 0 to dim.y - 1 do
for i = 0 to dim.x - 1 do for i = 0 to dim.x - 1 do
let expected_size = {
x=columns.(i+1)-columns.(i);
y=lines.(j+1)-lines.(j);
} in
let pos' = _move pos (columns.(i)) (lines.(j)) in let pos' = _move pos (columns.(i)) (lines.(j)) in
_render ~out m.(j).(i) pos' _render ~expected_size ~out m.(j).(i) pos'
done; done;
done; done;
let len_hlines, len_vlines = match expected_size with
| None -> columns.(dim.x), lines.(dim.y)
| Some {x;y} -> x,y
in
(* write frame if needed *) (* write frame if needed *)
begin match grid_shape with begin match grid_shape with
| Box.GridBase -> () | Box.GridBase -> ()
| Box.GridFramed -> | Box.GridFramed ->
let size = Box.size b in
for j=1 to dim.y - 1 do for j=1 to dim.y - 1 do
_write_hline ~out {pos with y=lines.(j)} size.x _write_hline ~out (_move_y pos (lines.(j)-1)) len_hlines
done; done;
for i=1 to dim.x - 1 do for i=1 to dim.x - 1 do
_write_vline ~out {pos with x=columns.(i)} size.y _write_vline ~out (_move_x pos (columns.(i)-1)) len_vlines
done; done;
for j=1 to dim.y - 1 do
for i=1 to dim.x - 1 do
Output.put_char out (_move pos (columns.(i)-1) (lines.(j)-1)) '+'
done
done
end end
let render out b = let render out b =

View file

@ -24,7 +24,19 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*) *)
(** {1 Pretty-Printing of Boxes} *) (** {1 Pretty-Printing of nested Boxes}
Allows to print nested boxes, lists, arrays, tables in a nice way
on any monospaced support.
{[
let b = PrintBox.(
]}
*)
type position = { x:int ; y: int } type position = { x:int ; y: int }
(** Positions are relative to the upper-left corner, that is, (** Positions are relative to the upper-left corner, that is,
@ -62,36 +74,55 @@ module Box : sig
val size : t -> position val size : t -> position
(** Size needed to print the box *) (** Size needed to print the box *)
end
val line : string -> t val line : string -> Box.t
(** Make a single-line box. (** Make a single-line box.
@raise Invalid_argument if the string contains ['\n'] *) @raise Invalid_argument if the string contains ['\n'] *)
val text : string -> t val text : string -> Box.t
(** Any text, possibly with several lines *) (** Any text, possibly with several lines *)
val lines : string list -> t val lines : string list -> Box.t
(** Shortcut for {!text}, with a list of lines *) (** Shortcut for {!text}, with a list of lines *)
val frame : t -> t val int_ : int -> Box.t
(** Put a single frame around the box *)
val grid : ?framed:bool -> t array array -> t val bool_ : bool -> Box.t
(** Grid of boxes (no frame between boxes). The matrix is indexed
with lines first, then columns. val float_ : float -> Box.t
val frame : Box.t -> Box.t
(** Put a single frame around the box *)
val grid : ?framed: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. @param framed if [true], each item of the grid will be framed.
default value is [true] *) default value is [true] *)
val init_grid : ?framed:bool -> val grid_text : ?framed:bool -> string array array -> Box.t
line:int -> col:int -> (line:int -> col:int -> t) -> t (** Same as {!grid}, but wraps every cell into a {!text} box *)
(** Same as {!grid} but takes the matrix as a function *)
val vlist : ?framed:bool -> t list -> t val transpose : 'a array array -> 'a array array
(** Vertical list of boxes *) (** Transpose a matrix *)
val hlist : ?framed:bool -> t list -> t val init_grid : ?framed:bool ->
(** Horizontal list of boxes *) line:int -> col:int -> (line:int -> col:int -> Box.t) -> Box.t
end (** Same as {!grid} but takes the matrix as a function *)
val vlist : ?framed:bool -> Box.t list -> Box.t
(** Vertical list of boxes *)
val hlist : ?framed:bool -> Box.t list -> Box.t
(** Horizontal list of boxes *)
val grid_map : ?framed:bool -> ('a -> Box.t) -> 'a array array -> Box.t
val vlist_map : ?framed:bool -> ('a -> Box.t) -> 'a list -> Box.t
val hlist_map : ?framed:bool -> ('a -> Box.t) -> 'a list -> Box.t
val render : Output.t -> Box.t -> unit val render : Output.t -> Box.t -> unit