feat(spices): add border style (#41)

* feat(spices): add border

* feat: add demo.gif and demo.tape in border example

* add get_border util to get border instead of using module

* add make constructor function

* add module Border signature in spices.mli

* add border example in examples/README.md

examples/README.md

@@ -59,3 +59,9 @@
 <a href="./emoji/main.ml">
     <img src="./emoji/demo.gif"/>
 </a>
+
+## Border
+
+<a href="./border/main.ml">
+    <img src="./border/demo.gif"/>
+</a>

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

examples/border/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (libraries minttea spices))

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

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 " ";
+  }

spices/dune

@@ -1,4 +1,4 @@
 (library
  (public_name spices)
  (name spices)
- (libraries tty colors))
+ (libraries tty colors str uuseg))

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;

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