Source file convert.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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
(** Color conversion utilities for terminal output.

    Provides functions to convert RGB colors to ANSI color codes using
    different quantization strategies. *)

open Utils

(** Reference to the Palette module from spectrum_palette_ppx. *)
module Palette = Spectrum_palette_ppx.Palette

(*
  What we call "ansi256" here are the xterm 256 color palette
  i.e. colours set by using the ESC[38;5;<code>m sequence

  The palette is organised such that:

    0-15: the basic 'system' colours, RGB values of 0, 128, 255
      plus an extra grey of 192,192,192
    16-231: non-grey colours, RGB values of 0, 95, 135, 175, 215, 255
      so intervals of 40 with darkest interval missing and all offset +15
    232-255: greys in intervals of 10, offset and truncated to 8..238

  The non-grey colours are organised into 'rows', with the six values of
  the B component as columns - the rows start with R:0 and G:0,
  incrementing G for the current R before incrementing R.
  starting at 16: 0,0,0

  The 16 basic colours are organised as:
    0: 0,0,0
    1-6: combinations of 0,128
    7: 192,192,192
    8: 128,128,128
    9-14: combinations of 0,255 (symmetrical to 1-6)
    15: 255,255,255

  NOTE: there are no 128+255 combinations, only 0+128 and 0+255

  (RGB values according to https://www.ditig.com/256-colors-cheat-sheet)

  but terminals are configurable and Wikipedia shows different apps
  choose different defaults for the 16 colour base palette:
  https://en.wikipedia.org/wiki/ANSI_escape_code#3-bit_and_4-bit
*)

(** Extended Color module with additional types and conversion functions. *)
module Color = struct
  include Color

  (** RGBA color type with integer components (0-255) and float alpha (0.0-1.0). *)
  module Rgba = struct
    type t = { r : int; g : int; b : int; a : float }
  end

  (** RGBA color type with float components (0.0-1.0). *)
  module Rgba' = struct
    type t = { r : float; g : float; b : float; a : float }
  end

  (** Create a color from RGB integer values (0-255). *)
  let of_rgb r g b = Rgb.(v r g b |> to_gg)

  (** Convert a color to RGBA with integer components. *)
  let to_rgba color =
    let c = Gg.Color.to_srgb color in
    {
      Rgba.r = int_of_float (Float.round (255. *. Gg.Color.r c));
      g = int_of_float (Float.round (255. *. Gg.Color.g c));
      b = int_of_float (Float.round (255. *. Gg.Color.b c));
      a = Gg.Color.a c;
    }

  (** Convert a color to RGBA with float components. *)
  let to_rgba' color =
    let c = Gg.Color.to_srgb color in
    {
      Rgba'.r = Gg.Color.r c;
      g = Gg.Color.g c;
      b = Gg.Color.b c;
      a = Gg.Color.a c;
    }

  (** Create a color from HSL values. *)
  let of_hsl h s l = Hsl.(v h s l |> to_gg)

  (** HSVA color type (Hue, Saturation, Value, Alpha). *)
  module Hsva = struct
    type t = {h: float; s: float; v: float; a: float}
  end

  (** Convert a color to HSVA representation.
      https://github.com/Qix-/color-convert/blob/master/conversions.js#L94 *)
  let to_hsva color_v4 : Hsva.t =
    let c = to_rgba' color_v4 in
    let v = max3 c.r c.g c.b in
    let diff = v -. (min3 c.r c.g c.b) in
    let diffc c' = (v -. c') /. 6. /. (diff +. 1.) /. 2. in
    let h, s = match diff with
      | 0. -> 0., 0.
      | _ -> begin
          let rdiff = diffc c.r
          and gdiff = diffc c.g
          and bdiff = diffc c.b in
          let s = diff /. v in
          let h =
            if c.r == v then
              bdiff -. gdiff
            else if c.g == v then
              (1. /. 3.) +. rdiff -. bdiff
            else
              (2. /. 3.) +. gdiff -. rdiff
          in
          let h =
            if h < 0. then
              h +. 1.
            else if h > 1. then
              h -. 1.
            else
              h
          in
          h, s
        end
    in
    {
      h = h *. 360.;
      s = s *. 100.;
      v = v *. 100.;
      a = 1.;
    }
end

(** Converter module type for RGB to ANSI color code conversion. *)
module type Converter = sig
  (** Convert RGB color to ANSI-256 color code (0-255).
      @param grey_threshold Optional threshold for grey detection (currently unused). *)
  val rgb_to_ansi256 : ?grey_threshold:int -> Gg.v4 -> int

  (** Convert RGB color to ANSI-16 color code (30-37, 90-97). *)
  val rgb_to_ansi16 : Gg.v4 -> int
end


(** Perceptual color converter using LAB color space for nearest-neighbor matching.

    This converter uses the CIE LAB color space to find the nearest terminal color,
    which provides better perceptual accuracy than Euclidean RGB distance.

    For perceptual matching we delegate nearest-colour search to the shared
    `spectrum_palettes` modules, which expose [nearest] backed by an octree
    built in LAB space (see spectrum_palette_ppx/palette.ml).

    For ANSI-16 we search the full 16-colour palette.
    For ANSI-256 we preserve historical behaviour by searching only xterm
    codes 16..255 (colour cube + greys), excluding basic codes 0..15.

    Idea:
    Possibly the 'OKLab' colourspace is even better for perceptual matching
    See: https://meat.io/oksolar
    https://bottosson.github.io/posts/oklab/
    ...but for now it's convenient that Gg already provides LAB conversion *)
module Perceptual : Converter = struct
  module Ansi16_palette = Spectrum_palettes.Terminal.Basic

  module Ansi256_palette = Spectrum_palettes.Terminal.Xterm256

  (* Match historical behaviour: ansi256 conversion targets xterm codes 16-255
     (colour cube + greys), not the basic 0-15 ANSI colours. *)
  let ansi256_target_colors =
    List.filteri (fun i _ -> i >= 16) Ansi256_palette.color_list

  let ansi256_nearest = Palette.nearest_of_list ansi256_target_colors

  let index_of_color_exn colors target ~msg =
    let rec find_index i = function
      | [] -> invalid_arg msg
      | c :: rest ->
        if c = target then i else find_index (i + 1) rest
    in
    find_index 0 colors

  let rgb_to_ansi16_code (r, g, b) =
    (* Find the matching color in the palette and return its code *)
    let target = Color.of_rgb r g b in
    let i =
      index_of_color_exn
        Ansi16_palette.color_list
        target
        ~msg:"Not in ANSI 16-color palette"
    in
    if i < 8 then 30 + i else 90 + (i - 8)

  let rgb_to_ansi256 ?grey_threshold:_ color_v4 =
    let i =
      ansi256_nearest color_v4
      |> index_of_color_exn
        ansi256_target_colors
        ~msg:"Not in ANSI 256-color target palette"
    in
    i + 16

  let rgb_to_ansi16 color_v4 =
    Ansi16_palette.nearest color_v4
    |> Color.to_rgba
    |> fun c -> rgb_to_ansi16_code (c.r, c.g, c.b)

end