From b9938996f92a72f476ea234fbd699396c83e2c87 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Sun, 26 Feb 2023 21:13:25 +0100 Subject: [PATCH] feature(ansi_color): add support for 8 and 24 bit color codes Signed-off-by: Ali Caglayan --- otherlibs/stdune/src/ansi_color.ml | 280 +++++++++++++++++----- otherlibs/stdune/src/ansi_color.mli | 27 +++ otherlibs/stdune/src/int.ml | 4 + otherlibs/stdune/src/int.mli | 4 + otherlibs/stdune/test/ansi_color_tests.ml | 274 ++++++++++++++++++--- src/dune_tui/dune_tui.ml | 37 +++ 6 files changed, 533 insertions(+), 93 deletions(-) diff --git a/otherlibs/stdune/src/ansi_color.ml b/otherlibs/stdune/src/ansi_color.ml index 638afbbfd27b..35c3edb4412e 100644 --- a/otherlibs/stdune/src/ansi_color.ml +++ b/otherlibs/stdune/src/ansi_color.ml @@ -1,3 +1,66 @@ +module RGB8 : sig + type t + + val to_dyn : t -> Dyn.t + + val of_int : int -> t + + val to_int : t -> int + + (** This is only used internally. *) + val write_to_buffer : Buffer.t -> t -> unit +end = struct + type t = char + + let to_dyn t = Dyn.Int (int_of_char t) + + let of_int t = char_of_int (t land 0xFF) + + let to_int t = int_of_char t + + let write_to_buffer buf c = + Buffer.add_string buf "38;5;"; + int_of_char c |> Int.to_string |> Buffer.add_string buf +end + +module RGB24 : sig + type t + + val to_dyn : t -> Dyn.t + + val red : t -> int + + val green : t -> int + + val blue : t -> int + + val create : r:int -> g:int -> b:int -> t + + (** This is only used internally. *) + val write_to_buffer : Buffer.t -> t -> unit +end = struct + type t = int + + let red t = Int.shift_right t 16 land 0xFF + + let green t = Int.shift_right t 8 land 0xFF + + let blue t = t land 0xFF + + let to_dyn t = Dyn.list Dyn.int [ red t; green t; blue t ] + + let create ~r ~g ~b = + ((r land 0xFF) lsl 16) lor ((g land 0xFF) lsl 8) lor (b land 0xFF) + + let write_to_buffer buf t = + Buffer.add_string buf "38;2;"; + red t |> Int.to_string |> Buffer.add_string buf; + Buffer.add_char buf ';'; + green t |> Int.to_string |> Buffer.add_string buf; + Buffer.add_char buf ';'; + blue t |> Int.to_string |> Buffer.add_string buf +end + module Style = struct type t = [ `Fg_default @@ -17,6 +80,8 @@ module Style = struct | `Fg_bright_magenta | `Fg_bright_cyan | `Fg_bright_white + | `Fg_8_bit_color of RGB8.t + | `Fg_24_bit_color of RGB24.t | `Bg_default | `Bg_black | `Bg_red @@ -34,54 +99,101 @@ module Style = struct | `Bg_bright_magenta | `Bg_bright_cyan | `Bg_bright_white + | `Bg_8_bit_color of RGB8.t + | `Bg_24_bit_color of RGB24.t | `Bold | `Dim | `Italic | `Underline ] - let to_ansi_code = function - | `Fg_default -> 39 - | `Fg_black -> 30 - | `Fg_red -> 31 - | `Fg_green -> 32 - | `Fg_yellow -> 33 - | `Fg_blue -> 34 - | `Fg_magenta -> 35 - | `Fg_cyan -> 36 - | `Fg_white -> 37 - | `Fg_bright_black -> 90 - | `Fg_bright_red -> 91 - | `Fg_bright_green -> 92 - | `Fg_bright_yellow -> 93 - | `Fg_bright_blue -> 94 - | `Fg_bright_magenta -> 95 - | `Fg_bright_cyan -> 96 - | `Fg_bright_white -> 97 - | `Bg_default -> 49 - | `Bg_black -> 40 - | `Bg_red -> 41 - | `Bg_green -> 42 - | `Bg_yellow -> 43 - | `Bg_blue -> 44 - | `Bg_magenta -> 45 - | `Bg_cyan -> 46 - | `Bg_white -> 47 - | `Bg_bright_black -> 100 - | `Bg_bright_red -> 101 - | `Bg_bright_green -> 102 - | `Bg_bright_yellow -> 103 - | `Bg_bright_blue -> 104 - | `Bg_bright_magenta -> 105 - | `Bg_bright_cyan -> 106 - | `Bg_bright_white -> 107 - | `Bold -> 1 - | `Dim -> 2 - | `Italic -> 3 - | `Underline -> 4 - - (* TODO use constructor names *) - let to_dyn s = Dyn.int (to_ansi_code s) + let write_to_buffer buf : t -> unit = function + | `Fg_default -> Buffer.add_string buf "39" + | `Fg_black -> Buffer.add_string buf "30" + | `Fg_red -> Buffer.add_string buf "31" + | `Fg_green -> Buffer.add_string buf "32" + | `Fg_yellow -> Buffer.add_string buf "33" + | `Fg_blue -> Buffer.add_string buf "34" + | `Fg_magenta -> Buffer.add_string buf "35" + | `Fg_cyan -> Buffer.add_string buf "36" + | `Fg_white -> Buffer.add_string buf "37" + | `Fg_bright_black -> Buffer.add_string buf "90" + | `Fg_bright_red -> Buffer.add_string buf "91" + | `Fg_bright_green -> Buffer.add_string buf "92" + | `Fg_bright_yellow -> Buffer.add_string buf "93" + | `Fg_bright_blue -> Buffer.add_string buf "94" + | `Fg_bright_magenta -> Buffer.add_string buf "95" + | `Fg_bright_cyan -> Buffer.add_string buf "96" + | `Fg_bright_white -> Buffer.add_string buf "97" + | `Fg_8_bit_color c -> RGB8.write_to_buffer buf c + | `Fg_24_bit_color rgb -> RGB24.write_to_buffer buf rgb + | `Bg_default -> Buffer.add_string buf "49" + | `Bg_black -> Buffer.add_string buf "40" + | `Bg_red -> Buffer.add_string buf "41" + | `Bg_green -> Buffer.add_string buf "42" + | `Bg_yellow -> Buffer.add_string buf "43" + | `Bg_blue -> Buffer.add_string buf "44" + | `Bg_magenta -> Buffer.add_string buf "45" + | `Bg_cyan -> Buffer.add_string buf "46" + | `Bg_white -> Buffer.add_string buf "47" + | `Bg_bright_black -> Buffer.add_string buf "100" + | `Bg_bright_red -> Buffer.add_string buf "101" + | `Bg_bright_green -> Buffer.add_string buf "102" + | `Bg_bright_yellow -> Buffer.add_string buf "103" + | `Bg_bright_blue -> Buffer.add_string buf "104" + | `Bg_bright_magenta -> Buffer.add_string buf "105" + | `Bg_bright_cyan -> Buffer.add_string buf "106" + | `Bg_bright_white -> Buffer.add_string buf "107" + | `Bg_8_bit_color c -> RGB8.write_to_buffer buf c + | `Bg_24_bit_color rgb -> RGB24.write_to_buffer buf rgb + | `Bold -> Buffer.add_string buf "1" + | `Dim -> Buffer.add_string buf "2" + | `Italic -> Buffer.add_string buf "3" + | `Underline -> Buffer.add_string buf "4" + + let to_dyn : t -> Dyn.t = function + | `Fg_default -> Dyn.variant "Fg_default" [] + | `Fg_black -> Dyn.variant "Fg_black" [] + | `Fg_red -> Dyn.variant "Fg_red" [] + | `Fg_green -> Dyn.variant "Fg_green" [] + | `Fg_yellow -> Dyn.variant "Fg_yellow" [] + | `Fg_blue -> Dyn.variant "Fg_blue" [] + | `Fg_magenta -> Dyn.variant "Fg_magenta" [] + | `Fg_cyan -> Dyn.variant "Fg_cyan" [] + | `Fg_white -> Dyn.variant "Fg_white" [] + | `Fg_bright_black -> Dyn.variant "Fg_bright_black" [] + | `Fg_bright_red -> Dyn.variant "Fg_bright_red" [] + | `Fg_bright_green -> Dyn.variant "Fg_bright_green" [] + | `Fg_bright_yellow -> Dyn.variant "Fg_bright_yellow" [] + | `Fg_bright_blue -> Dyn.variant "Fg_bright_blue" [] + | `Fg_bright_magenta -> Dyn.variant "Fg_bright_magenta" [] + | `Fg_bright_cyan -> Dyn.variant "Fg_bright_cyan" [] + | `Fg_bright_white -> Dyn.variant "Fg_bright_white" [] + | `Fg_8_bit_color c -> Dyn.variant "Fg_8_bit_color" [ RGB8.to_dyn c ] + | `Fg_24_bit_color rgb -> Dyn.variant "Fg_24_bit_color" [ RGB24.to_dyn rgb ] + | `Bg_default -> Dyn.variant "Bg_default" [] + | `Bg_black -> Dyn.variant "Bg_black" [] + | `Bg_red -> Dyn.variant "Bg_red" [] + | `Bg_green -> Dyn.variant "Bg_green" [] + | `Bg_yellow -> Dyn.variant "Bg_yellow" [] + | `Bg_blue -> Dyn.variant "Bg_blue" [] + | `Bg_magenta -> Dyn.variant "Bg_magenta" [] + | `Bg_cyan -> Dyn.variant "Bg_cyan" [] + | `Bg_white -> Dyn.variant "Bg_white" [] + | `Bg_bright_black -> Dyn.variant "Bg_bright_black" [] + | `Bg_bright_red -> Dyn.variant "Bg_bright_red" [] + | `Bg_bright_green -> Dyn.variant "Bg_bright_green" [] + | `Bg_bright_yellow -> Dyn.variant "Bg_bright_yellow" [] + | `Bg_bright_blue -> Dyn.variant "Bg_bright_blue" [] + | `Bg_bright_magenta -> Dyn.variant "Bg_bright_magenta" [] + | `Bg_bright_cyan -> Dyn.variant "Bg_bright_cyan" [] + | `Bg_bright_white -> Dyn.variant "Bg_bright_white" [] + | `Bg_8_bit_color c -> Dyn.variant "Bg_8_bit_color" [ RGB8.to_dyn c ] + | `Bg_24_bit_color rgb -> Dyn.variant "Bg_24_bit_color" [ RGB24.to_dyn rgb ] + | `Bold -> Dyn.variant "Bold" [] + | `Dim -> Dyn.variant "Dim" [] + | `Italic -> Dyn.variant "Italic" [] + | `Underline -> Dyn.variant "Underline" [] module Of_ansi_code = struct type code = t @@ -92,10 +204,10 @@ module Style = struct | code ] - let to_ansi_code_exn = function - | `Clear -> 0 - | `Unknown -> 0 - | #code as t -> to_ansi_code (t :> code) + let write_to_buffer (buf : Buffer.t) = function + | `Clear -> Buffer.add_char buf '0' + | `Unknown -> Buffer.add_char buf '0' + | #code as t -> write_to_buffer buf (t :> code) end let of_ansi_code : int -> Of_ansi_code.t = function @@ -157,7 +269,9 @@ module Style = struct | `Fg_bright_blue | `Fg_bright_magenta | `Fg_bright_cyan - | `Fg_bright_white -> false + | `Fg_bright_white + | `Fg_8_bit_color _ + | `Fg_24_bit_color _ -> false | _ -> true let is_not_bg = function @@ -177,15 +291,16 @@ module Style = struct | `Bg_bright_blue | `Bg_bright_magenta | `Bg_bright_cyan - | `Bg_bright_white -> false + | `Bg_bright_white + | `Bg_8_bit_color _ + | `Bg_24_bit_color _ -> false | _ -> true let rec write_codes buf = function | [] -> () - | [ t ] -> - Buffer.add_string buf (Int.to_string (Of_ansi_code.to_ansi_code_exn t)) + | [ t ] -> Of_ansi_code.write_to_buffer buf t | t :: ts -> - Buffer.add_string buf (Int.to_string (Of_ansi_code.to_ansi_code_exn t)); + Of_ansi_code.write_to_buffer buf t; Buffer.add_char buf ';'; write_codes buf ts @@ -228,7 +343,8 @@ let output_is_a_tty = lazy (Unix.isatty Unix.stderr) let stderr_supports_color = lazy (supports_color output_is_a_tty) let rec tag_handler buf current_styles ppf (styles : Style.t list) pp = - Format.pp_print_as ppf 0 (Style.escape_sequence_no_reset buf styles); + Format.pp_print_as ppf 0 + (Style.escape_sequence_no_reset buf (styles :> Style.Of_ansi_code.t list)); Pp.to_fmt_with_tags ppf pp ~tag_handler:(tag_handler buf (current_styles @ styles)); Format.pp_print_as ppf 0 @@ -285,6 +401,51 @@ let index_from_any str start chars = in go start +let rec parse_styles l (accu : Style.t list) = + (* This function takes a list of strings, taken from splitting an Ansi code on + ';', and adds the parsed styles to the already accumulated styles. There is + some non-trivial interaction with parsing here. For example, 8-bit and + 24-bit color codes need some lookahead and default colours need to be able + to override other styles. *) + match l with + | [] -> accu (* Parsing 8-bit foreground colors *) + | "38" :: "5" :: s :: l -> ( + match Int.of_string s with + | None -> parse_styles l accu + | Some code -> parse_styles l (`Fg_8_bit_color (RGB8.of_int code) :: accu)) + (* Parsing 8-bit background colors *) + | "48" :: "5" :: s :: l -> ( + match Int.of_string s with + | None -> parse_styles l accu + | Some code -> parse_styles l (`Bg_8_bit_color (RGB8.of_int code) :: accu)) + (* Parsing 24-bit foreground colors *) + | "38" :: "2" :: r :: g :: b :: l -> ( + match (Int.of_string r, Int.of_string g, Int.of_string b) with + | Some r, Some g, Some b -> + parse_styles l (`Fg_24_bit_color (RGB24.create ~r ~g ~b) :: accu) + | _ -> parse_styles l accu) + (* Parsing 24-bit background colors *) + | "48" :: "2" :: r :: g :: b :: l -> ( + match (Int.of_string r, Int.of_string g, Int.of_string b) with + | Some r, Some g, Some b -> + parse_styles l (`Bg_24_bit_color (RGB24.create ~r ~g ~b) :: accu) + | _ -> parse_styles l accu) + | s :: l -> + parse_styles l + (match Int.of_string s with + | None -> accu + | Some code -> ( + match Style.of_ansi_code code with + | `Clear -> [] + | `Unknown -> accu + (* If the foreground is set to default, we filter out any + other foreground modifiers. Same for background. *) + | `Fg_default -> List.filter accu ~f:Style.is_not_fg + | `Bg_default -> List.filter accu ~f:Style.is_not_bg + | #Style.t as s -> s :: accu)) + +let parse_styles styles l = parse_styles l (List.rev styles) |> List.rev + let parse_line str styles = let len = String.length str in let add_chunk acc ~styles ~pos ~len = @@ -317,20 +478,7 @@ let parse_line str styles = [] else String.sub str ~pos:seq_start ~len:(seq_end - seq_start) - |> String.split ~on:';' - |> List.fold_left ~init:(List.rev styles) ~f:(fun styles s -> - match Int.of_string s with - | None -> styles - | Some code -> ( - match Style.of_ansi_code code with - | `Clear -> [] - | `Unknown -> styles - (* If the foreground is set to default, we filter out any - other foreground modifiers. Same for background. *) - | `Fg_default -> List.filter styles ~f:Style.is_not_fg - | `Bg_default -> List.filter styles ~f:Style.is_not_bg - | #Style.t as s -> s :: styles)) - |> List.rev + |> String.split ~on:';' |> parse_styles styles in loop styles (seq_end + 1) acc | Some (seq_end, _) -> loop styles (seq_end + 1) acc) diff --git a/otherlibs/stdune/src/ansi_color.mli b/otherlibs/stdune/src/ansi_color.mli index 8b8f091ab03d..bf7ef1cfc780 100644 --- a/otherlibs/stdune/src/ansi_color.mli +++ b/otherlibs/stdune/src/ansi_color.mli @@ -1,4 +1,27 @@ +module RGB8 : sig + (** 8 bit RGB color *) + type t + + (** [RGB8.to_int t] returns the [int] value of [t] as an 8 bit integer. *) + val to_int : t -> int +end + +module RGB24 : sig + (** 24 bit RGB color *) + type t + + (** [RGB24.red t] returns the red component of [t] *) + val red : t -> int + + (** [RGB24.green t] returns the green component of [t] *) + val green : t -> int + + (** [RGB24.blue t] returns the blue component of [t] *) + val blue : t -> int +end + module Style : sig + (** ANSI terminal styles *) type t = [ `Fg_default | `Fg_black @@ -17,6 +40,8 @@ module Style : sig | `Fg_bright_magenta | `Fg_bright_cyan | `Fg_bright_white + | `Fg_8_bit_color of RGB8.t + | `Fg_24_bit_color of RGB24.t | `Bg_default | `Bg_black | `Bg_red @@ -34,6 +59,8 @@ module Style : sig | `Bg_bright_magenta | `Bg_bright_cyan | `Bg_bright_white + | `Bg_8_bit_color of RGB8.t + | `Bg_24_bit_color of RGB24.t | `Bold | `Dim | `Italic diff --git a/otherlibs/stdune/src/int.ml b/otherlibs/stdune/src/int.ml index c01f905ed98b..d545ee722e69 100644 --- a/otherlibs/stdune/src/int.ml +++ b/otherlibs/stdune/src/int.ml @@ -25,3 +25,7 @@ let to_string i = string_of_int i module Infix = Comparator.Operators (T) let of_string s = int_of_string_opt s + +let shift_left = Stdlib.Int.shift_left + +let shift_right = Stdlib.Int.shift_right diff --git a/otherlibs/stdune/src/int.mli b/otherlibs/stdune/src/int.mli index 912fae44f598..9a9ac7b9fb85 100644 --- a/otherlibs/stdune/src/int.mli +++ b/otherlibs/stdune/src/int.mli @@ -17,3 +17,7 @@ val of_string : string -> t option val to_string : t -> string module Infix : Comparator.OPS with type t = t + +val shift_left : t -> t -> t + +val shift_right : t -> t -> t diff --git a/otherlibs/stdune/test/ansi_color_tests.ml b/otherlibs/stdune/test/ansi_color_tests.ml index 8316fdd61927..bfaeb3e8bb00 100644 --- a/otherlibs/stdune/test/ansi_color_tests.ml +++ b/otherlibs/stdune/test/ansi_color_tests.ml @@ -71,38 +71,46 @@ let%expect_test "reproduce #2664" = Seq Seq Seq - Seq Nop,Tag [ 34 ],Verbatim "1", + Seq + Nop,Tag [ Fg_blue ],Verbatim "1", Tag - [ 34 ],Verbatim "2",Tag - [ 34 ], - Verbatim - "3", - Tag - [ 34 ],Verbatim "4",Tag - [ 34 ], - Verbatim - "5",Tag - [ 34 ], + [ Fg_blue ],Verbatim "2", + Tag + [ Fg_blue ],Verbatim "3",Tag + [ Fg_blue + ], Verbatim - "6", + "4", + Tag + [ Fg_blue ],Verbatim "5",Tag + [ Fg_blue ], + Verbatim + "6", Tag - [ 34 ],Verbatim "7",Tag [ 34 ],Verbatim "8", - Tag - [ 34 ],Verbatim "9",Tag [ 34 ],Verbatim "10", - Tag - [ 34 ],Verbatim "11",Tag [ 34 ],Verbatim "12", - Tag - [ 34 ],Verbatim "13",Tag [ 34 ],Verbatim "14",Tag - [ 34 ], + [ Fg_blue ],Verbatim "7",Tag + [ Fg_blue ], + Verbatim + "8",Tag + [ Fg_blue + ], Verbatim - "15", + "9", + Tag + [ Fg_blue ],Verbatim "10",Tag + [ Fg_blue ],Verbatim + "11", + Tag + [ Fg_blue ],Verbatim "12",Tag + [ Fg_blue ],Verbatim "13", + Tag + [ Fg_blue ],Verbatim "14",Tag [ Fg_blue ],Verbatim "15", Tag - [ 34 ],Verbatim "16",Tag [ 34 ],Verbatim "17",Tag - [ 34 ], - Verbatim - "18", - Tag - [ 34 ],Verbatim "19",Tag [ 34 ],Verbatim "20" |}] + [ Fg_blue ],Verbatim "16",Tag [ Fg_blue ],Verbatim "17", + Tag + [ Fg_blue ],Verbatim "18",Tag [ Fg_blue ],Verbatim "19",Tag + [ Fg_blue + ],Verbatim + "20" |}] let%expect_test "Ansi_color.strip" = print_string @@ -119,3 +127,215 @@ the lazy fox jumps over the brown dog the lazy fox jumps over the brown dog the lazy fox jumps over the brown dog the lazy fox jumps over|}] + +let%expect_test "parse fg and bg colors" = + let example = + "This is a \027[34mblue\027[39m string with \027[31mred\027[39m and \ + \027[32mgreen\027[39m together with strings of a \027[44mblue \ + blackground\027[49m and \027[41mred background\027[49m and \027[42mgreen \ + background\027[49m" + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| +Vbox + 0,Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq Nop,Verbatim "This is a ",Tag + [ Fg_blue ], + Verbatim + "blue",Verbatim + " string with ", + Tag + [ Fg_red ],Verbatim "red",Verbatim " and ",Tag + [ Fg_green + ], + Verbatim + "green", + Verbatim + " together with strings of a ",Tag + [ Bg_blue ],Verbatim + "blue blackground", + Verbatim + " and ",Tag [ Bg_red ],Verbatim "red background",Verbatim + " and ", + Tag + [ Bg_green ],Verbatim "green background" |}] + +let%expect_test "parse multiple fg and bg colors" = + let example = + "This text is \027[34;41mblue string with a red background\027[0m and \ + \027[32;44mgreen string with a blue background\027[0m" + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| +Vbox + 0,Seq + Seq + Seq + Seq Nop,Verbatim "This text is ",Tag + [ Fg_blue; Bg_red ],Verbatim + "blue string with a red background", + Verbatim + " and ",Tag + [ Fg_green; Bg_blue ],Verbatim + "green string with a blue background" |}] + +let%expect_test "fg default overrides" = + let example = + "This text has a \027[34mblue foreground\027[39m but here it becomes the \ + default foreground,\027[34;39m even together with another foreground \ + modifier." + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| + Vbox + 0,Seq + Seq + Seq + Seq Nop,Verbatim "This text has a ",Tag + [ Fg_blue ],Verbatim + "blue foreground", + Verbatim + " but here it becomes the default foreground,",Verbatim + " even together with another foreground modifier." |}] + +let%expect_test "bg default overrides" = + let example = + "This text has a \027[44mblue background\027[49m but here it becomes the \ + default background,\027[44;49m even together with another background \ + modifier." + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| +Vbox + 0,Seq + Seq + Seq + Seq Nop,Verbatim "This text has a ",Tag + [ Bg_blue ],Verbatim + "blue background", + Verbatim + " but here it becomes the default background,",Verbatim + " even together with another background modifier." |}] + +let%expect_test "parse 8-bit colors" = + let example = + "This is a \027[38;5;33mblue\027[39m string with \027[38;5;196mred\027[39m \ + and \027[38;5;46mgreen\027[39m together with strings of a \ + \027[48;5;33mblue blackground\027[49m and \027[48;5;196mred \ + background\027[49m and \027[48;5;46mgreen background\027[49m" + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| +Vbox + 0,Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq Nop,Verbatim "This is a ",Tag + [ Fg_8_bit_color 33 + ],Verbatim "blue", + Verbatim + " string with ",Tag + [ Fg_8_bit_color 196 ],Verbatim + "red", + Verbatim + " and ",Tag [ Fg_8_bit_color 46 ],Verbatim "green", + Verbatim + " together with strings of a ",Tag + [ Bg_8_bit_color 33 ], + Verbatim + "blue blackground", + Verbatim + " and ",Tag [ Bg_8_bit_color 196 ],Verbatim "red background", + Verbatim + " and ",Tag [ Bg_8_bit_color 46 ],Verbatim "green background" |}] + +let%expect_test "parse 24-bit colors" = + let example = + "This is a \027[38;2;255;0;0mblue\027[39m string with \ + \027[38;2;0;255;0mred\027[39m and \027[38;2;0;0;255mgreen\027[39m \ + together with strings of a \027[48;2;255;0;0mblue blackground\027[49m and \ + \027[48;2;0;255;0mred background\027[49m and \027[48;2;0;0;255mgreen \ + background\027[49m" + in + Ansi_color.parse example + |> dyn_of_pp (Dyn.list Ansi_color.Style.to_dyn) + |> Dyn.pp + |> Format.printf "%a@.%!" Pp.to_fmt; + [%expect + {| + Vbox + 0,Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq Nop,Verbatim "This is a ",Tag + [ Fg_24_bit_color + [ 255; 0; 0 ] + ],Verbatim "blue", + Verbatim + " string with ",Tag + [ Fg_24_bit_color [ 0; 255; 0 ] ], + Verbatim + "red",Verbatim " and ", + Tag + [ Fg_24_bit_color [ 0; 0; 255 ] ],Verbatim "green", + Verbatim + " together with strings of a ",Tag + [ Bg_24_bit_color + [ 255; 0; 0 ] + ],Verbatim + "blue blackground", + Verbatim + " and ",Tag + [ Bg_24_bit_color [ 0; 255; 0 ] ],Verbatim + "red background", + Verbatim + " and ",Tag + [ Bg_24_bit_color [ 0; 0; 255 ] ],Verbatim + "green background" +|}] diff --git a/src/dune_tui/dune_tui.ml b/src/dune_tui/dune_tui.ml index 810b583878dc..f7db557cd2e4 100644 --- a/src/dune_tui/dune_tui.ml +++ b/src/dune_tui/dune_tui.ml @@ -1,5 +1,38 @@ open Stdune +let attr_of_ansi_color_rgb8 (c : Ansi_color.RGB8.t) = + let module A = Notty.A in + match Ansi_color.RGB8.to_int c with + | 0 -> A.black + | 1 -> A.red + | 2 -> A.green + | 3 -> A.yellow + | 4 -> A.blue + | 5 -> A.magenta + | 6 -> A.cyan + | 7 -> A.white + | 8 -> A.lightblack + | 9 -> A.lightred + | 10 -> A.lightgreen + | 11 -> A.lightyellow + | 12 -> A.lightblue + | 13 -> A.lightmagenta + | 14 -> A.lightcyan + | 15 -> A.lightwhite + | i when i <= 231 -> + let i = i - 16 in + let r = i / 36 in + let g = i / 6 mod 6 in + let b = i mod 6 in + A.rgb ~r ~g ~b + | i when i <= 255 -> A.gray (i - 232) + | i -> Code_error.raise "invalid 8-bit color" [ ("value", Dyn.int i) ] + +let attr_of_ansi_color_rgb24 (c : Ansi_color.RGB24.t) = + let module A = Notty.A in + A.rgb ~r:(Ansi_color.RGB24.red c) ~g:(Ansi_color.RGB24.green c) + ~b:(Ansi_color.RGB24.blue c) + let attr_of_ansi_color_style (s : Ansi_color.Style.t) = let module A = Notty.A in match s with @@ -20,6 +53,8 @@ let attr_of_ansi_color_style (s : Ansi_color.Style.t) = | `Fg_bright_magenta -> A.(fg lightmagenta) | `Fg_bright_cyan -> A.(fg lightcyan) | `Fg_bright_white -> A.(fg lightwhite) + | `Fg_8_bit_color c -> A.fg (attr_of_ansi_color_rgb8 c) + | `Fg_24_bit_color c -> A.fg (attr_of_ansi_color_rgb24 c) | `Bg_black -> A.(bg black) | `Bg_red -> A.(bg red) | `Bg_green -> A.(bg green) @@ -37,6 +72,8 @@ let attr_of_ansi_color_style (s : Ansi_color.Style.t) = | `Bg_bright_magenta -> A.(bg lightmagenta) | `Bg_bright_cyan -> A.(bg lightcyan) | `Bg_bright_white -> A.(bg lightwhite) + | `Bg_8_bit_color c -> A.bg (attr_of_ansi_color_rgb8 c) + | `Bg_24_bit_color c -> A.bg (attr_of_ansi_color_rgb24 c) | `Bold -> A.(st bold) | `Italic -> A.(st italic) | `Dim -> A.(st dim)