Source file palette.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
(*****************************************************************************)
(*                                                                           *)
(* SPDX-License-Identifier: MIT                                              *)
(* Copyright (c) 2025 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(*****************************************************************************)

type gradient_dir = Up | Right | DownRight

type t = {
  (* Brand-specific names removed; use generic aliases below. *)
  fg_primary : string -> string;
  fg_secondary : string -> string;
  fg_muted : string -> string;
  bg_primary : string -> string;
  fg_stealth : string -> string;
  bg_stealth : string -> string;
  fg_slate : string -> string;
  bg_slate : string -> string;
  fg_steel : string -> string;
  bg_steel : string -> string;
  fg_white : string -> string;
  bg_white : string -> string;
  purple_gradient : string -> string;
  purple_gradient_at :
    gradient_dir -> total_visible:int -> start_pos:int -> string -> string;
  purple_gradient_line : gradient_dir -> string -> string;
  fg_success : string -> string;
  fg_error : string -> string;
  selection_bg : string -> string;
  selection_fg : string -> string;
  fixed_region_bg : string -> string;
  header_bg : string -> string;
}

let id s = s

let default : t =
  {
    fg_primary = id;
    fg_secondary = id;
    fg_muted = id;
    bg_primary = id;
    fg_stealth = id;
    bg_stealth = id;
    fg_slate = id;
    bg_slate = id;
    fg_steel = id;
    bg_steel = id;
    fg_white = id;
    bg_white = id;
    purple_gradient = id;
    purple_gradient_at = (fun _dir ~total_visible:_ ~start_pos:_ s -> s);
    purple_gradient_line = (fun _dir s -> s);
    fg_success = id;
    fg_error = id;
    selection_bg = id;
    selection_fg = id;
    fixed_region_bg = id;
    header_bg = id;
  }

let current : t option ref = ref (Some default)

let set t = current := Some t

let get () = !current

let require () =
  match !current with
  | Some t -> t
  | None -> failwith "Miaou Palette not registered"