Source file ANSI_Rendering.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
open Style

let color_value (i, c) =
  let color_value_aux =
    match c with
    | Black -> 0
    | Red -> 1
    | Green -> 2
    | Yellow -> 3
    | Blue -> 4
    | Magenta -> 5
    | Cyan -> 6
    | White -> 7 in
  match i with
  | Standard -> color_value_aux
  | High -> 8 + color_value_aux

(* See https://stackoverflow.com/questions/4842424/list-of-ansi-color-escape-sequences/33206814#33206814 *)

let rendering_to_value ?(strict=false) = function
  | Close _ when not strict -> "0"
  | Open No -> "0"
  | Close No -> "0" 
  | Open Bold -> "1"
  | Close Bold -> "22" 
  | Open Faint -> "2"
  | Close Faint -> "22" 
  | Open Italic -> "3"
  | Close Italic -> "23" 
  | Open Underline -> "4"
  | Close Underline -> "24" 
  | Open FG (Code c) -> Printf.sprintf "38;5;%d" (color_value c)
  | Open FG (RGB (r,g,b)) -> Printf.sprintf "38;2;%d;%d;%d" r g b
  | Close (FG _ )-> "39" 
  | Open BG (Code c) -> Printf.sprintf "48;5;%d" (color_value c)
  | Open BG (RGB (r,g,b)) -> Printf.sprintf "48;;2;%d;%d;%d" r g b
  | Close (BG _ ) -> "49" 

let render_att ~strict a =
  Printf.sprintf "\027[%sm" (rendering_to_value ~strict a)

let render_aux attr =
  let brackets =
    function
    | No -> Open No, Close No
    | Bold -> Open Bold, Close Bold
    | Faint -> Open Faint, Close Faint
    | Italic -> Open Italic, Close Italic
    | Underline -> Open Underline, Close Underline
    | FG color -> Open (FG color), Close (FG color)
    | BG color -> Open (BG color), Close (BG color) in
  List.fold_right
    (fun style (o, c) ->
      let o', c' = brackets style in
      o'::o, c'::c)
    attr
    ([], [])

let render att s =
  let o, c = render_aux att in
  let buff = Buffer.create (String.length s) in
  let () =
    List.iter (fun a -> Buffer.add_string buff (render_att ~strict:true a)) o in
  let () = Buffer.add_string buff s in
  let () = List.iter (fun a -> Buffer.add_string buff (render_att ~strict:true a)) c in
  Buffer.contents buff

let render_mark att = 
  let buff = Buffer.create 2 in
  let () =
    List.iter (fun a -> Buffer.add_string buff (render_att ~strict:true a)) att in
  Buffer.contents buff