79 lines
2.4 KiB
OCaml
79 lines
2.4 KiB
OCaml
open Types
|
|
open Seq
|
|
|
|
let match_env_order =
|
|
let open Types in
|
|
function
|
|
| "rainbow-pair" -> RainbowPair
|
|
| "rainbow-split" -> RainbowSplit
|
|
| "tonepair" -> TonePair
|
|
| "straight" -> Straight
|
|
| "default" -> Default
|
|
| "random" -> Random
|
|
| s -> (
|
|
let parse = Parse.parse_env_order s in
|
|
parse |> function [||] -> Straight | e -> Explicit e)
|
|
|
|
let ( >>= ) = Option.bind
|
|
|
|
let get_env_colours =
|
|
Sys.getenv_opt "CULRS" >>= fun s ->
|
|
if String.length s > 0 then Some s else None
|
|
|
|
let get_env_order =
|
|
Sys.getenv_opt "CULR_ORDER" >>= fun s ->
|
|
if String.length s > 0 then Some s else None
|
|
|
|
let to_sixteen f = ints 0 |> take 16 |> f |> Array.of_seq
|
|
|
|
let permute (order : order) (colours : colour array) =
|
|
let open Array in
|
|
let make_simple = map (fun i -> Simple i) in
|
|
match order with
|
|
| Explicit e ->
|
|
let clen = length colours in
|
|
e
|
|
|> map (fun index ->
|
|
if index < clen then colours.(index) else Simple index)
|
|
| RainbowPair ->
|
|
[| 0; 8; 1; 9; 3; 11; 2; 10; 6; 14; 4; 12; 5; 13; 7; 15 |] |> make_simple
|
|
| RainbowSplit ->
|
|
[| 0; 8; 1; 3; 2; 6; 4; 5; 9; 11; 10; 14; 12; 13; 7; 15 |] |> make_simple
|
|
| TonePair ->
|
|
let open Seq in
|
|
let lows = ints 0 |> take 8 in
|
|
let highs = lows |> map (fun i -> i + 8) in
|
|
interleave lows highs |> Array.of_seq |> make_simple
|
|
| Straight ->
|
|
let open Seq in
|
|
ints 0 |> take 16 |> Array.of_seq |> make_simple
|
|
| Default ->
|
|
let open Seq in
|
|
ints 0 |> take 16
|
|
|> filter (fun i -> not (i = 0 || i = 8))
|
|
|> Array.of_seq |> make_simple
|
|
| Random ->
|
|
Random.self_init ();
|
|
shuffle ~rand:Random.int colours;
|
|
colours
|
|
|
|
let get_colours =
|
|
let colours = get_env_colours
|
|
and order = get_env_order
|
|
and init_default_colours = to_sixteen (map (fun x -> Types.Simple x))
|
|
and init_order_for_colours c =
|
|
let open Seq in
|
|
ints 0 |> take (Array.length c) |> Array.of_seq
|
|
in
|
|
match (colours, order) with
|
|
| None, None -> permute Default init_default_colours
|
|
| None, Some o -> permute (match_env_order o) init_default_colours
|
|
| Some c, None ->
|
|
let colours = Parse.parse_env_colours c in
|
|
permute (Explicit (init_order_for_colours colours)) colours
|
|
| Some c, Some o -> (
|
|
let colours = Parse.parse_env_colours c and order = match_env_order o in
|
|
match order with
|
|
| Explicit _ | Random -> permute order colours
|
|
| _ -> colours)
|