diff --git a/src/PrintBox.ml b/src/PrintBox.ml index a5931ca..a64627a 100644 --- a/src/PrintBox.ml +++ b/src/PrintBox.ml @@ -33,10 +33,7 @@ end type view = | Empty - | Text of { - l: string list; - style: Style.t; - } + | Text of rich_text | Frame of t | Pad of position * t (* vertical and horizontal padding *) | Align of { @@ -51,21 +48,71 @@ type view = inner: t; } +and rich_text = + | RT_str of string + | RT_style of Style.t * rich_text + | RT_cat of rich_text list + and t = view +module Rich_text = struct + type t = rich_text + + type view = rich_text = + | RT_str of string + | RT_style of Style.t * rich_text + | RT_cat of rich_text list + + let[@inline] view (self:t) : view = self + + let line_ s : t = RT_str s + let line s : t = + if String.contains s '\n' then invalid_arg "PrintBox.Rich_text.line"; + line_ s + + let with_style style s : t = RT_style (style, s) + let bold s = with_style Style.bold s + let newline : t = RT_str "\n" + let space : t = RT_str " " + + let cat l : t = match l with + | [] -> RT_str "" + | [x] -> x + | _ -> RT_cat l + + let cat_with ~sep l = + let rec loop acc = function + | [] -> assert (acc=[]); RT_str "" + | [x] -> cat (List.rev (x::acc)) + | x :: tl -> loop (sep :: x :: acc) tl + in + loop [] l + + let lines l = cat_with ~sep:newline l + let lines_text l = lines @@ List.rev @@ List.rev_map line l + + let text s : t = RT_str s + + let sprintf fmt = + let buffer = Buffer.create 64 in + Printf.kbprintf (fun _ -> text (Buffer.contents buffer)) buffer fmt + let asprintf fmt = Format.kasprintf text fmt + + let s = text +end + let empty = Empty let[@inline] view (t:t) : view = t -let[@inline] line_ s = Text {l=[s]; style=Style.default} - -let line_with_style style s = - if String.contains s '\n' then invalid_arg "PrintBox.line"; - Text {l=[s]; style} +(* no check for \n *) +let[@inline] line_ s = Text (Rich_text.line_ s) -let line s = line_with_style Style.default s +let[@inline] line s = Text (Rich_text.line s) +let[@inline] line_with_style style str = Text (Rich_text.(with_style style @@ line str)) -let text s = Text {l=[s]; style=Style.default} -let text_with_style style s = Text {l=[s]; style} +let rich_text t : t = Text t +let text s = Text (Rich_text.text s) +let text_with_style style str = Text Rich_text.(with_style style @@ text str) let sprintf_with_style style format = let buffer = Buffer.create 64 in @@ -78,8 +125,9 @@ let sprintf format = sprintf_with_style Style.default format let asprintf format = Format.kasprintf text format let asprintf_with_style style format = Format.kasprintf (text_with_style style) format -let[@inline] lines l = Text {l; style=Style.default} -let[@inline] lines_with_style style l = Text {l; style} +let[@inline] lines l = Text (Rich_text.lines_text l) +let[@inline] lines_with_style style l = + Text Rich_text.(with_style style @@ lines_text l) let int x = line_ (string_of_int x) let float x = line_ (string_of_float x) diff --git a/src/PrintBox.mli b/src/PrintBox.mli index 5dba54a..89e4f0a 100644 --- a/src/PrintBox.mli +++ b/src/PrintBox.mli @@ -102,6 +102,10 @@ type t (** Main type for a document composed of nested boxes. @since 0.2 the type [t] is opaque *) +type rich_text +(** Text with formatting and new lines. + @since NEXT_RELEASE *) + (** The type [view] can be used to observe the inside of the box, now that [t] is opaque. @@ -110,10 +114,7 @@ type t *) type view = private | Empty - | Text of { - l: string list; - style: Style.t; - } + | Text of rich_text | Frame of t | Pad of position * t (* vertical and horizontal padding *) | Align of { @@ -157,10 +158,16 @@ val lines : string list -> t [lines l] is the same as [text (String.concat "\n" l)]. *) val int_ : int -> t +(** @deprecated use {!int} *) +[@@deprecated "use int"] val bool_ : bool -> t +(** @deprecated use {!bool} *) +[@@deprecated "use bool"] val float_ : float -> t +(** @deprecated use {!float} *) +[@@deprecated "use float"] val int : int -> t (** @since 0.2 *) @@ -171,6 +178,10 @@ val bool : bool -> t val float : float -> t (** @since 0.2 *) +val rich_text : rich_text -> t +(** A box containing rich text. See {!Rich_text} for more. + @since NEXT_RELEASE *) + val frame : t -> t (** Put a single frame around the box *) @@ -240,14 +251,14 @@ val init_grid : ?bars:bool -> line:int -> col:int -> (line:int -> col:int -> t) -> t (** Same as {!grid} but takes the matrix as a function *) -val grid_l : +val grid_l : ?pad:(t -> t) -> ?bars:bool -> t list list -> t (** Same as {!grid} but from lists. @since 0.3 *) -val grid_text_l : +val grid_text_l : ?pad:(t -> t) -> ?bars:bool -> string list list -> t @@ -338,11 +349,66 @@ val asprintf_with_style : Style.t -> ('a, Format.formatter, unit, t) format4 -> (** Formatting for {!text}, with style. @since 0.3 *) +(** Rich text *) +module Rich_text : sig + type t = rich_text + + (** View on the internals of the rich text. + {b NOTE} this is unstable for now, no promise of stability is made. *) + type view = private + | RT_str of string + | RT_style of Style.t * t + | RT_cat of t list + + val view : t -> view + + val s : string -> t + (** Short for {!text} *) + + val line : string -> t + (** Make a single-line text object. + @raise Invalid_argument if the string contains ['\n'] *) + + val text : string -> t + (** Any text, possibly with several lines *) + + val space : t + + val newline : t + + val cat : t list -> t + (** [cat txts] is the concatenation of items in [txts]. *) + + val cat_with : sep:t -> t list -> t + (** [concat_with ~sep l] concatenates items of [l], + inserting [sep] in between each. It doesn't add [sep] after + the last element. *) + + val lines : t list -> t + (** Concatenate with interspersed new lines *) + + val lines_text : string list -> t + (** same as [lines @@ List.map line l] *) + + val sprintf : ('a, Buffer.t, unit, t) format4 -> 'a + (** Formatting. *) + + val asprintf : ('a, Format.formatter, unit, t) format4 -> 'a + (** Formatting. *) + + val with_style : Style.t -> t -> t + (** Add style to the text. *) + + val bold : t -> t + (** Short for [with_style Style.bold] *) +end + (** {2 Simple Structural Interface} *) type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] type box = t +(** A simple interface. *) module Simple : sig type t = [ `Empty diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index 2bb3965..507fa74 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/src/printbox-html/PrintBox_html.ml @@ -86,13 +86,20 @@ let rec to_html_rec ~config (b: B.t) : [< Html_types.flow5 > `Div `Ul `Table `P] let to_html_rec = to_html_rec ~config in match B.view b with | B.Empty -> H.div [] - | B.Text {l; style} -> - let a, bold = attrs_of_style style in - let l = List.map H.txt l in - let l = if bold then List.map (fun x->H.b [x]) l else l in - H.div - ~a:(H.a_class config.cls_text :: (a @ config.a_text)) - l + | B.Text rt -> + let module RT = B.Rich_text in + let rec conv_rt style rt = + match RT.view rt with + | RT.RT_str s -> + let a, bold = attrs_of_style style in + let s = H.txt s in + let s = if bold then H.b [s] else s in + H.div [s] + ~a:(H.a_class config.cls_text :: (a @ config.a_text)) + | RT.RT_cat l -> H.div (List.map (conv_rt style) l) + | RT.RT_style (style, sub) -> conv_rt style sub + in + conv_rt B.Style.default rt | B.Pad (_, b) | B.Frame b -> to_html_rec b | B.Align {h=`Right;inner=b;v=_} -> diff --git a/src/printbox-text/PrintBox_text.ml b/src/printbox-text/PrintBox_text.ml index 39dfcc4..d6c85a6 100644 --- a/src/printbox-text/PrintBox_text.ml +++ b/src/printbox-text/PrintBox_text.ml @@ -242,11 +242,19 @@ module Box_inner : sig val of_box : B.box -> t val render : ansi:bool -> Output.t -> t -> unit end = struct + type line_chunk = { + s: string; + pos: int; + len: int; + style: B.Style.t; + width: int; + } + type line = line_chunk list + type 'a shape = | Empty | Text of { - l: (string * int * int) list; (* list of lines *) - style: B.Style.t; + l: line list; } | Frame of 'a | Pad of position * 'a (* vertical and horizontal padding *) @@ -270,6 +278,7 @@ end = struct mutable bottom: bool; } + (* TODO: replace with a simple integer with 8 bit fields *) type display_connections = { mutable nontree: display_conn_basic; mutable tree: display_conn_basic; @@ -413,12 +422,15 @@ end = struct lines.(dim.y) <- lines.(dim.y) - additional_space; lines, columns, additional_space + let line_width (l:line) : int = + List.fold_left (fun acc {width; _} -> acc + width) 0 l + let size_of_shape = function | Empty -> Pos.origin - | Text {l;style=_} -> + | Text {l} -> let width = List.fold_left - (fun acc (s,i,len) -> max acc (str_display_width_ s i len)) + (fun acc line -> max acc (line_width line)) 0 l in { x=width; y=List.length l; } @@ -441,34 +453,51 @@ end = struct ; y=s.y + dim_children.y } - let[@unroll 2] rec lines_ s i (k: string -> int -> int -> unit) : unit = + let[@unroll 2] rec lines_ s i (k: full:bool -> string -> int -> int -> unit) : unit = match String.index_from s i '\n' with | j -> - k s i (j - i); + k ~full:true s i (j - i); lines_ s (j+1) k | exception Not_found -> if i < String.length s then ( - k s i (String.length s - i) + k ~full:false s i (String.length s - i) ) - let lines_l_ l k = - match l with - | [] -> () - | [s] -> lines_ s 0 k - | s1::s2::tl -> - lines_ s1 0 k; - lines_ s2 0 k; - List.iter (fun s -> lines_ s 0 k) tl - let rec of_box (b:B.t) : t = let shape = match B.view b with | B.Empty -> Empty - | B.Text {l;style} -> + | B.Text rt -> + let module RT = B.Rich_text in + (* split into lines *) - let acc = ref [] in - lines_l_ l (fun s i len -> acc := (s,i,len) :: !acc); - Text {l=List.rev !acc; style} + let lines = ref [] in + let cur_line = ref [] in + + let rec conv_text style t = + match RT.view t with + | RT.RT_str s -> + lines_ s 0 + (fun ~full s pos len -> + let width = str_display_width_ s pos len in + let chunk = {s;pos;len;style;width} in + if full then ( + let line = List.rev @@ chunk :: !cur_line in + cur_line := []; + lines := line :: !lines; + ) else ( + cur_line := chunk :: !cur_line + ) + ); + | RT.RT_cat l -> List.iter (conv_text style) l + | RT.RT_style (style,sub) -> conv_text style sub + in + conv_text B.Style.default rt; + if !cur_line <> [] then ( + lines := List.rev !cur_line :: !lines + ); + + Text {l=List.rev !lines} | B.Frame t -> Frame (of_box t) | B.Pad (dim, t) -> Pad (dim, of_box t) | B.Align {h;v;inner} -> Align {h;v;inner=of_box inner} @@ -508,19 +537,33 @@ end = struct let rec render_rec ~ansi ?(offset=offset) ?expected_size b pos = match shape b with | Empty -> conn_m.m - | Text {l;style} -> - let ansi_prelude, ansi_suffix = - if ansi then Style_ansi.brackets style else "", "" in - let has_style = ansi_prelude <> "" || ansi_suffix <> "" in - List.iteri - (fun line_idx (s,s_i,len)-> - if has_style then ( - Output.put_sub_string_brack out (Pos.move_y pos line_idx) - ~pre:ansi_prelude s s_i len ~post:ansi_suffix - ) else ( - Output.put_sub_string out (Pos.move_y pos line_idx) s s_i len - )) - l; + | Text {l} -> + + let render_chunk line_idx col_idx {s; pos=s_pos; len; style; width=_} = + let ansi_prelude, ansi_suffix = + if ansi then Style_ansi.brackets style else "", "" in + let has_style = ansi_prelude <> "" || ansi_suffix <> "" in + let pos = Pos.move pos col_idx line_idx in + if has_style then ( + Output.put_sub_string_brack out pos + ~pre:ansi_prelude s s_pos len ~post:ansi_suffix + ) else ( + Output.put_sub_string out pos s s_pos len + ) + in + + let render_line line_idx (l:line) = + let col_idx= ref 0 in + List.iter + (fun c -> + render_chunk line_idx !col_idx c; + col_idx := !col_idx + c.width; + ) + l + in + + List.iteri render_line l; + conn_m.m | Frame b' -> let {x;y} = size b' in diff --git a/test/test1.expected b/test/test1.expected index 338fd6b..4d3ab9c 100644 --- a/test/test1.expected +++ b/test/test1.expected @@ -461,7 +461,7 @@ root │ │ │ │ │ │ │ │t│ -│ lil' ol' me │a│ +│ lil' ol' me │a│ │ │l│ │ │l│ │ │ │ @@ -510,6 +510,32 @@ root │ │ 10│20 │ │ │ │ └─────┴──────────────────────────┘ +┌─────────────────┬──────────────────────────────────────────────────────────────┐ +│subject │announce: printbox 0.3 │ +├─────────────────┼──────────────────────────────────────────────────────────────┤ +│explanation │┌────────────────────────────────────────────────────────────┐│ +│ ││PrintBox is a library for rendering nested tables, ││ +│ ││ trees, and similar structures in monospace text or HTML.││ +│ │└────────────────────────────────────────────────────────────┘│ +├─────────────────┼──────────────────────────────────────────────────────────────┤ +│github │https://github.com/c-cube/printbox/releases/tag/0.3 │ +├─────────────────┼──────────────────────────────────────────────────────────────┤ +│contributors │Simon │ +│ ├──────────────────────────────────────────────────────────────┤ +│ │Guillaume │ +│ ├──────────────────────────────────────────────────────────────┤ +│ │Matt │ +├─────────────────┼──────────────────────────────────────────────────────────────┤ +│dependencies │├─mandatory │ +│ ││ ├─dune │ +│ ││ └─bytes │ +│ │└─optional │ +│ │ ├─uutf │ +│ │ ├─uucp │ +│ │ └─tyxml │ +├─────────────────┼──────────────────────────────────────────────────────────────┤ +│expected reaction│🎉 │ +└─────────────────┴──────────────────────────────────────────────────────────────┘ ┌────────────────────────────────────┐ │nice unicode! 💪 │ ├────────────────────────────────────┤ @@ -528,3 +554,8 @@ root ││ │└─────────────────┘││ │└──────────────┴───────────────────┘│ └────────────────────────────────────┘ +┌─────────────────────────────────┐ +│ab │ +│cd no color here │ +│hello world color me (but not me)│ +└─────────────────────────────────┘ diff --git a/test/test1.ml b/test/test1.ml index 20c4104..0b6d5de 100644 --- a/test/test1.ml +++ b/test/test1.ml @@ -28,7 +28,8 @@ let () = let grid = B.frame @@ B.grid_l [ [B.text "the center of the triangle is"; B.empty]; - [B.center_hv @@ B.text "lil' ol' me"; + [B.center_hv @@ + B.(rich_text B.Rich_text.(cat [s "lil' "; with_style B.Style.(fg_color Red) (s "ol'"); s " me"])); B.pad' ~col:0 ~lines:6 @@ B.text "t\na\nl\nl"]; [B.align_right (B.text "i'm aligned right"); B.empty]; [ B.text "loooooooooooooooooooooooooooooooooong"; B.empty; ]; @@ -77,10 +78,10 @@ end let b = let open PrintBox in - frame @@ record [ + frame @@ v_record [ ("subject", text_with_style Style.bold "announce: printbox 0.3"); ("explanation", - frame @@ text {|PrintBox is a library for rendering nested tables, + frame @@ center_hv @@ text {|PrintBox is a library for rendering nested tables, trees, and similar structures in monospace text or HTML.|}); ("github", text_with_style Style.(bg_color Blue) "https://github.com/c-cube/printbox/releases/tag/0.3"); @@ -95,6 +96,9 @@ let b = ("expected reaction", text "🎉"); ] +(* announcefor 0.3 *) +let () = print_endline @@ PrintBox_text.to_string b + module Unicode = struct let b = B.(frame @@ vlist [text "nice unicode! 💪"; frame @@ @@ -106,3 +110,15 @@ module Unicode = struct let () = print_endline @@ PrintBox_text.to_string b end + +module Rich_text_ = struct + let b = + B.(frame @@ rich_text @@ Rich_text.(lines [ + cat [with_style Style.(bg_color Cyan) (s "ab\ncd"); s " no color here"]; + cat [s "hello"; space; s "world"; + with_style Style.(fg_color Green) (s " color me"); s " (but not me)"]; + ]));; + + let () = print_endline @@ PrintBox_text.to_string b + +end