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
type plain =
[ `black | `blue | `cyan | `green | `magenta | `red | `white | `yellow ]
type t = Ansi of [ plain | `bright of plain ] | Rgb of int * int * int
let pp_plain ppf x =
Format.fprintf ppf
(match x with
| `black -> "black"
| `blue -> "blue"
| `cyan -> "cyan"
| `green -> "green"
| `magenta -> "magenta"
| `red -> "red"
| `white -> "white"
| `yellow -> "yellow")
let pp_dump ppf = function
| Rgb (r, g, b) -> Format.fprintf ppf "RGB (%d, %d, %d)" r g b
| Ansi (#plain as x) -> Format.fprintf ppf "ANSI (%a)" pp_plain x
| Ansi (`bright x) -> Format.fprintf ppf "ANSI (bright %a)" pp_plain x
let ansi x = Ansi x
let rgb =
let invalid_component typ n =
Format.kasprintf invalid_arg "Color.rgb: invalid %s component %d" typ n
in
fun r g b ->
if r < 0 || r > 255 then invalid_component "red" r;
if g < 0 || g > 255 then invalid_component "green" g;
if b < 0 || b > 255 then invalid_component "blue" b;
Rgb (r, g, b)
let hex =
let invalid_length =
Format.kasprintf invalid_arg "Color.hex: invalid hexstring length %d"
in
let hex c =
if c >= '0' && c <= '9' then Char.code c - Char.code '0'
else if c >= 'a' && c <= 'f' then Char.code c - Char.code 'a' + 10
else if c >= 'A' && c <= 'F' then Char.code c - Char.code 'A' + 10
else
Format.kasprintf invalid_arg "Color.hex: invalid hexstring character %c" c
in
fun s ->
let len = String.length s in
if len = 0 then invalid_length len;
if s.[0] <> '#' then invalid_arg "Color.hex: hexstrings must start with '#'";
let r1, r0, g1, g0, b1, b0 =
match len with
| 7 -> (hex s.[1], hex s.[2], hex s.[3], hex s.[4], hex s.[5], hex s.[6])
| 4 ->
let r, g, b = (hex s.[1], hex s.[2], hex s.[3]) in
(r, r, g, g, b, b)
| _ -> invalid_length len
in
rgb ((16 * r1) + r0) ((16 * g1) + g0) ((16 * b1) + b0)