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
leostera · Mar 16, 2024 · 204aef6 · 204aef6
1 parent 7be848f
commit 204aef6
Show file tree

Hide file tree

Showing 9 changed files with 321 additions and 1 deletion.
diff --git a/examples/README.md b/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>
diff --git a/examples/border/demo.gif b/examples/border/demo.gif
diff --git a/examples/border/demo.tape 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
@@ -0,0  1,3 @@
 (executable
  (name main)
  (libraries minttea spices))
diff --git a/examples/border/main.ml 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
@@ -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
@@ -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
@@ -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
@@ -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