diff --git a/examples/README.md b/examples/README.md index 93c3c61..307e420 100644 --- a/examples/README.md +++ b/examples/README.md @@ -59,3 +59,9 @@ + +## Border + + + + diff --git a/examples/border/demo.gif b/examples/border/demo.gif new file mode 100644 index 0000000..046d732 Binary files /dev/null and b/examples/border/demo.gif differ diff --git a/examples/border/demo.tape b/examples/border/demo.tape new file mode 100644 index 0000000..6057224 --- /dev/null +++ b/examples/border/demo.tape @@ -0,0 +1,17 @@ +Output demo.gif + +Require echo + +Set Shell "bash" +Set Framerate 24 +Set FontSize 32 +Set Width 1200 +Set Height 600 + +Type "dune exec --no-print-directory ./main.exe" +Enter +Sleep 1s +Type "hello world" +Sleep 1s +Type "q" +Sleep 1s diff --git a/examples/border/dune b/examples/border/dune new file mode 100644 index 0000000..c3afbe4 --- /dev/null +++ b/examples/border/dune @@ -0,0 +1,3 @@ +(executable + (name main) + (libraries minttea spices)) diff --git a/examples/border/main.ml b/examples/border/main.ml new file mode 100644 index 0000000..e27a344 --- /dev/null +++ b/examples/border/main.ml @@ -0,0 +1,32 @@ +open Minttea + +let red_with_border fmt = + Spices.( + default |> border Border.thick |> padding_left 5 |> padding_right 5 + |> fg (color "#FF0000") + |> build) + fmt + +let overlay_border fmt = Spices.(default |> border Border.double |> build) fmt + +type s = { text : string } + +let init _ = Command.Noop +let initial_model = { text = "" } + +let update event model = + match event with + | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit) + | Event.KeyDown (Key k) -> + let model = { text = model.text ^ k } in + (model, Command.Noop) + | Event.KeyDown Space -> + let model = { text = model.text ^ " " } in + (model, Command.Noop) + | Event.KeyDown Enter -> + let model = { text = model.text ^ "\n" } in + (model, Command.Noop) + | _ -> (model, Command.Noop) + +let view model = overlay_border "%s" (red_with_border "%s" model.text) +let () = Minttea.app ~init ~update ~view () |> Minttea.start ~initial_model diff --git a/spices/border.ml b/spices/border.ml new file mode 100644 index 0000000..bd011ca --- /dev/null +++ b/spices/border.ml @@ -0,0 +1,219 @@ +let remove_color_sequences s = + let regex = Str.regexp "\027\\[[0-9;]*m" in + Str.global_replace regex "" s + +let rec create_string n s = + if n = 0 then "" + else + let str = create_string (n - 1) s in + str ^ s + +let utf8_len str = + Uuseg_string.fold_utf_8 `Grapheme_cluster (fun x _ -> x + 1) 0 str + +let get_width text = + List.fold_left + (fun acc line -> + let len = utf8_len (remove_color_sequences line) in + if acc < len then len else acc) + 0 + (Str.split (Str.regexp "\r?\n") text) + +let get_height text = List.length (Str.split (Str.regexp "\r?\n") text) + +type t = { + top : string option; + left : string option; + bottom : string option; + right : string option; + top_left : string option; + top_right : string option; + bottom_left : string option; + bottom_right : string option; + middle_left : string option; + middle_right : string option; + middle : string option; + middle_top : string option; + middle_bottom : string option; +} + +let make ?top ?left ?bottom ?right ?top_left ?top_right ?bottom_left + ?bottom_right ?middle_left ?middle_right ?middle ?middle_top ?middle_bottom + () = + { + top; + left; + bottom; + right; + top_left; + top_right; + bottom_left; + bottom_right; + middle_left; + middle_right; + middle; + middle_top; + middle_bottom; + } + +let build_border (border : t) text = + let top = Option.value border.top ~default:"" in + let left = Option.value border.left ~default:"" in + let bottom = Option.value border.bottom ~default:"" in + let right = Option.value border.right ~default:"" in + let top_left = Option.value border.top_left ~default:"" in + let top_right = Option.value border.top_right ~default:"" in + let bottom_left = Option.value border.bottom_left ~default:"" in + let bottom_right = Option.value border.bottom_right ~default:"" in + + let width = get_width text in + let top_border = top_left ^ create_string width top ^ top_right in + let bottom_border = bottom_left ^ create_string width bottom ^ bottom_right in + let l = Str.split (Str.regexp "\r?\n") text in + let l = + List.map + (fun x -> + let x_w = get_width x in + let extra_right_spacing = create_string (width - x_w) " " in + let res = left ^ x ^ extra_right_spacing ^ right in + res) + l + in + let text = String.concat "\n" l in + Format.sprintf "%s\n%s\n%s" top_border text bottom_border + +let normal = + { + top = Some "─"; + bottom = Some "─"; + left = Some "│"; + right = Some "│"; + top_left = Some "┌"; + top_right = Some "┐"; + bottom_left = Some "└"; + bottom_right = Some "┘"; + middle_left = Some "├"; + middle_right = Some "┤"; + middle = Some "┼"; + middle_top = Some "┬"; + middle_bottom = Some "┴"; + } + +let rounded = + { + top = Some "─"; + bottom = Some "─"; + left = Some "│"; + right = Some "│"; + top_left = Some "╭"; + top_right = Some "╮"; + bottom_left = Some "╰"; + bottom_right = Some "╯"; + middle_left = Some "├"; + middle_right = Some "┤"; + middle = Some "┼"; + middle_top = Some "┬"; + middle_bottom = Some "┴"; + } + +let block = + { + top = Some "█"; + bottom = Some "█"; + left = Some "█"; + right = Some "█"; + top_left = Some "█"; + top_right = Some "█"; + bottom_left = Some "█"; + bottom_right = Some "█"; + middle_left = None; + middle_right = None; + middle = None; + middle_top = None; + middle_bottom = None; + } + +let outer_half_block = + { + top = Some "▀"; + bottom = Some "▄"; + left = Some "▌"; + right = Some "▐"; + top_left = Some "▛"; + top_right = Some "▜"; + bottom_left = Some "▙"; + bottom_right = Some "▟"; + middle_left = None; + middle_right = None; + middle = None; + middle_top = None; + middle_bottom = None; + } + +let inner_half_block = + { + top = Some "▄"; + bottom = Some "▀"; + left = Some "▐"; + right = Some "▌"; + top_left = Some "▗"; + top_right = Some "▖"; + bottom_left = Some "▝"; + bottom_right = Some "▘"; + middle_left = None; + middle_right = None; + middle = None; + middle_top = None; + middle_bottom = None; + } + +let thick = + { + top = Some "━"; + bottom = Some "━"; + left = Some "┃"; + right = Some "┃"; + top_left = Some "┏"; + top_right = Some "┓"; + bottom_left = Some "┗"; + bottom_right = Some "┛"; + middle_left = Some "┣"; + middle_right = Some "┫"; + middle = Some "╋"; + middle_top = Some "┳"; + middle_bottom = Some "┻"; + } + +let double = + { + top = Some "═"; + bottom = Some "═"; + left = Some "║"; + right = Some "║"; + top_left = Some "╔"; + top_right = Some "╗"; + bottom_left = Some "╚"; + bottom_right = Some "╝"; + middle_left = Some "╠"; + middle_right = Some "╣"; + middle = Some "╬"; + middle_top = Some "╦"; + middle_bottom = Some "╩"; + } + +let hidden = + { + top = Some " "; + bottom = Some " "; + left = Some " "; + right = Some " "; + top_left = Some " "; + top_right = Some " "; + bottom_left = Some " "; + bottom_right = Some " "; + middle_left = Some " "; + middle_right = Some " "; + middle = Some " "; + middle_top = Some " "; + middle_bottom = Some " "; + } diff --git a/spices/dune b/spices/dune index aca7a4f..1e59937 100644 --- a/spices/dune +++ b/spices/dune @@ -1,4 +1,4 @@ (library (public_name spices) (name spices) - (libraries tty colors)) + (libraries tty colors str uuseg)) diff --git a/spices/spices.ml b/spices/spices.ml index 39e78d2..7f42f35 100644 --- a/spices/spices.ml +++ b/spices/spices.ml @@ -13,6 +13,8 @@ let color ?(profile = Tty.Profile.default) raw = let gradient = Gradient.make +module Border = Border + type style = { background : color option; blink : bool; @@ -35,6 +37,7 @@ type style = { strikethrough : bool; underline : bool; width : int option; + border : Border.t option; } let default = @@ -60,6 +63,7 @@ let default = strikethrough = false; underline = false; width = None; + border = None; } let bg x t = { t with background = Some x } @@ -83,6 +87,7 @@ let reverse x t = { t with reverse = x } let strikethrough x t = { t with strikethrough = x } let underline x t = { t with underline = x } let width x t = { t with width = x } +let border x t = { t with border = Some x } let do_render t str = (* Pre-process padding *) @@ -133,6 +138,13 @@ let do_render t str = Buffer.contents buf in + (* handle border *) + let str = + match t.border with + | Some border -> Border.build_border border str + | None -> str + in + (* handle margin *) let str = ref str in if t.margin_left > 0 then str := String.make t.margin_left ' ' ^ !str; diff --git a/spices/spices.mli b/spices/spices.mli index 0844b1f..50aa598 100644 --- a/spices/spices.mli +++ b/spices/spices.mli @@ -7,6 +7,36 @@ type color = Tty.Color.t = private val color : ?profile:Tty.Profile.t -> string -> color val gradient : start:color -> finish:color -> steps:int -> color array +module Border : sig + type t + + val make : + ?top:string -> + ?left:string -> + ?bottom:string -> + ?right:string -> + ?top_left:string -> + ?top_right:string -> + ?bottom_left:string -> + ?bottom_right:string -> + ?middle_left:string -> + ?middle_right:string -> + ?middle:string -> + ?middle_top:string -> + ?middle_bottom:string -> + unit -> + t + + val normal : t + val rounded : t + val block : t + val outer_half_block : t + val inner_half_block : t + val thick : t + val double : t + val hidden : t +end + type style val default : style @@ -31,6 +61,7 @@ val reverse : bool -> style -> style val strikethrough : bool -> style -> style val underline : bool -> style -> style val width : int option -> style -> style +val border : Border.t -> style -> style type 'a style_fun = ('a, Format.formatter, unit, unit, unit, string) format6 -> 'a