Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 97 lines (82 sloc) 2.349 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 type color =
20 [ `black
21 | `red
22 | `green
23 | `yellow
24 | `blue
25 | `magenta
26 | `cyan
27 | `white ]
28
29 let color = function
30 | `black -> 0
31 | `red -> 1
32 | `green -> 2
33 | `yellow -> 3
34 | `blue -> 4
35 | `magenta -> 5
36 | `cyan -> 6
37 | `white -> 7
38
39 let foreground c = 30 + color c
40 let background c = 40 + color c
41
42 let open_color_code c = Printf.sprintf "\027[%dm" (foreground c)
43 let close_color_code = "\027[0m"
44
45 (** all call to produce color come from here,
46 so this global propertie is here to enforce that
47 no any production are in color *)
48 let set_ignore_color, get_ignore_color =
49 let __ignore_color = ref false in
50 (fun b -> __ignore_color := b), (fun () -> !__ignore_color)
51
52 let print =
53 if Sys.os_type = "Win32" then
54 fun (_:color) s -> s
55 else
56 fun (c:color) s ->
57 if get_ignore_color () then s else
58 match c with
59 | `black -> s
60 | c -> Printf.sprintf "%s%s%s" (open_color_code c) s close_color_code
61
62 let string_of_color = function
63 | `black -> "black"
64 | `red -> "red"
65 | `green -> "green"
66 | `yellow -> "yellow"
67 | `blue -> "blue"
68 | `magenta -> "magenta"
69 | `cyan -> "cyan"
70 | `white -> "white"
71
72 let color_of_string = function
73 | "black" -> Some `black
74 | "red" -> Some `red
75 | "green" -> Some `green
76 | "yellow" -> Some `yellow
77 | "blue" -> Some `blue
78 | "magenta" -> Some `magenta
79 | "cyan" -> Some `cyan
80 | "white" -> Some `white
81 | _ -> None
82
83 let symbols = [
84 "black"; "red"; "green"; "yellow"; "blue"; "magenta"; "cyan"; "white"
85 ]
86
87 let uncolor = function
88 | 0 -> `black
89 | 1 -> `red
90 | 2 -> `green
91 | 3 -> `yellow
92 | 4 -> `blue
93 | 5 -> `magenta
94 | 6 -> `cyan
95 | 7 -> `white
96 | _ -> assert false
Something went wrong with that request. Please try again.