diff --git a/.ocamlinit b/.ocamlinit index f477d71c..7711334d 100644 --- a/.ocamlinit +++ b/.ocamlinit @@ -9,7 +9,7 @@ #load "containers_misc.cma";; #require "threads";; #load "containers_thread.cma";; -open Containers;; +open Containers_misc;; #install_printer Bencode.pretty;; #install_printer HGraph.Default.fmt;; #require "CamlGI";; diff --git a/_oasis b/_oasis index da7316d4..ff9b3700 100644 --- a/_oasis +++ b/_oasis @@ -59,7 +59,7 @@ Library "containers_misc" PHashtbl, SkipList, SplayTree, SplayMap, Univ, Bij, PiCalculus, Bencode, Sexp, RAL, UnionFind, SmallSet, AbsSet, CSM, - ActionMan, BencodeOnDisk, TTree, + ActionMan, BencodeOnDisk, TTree, PrintBox, HGraph, Automaton, Conv, Bidir, Iteratee, Ty, Tell, BencodeStream, RatTerm, Cause, AVL, ParseReact BuildDepends: unix,containers diff --git a/misc/printBox.ml b/misc/printBox.ml new file mode 100644 index 00000000..4d8f5eca --- /dev/null +++ b/misc/printBox.ml @@ -0,0 +1,329 @@ + +(* +copyright (c) 2013-2014, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +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. +*) + +(** {1 Pretty-Printing of Boxes} *) + +type position = { x:int ; y: int } + +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 _move_x pos x = _move pos x 0 +let _move_y pos y = _move pos 0 y + +(** {2 Output: where to print to} *) + +module Output = struct + type t = { + put_char : position -> char -> unit; + put_string : position -> string -> unit; + put_sub_string : position -> string -> int -> int -> unit; + flush : unit -> unit; + } + + let put_char out pos c = out.put_char pos c + let put_string out pos s = out.put_string pos s + let put_sub_string out pos s s_i s_len = out.put_sub_string pos s s_i s_len + + (** An internal buffer, suitable for writing efficiently, then + convertable into a list of lines *) + type buffer = { + mutable buf_lines : buf_line array; + mutable buf_len : int; + } + and buf_line = { + mutable bl_str : string; + mutable bl_len : int; + } + + let _make_line _ = {bl_str=""; bl_len=0} + + let _ensure_lines buf i = + if i >= Array.length buf.buf_lines + then ( + let lines' = Array.init (2 * i + 5) _make_line in + Array.blit buf.buf_lines 0 lines' 0 buf.buf_len; + buf.buf_lines <- lines'; + ) + + let _ensure_line line i = + if i >= String.length line.bl_str + then ( + let str' = String.make (2 * i + 5) ' ' in + String.blit line.bl_str 0 str' 0 line.bl_len; + line.bl_str <- str'; + ) + + let _buf_put_char buf pos c = + _ensure_lines buf pos.y; + _ensure_line buf.buf_lines.(pos.y) pos.x; + buf.buf_len <- max buf.buf_len (pos.y+1); + let line = buf.buf_lines.(pos.y) in + line.bl_str.[pos.x] <- c; + line.bl_len <- max line.bl_len (pos.x+1) + + let _buf_put_sub_string buf pos s s_i s_len = + _ensure_lines buf pos.y; + _ensure_line buf.buf_lines.(pos.y) (pos.x + s_len); + buf.buf_len <- max buf.buf_len (pos.y+1); + let line = buf.buf_lines.(pos.y) in + String.blit s s_i line.bl_str pos.x s_len; + line.bl_len <- max line.bl_len (pos.x+s_len) + + let _buf_put_string buf pos s = + _buf_put_sub_string buf pos s 0 (String.length s) + + (* create a new buffer *) + let make_buffer () = + let buf = { + buf_lines = Array.init 16 _make_line; + buf_len = 0; + } in + let buf_out = { + put_char = _buf_put_char buf; + put_sub_string = _buf_put_sub_string buf; + put_string = _buf_put_string buf; + flush = (fun () -> ()); + } in + buf, buf_out + + let buf_to_lines ?(indent=0) buf = + let buffer = Buffer.create (5 + buf.buf_len * 32) in + for i = 0 to buf.buf_len - 1 do + for k = 1 to indent do Buffer.add_char buffer ' ' done; + let line = buf.buf_lines.(i) in + Buffer.add_substring buffer line.bl_str 0 line.bl_len; + Buffer.add_char buffer '\n'; + done; + Buffer.contents buffer + + let buf_output ?(indent=0) oc buf = + for i = 0 to buf.buf_len - 1 do + for k = 1 to indent do output_char oc ' '; done; + let line = buf.buf_lines.(i) in + output oc line.bl_str 0 line.bl_len; + output_char oc '\n'; + done +end + +(* find [c] in [s], starting at offset [i] *) +let rec _find s c i = + if i >= String.length s then None + else if s.[i] = c then Some i + else _find s c (i+1) + +let rec _lines s i k = match _find s '\n' i with + | None -> () + | Some j -> + let s' = String.sub s i (j-i) in + k s'; + _lines s (j+1) k + +module Box = struct + type grid_shape = + | GridBase + | GridFramed + + type 'a shape = + | Line of string + | Text of string list (* in a box *) + | Frame of 'a + | Grid of grid_shape * 'a array array + + type t = { + shape : t shape; + size : position lazy_t; + } + + let size box = Lazy.force box.size + + let shape b = b.shape + + let _array_foldi f acc a = + let acc = ref acc in + Array.iteri (fun i x -> acc := f !acc i x) a; + !acc + + let _dim_matrix m = + if Array.length m = 0 then {x=0;y=0} + else {y=Array.length m; x=Array.length m.(0); } + + (* height of a line composed of boxes *) + let _height_line a = + _array_foldi + (fun h i box -> + let s = size box in + max h s.y + ) 0 a + + (* how large is the [i]-th column of [m]? *) + let _width_column m i = + let acc = ref 0 in + for j = 0 to Array.length m - 1 do + acc := max !acc (size m.(j).(i)).x + done; + !acc + + (* 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 = + let dim = _dim_matrix m 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) + 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)) + done; + (* no trailing bars, adjust *) + columns.(dim.x) <- columns.(dim.x) - 1; + lines.(dim.y) <- lines.(dim.y) - 1; + 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 + in + { x=width; y=List.length l; } + | Frame t -> + let {x;y} = size t in + { x=x+2; y=y+2; } + | Grid (_,m) -> + let dim = _dim_matrix m in + let lines, columns = _size_matrix m in + { y=lines.(dim.y); x=columns.(dim.x)} + + let _make shape = + { shape; size=(lazy (_size shape)); } + + let line s = + assert (_find s '\n' 0 = None); + _make (Line s) + + let text s = + let acc = ref [] in + _lines s 0 (fun x -> acc := x :: !acc); + _make (Text (List.rev !acc)) + + let lines l = + assert (List.for_all (fun s -> _find s '\n' 0 = None) l); + _make (Text l) + + let frame b = _make (Frame b) + + let grid ?(framed=true) m = + _make (Grid ((if framed then GridFramed else 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 + grid ?framed m + + let vlist ?framed l = + let a = Array.of_list l in + grid ?framed (Array.map (fun line -> [| line |]) a) + + let hlist ?framed l = + grid ?framed [| Array.of_list l |] +end + +let _write_vline ~out pos n = + for j=0 to n-1 do + Output.put_char out (_move_y pos j) '|' + done + +let _write_hline ~out pos n = + for i=0 to n-1 do + Output.put_char out (_move_x pos i) '-' + done + +(* render given box on the output, starting with upper left corner + at the given position. *) +let rec _render ~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 -> + Output.put_string out (_move_y pos i) line + ) l + | Box.Frame b' -> + let {x;y} = Box.size b' in + Output.put_char out pos '+'; + Output.put_char out (_move pos (x+1) (y+1)) '+'; + Output.put_char out (_move pos 0 (y+1)) '+'; + Output.put_char out (_move pos (x+1) 0) '+'; + _write_hline out (_move_x pos 1) x; + _write_hline out (_move pos 1 (y+1)) x; + _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.Grid (grid_shape,m) -> + let dim = Box._dim_matrix m in + let lines, columns = Box._size_matrix m in + + (* write boxes *) + for j = 0 to dim.y - 1 do + for i = 0 to dim.x - 1 do + let pos' = _move pos (columns.(i)) (lines.(j)) in + _render ~out m.(j).(i) pos' + done; + done; + + (* write frame if needed *) + begin match grid_shape with + | Box.GridBase -> () + | Box.GridFramed -> + let size = Box.size b in + for j=1 to dim.y - 1 do + _write_hline ~out {pos with y=lines.(j)} size.x + done; + for i=1 to dim.x - 1 do + _write_vline ~out {pos with x=columns.(i)} size.y + done; + end + +let render out b = + _render ~out b origin + +let to_string b = + let buf, out = Output.make_buffer () in + render out b; + Output.buf_to_lines buf + +let output ?(indent=0) oc b = + let buf, out = Output.make_buffer () in + render out b; + Output.buf_output ~indent oc buf; + flush oc diff --git a/misc/printBox.mli b/misc/printBox.mli new file mode 100644 index 00000000..25c34474 --- /dev/null +++ b/misc/printBox.mli @@ -0,0 +1,100 @@ + +(* +copyright (c) 2013-2014, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +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. +*) + +(** {1 Pretty-Printing of Boxes} *) + +type position = { x:int ; y: int } +(** Positions are relative to the upper-left corner, that is, +when [x] increases we go toward the right, and when [y] increases +we go toward the bottom (same order as a printer) *) + +val origin : position +(** Initial position *) + +module Output : sig + type t = { + put_char : position -> char -> unit; + put_string : position -> string -> unit; + put_sub_string : position -> string -> int -> int -> unit; + flush : unit -> unit; + } + + (** {6 Default Instance: a buffer} *) + + type buffer + + val make_buffer : unit -> buffer * t + (** New buffer, and the corresponding output (buffers are mutable) *) + + val buf_to_lines : ?indent:int -> buffer -> string + (** Print the content of the buffer into a string. + @param indent number of spaces to insert in front of the lines *) + + val buf_output : ?indent:int -> out_channel -> buffer -> unit + (** Print the buffer on the given channel *) +end + +module Box : sig + type t + + val size : t -> position + (** Size needed to print the box *) + + val line : string -> t + (** Make a single-line box. + @raise Invalid_argument if the string contains ['\n'] *) + + val text : string -> t + (** Any text, possibly with several lines *) + + val lines : string list -> t + (** Shortcut for {!text}, with a list of lines *) + + val frame : t -> t + (** Put a single frame around the box *) + + val grid : ?framed:bool -> t array array -> t + (** Grid of boxes (no frame between boxes). The matrix is indexed + with lines first, then columns. + @param framed if [true], each item of the grid will be framed. + default value is [true] *) + + val init_grid : ?framed:bool -> + line:int -> col:int -> (line:int -> col:int -> t) -> t + (** Same as {!grid} but takes the matrix as a function *) + + val vlist : ?framed:bool -> t list -> t + (** Vertical list of boxes *) + + val hlist : ?framed:bool -> t list -> t + (** Horizontal list of boxes *) +end + +val render : Output.t -> Box.t -> unit + +val to_string : Box.t -> string + +val output : ?indent:int -> out_channel -> Box.t -> unit