From 3fc9c2e2c8d58984e7912b16b43dbc3f0d09e160 Mon Sep 17 00:00:00 2001 From: atagen Date: Wed, 4 Dec 2024 14:28:40 +1100 Subject: [PATCH] overhaul colour/ordering system for coherency squash --- bin/main.ml | 2 +- lib/env.ml | 85 ++++++++++++++++++++++++++++++++++++++++------- lib/env.mli | 3 +- lib/pipes.ml | 6 ++-- lib/processing.ml | 23 ++----------- lib/types.ml | 9 +++++ 6 files changed, 90 insertions(+), 38 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 0819361..f58c299 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,3 +1,3 @@ open Culr -let () = Pipes.read_all Env.colours Env.order +let () = Pipes.read_all Env.get_colours \ No newline at end of file diff --git a/lib/env.ml b/lib/env.ml index e7db676..5072dd3 100644 --- a/lib/env.ml +++ b/lib/env.ml @@ -1,17 +1,78 @@ +open Types open Seq -let to_sixteen f = ints 0 |> take 16 |> f |> Array.of_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 ( =!? ) = fun el col -> not (Array.mem el col) -let colours = - let init_default = to_sixteen (map (fun x -> Types.Simple x)) in - Sys.getenv_opt "CULRS" - >>= (fun s -> if String.length s > 0 then Some s else None) - |> Option.fold ~none:init_default ~some:Parse.parse_env_colours +let get_env_colours = + Sys.getenv_opt "CULRS" >>= fun s -> + if String.length s > 0 then Some s else None -let order = - let init_default = to_sixteen (filter (fun i -> i =!? [| 0; 8 |])) in - Sys.getenv_opt "CULR_ORDER" - >>= (fun s -> if String.length s > 0 then Some s else None) - |> Option.fold ~none:init_default ~some:Parse.parse_env_order +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) diff --git a/lib/env.mli b/lib/env.mli index 2613ce3..7634a75 100644 --- a/lib/env.mli +++ b/lib/env.mli @@ -1,2 +1 @@ -val colours : Types.colour array -val order : int array +val get_colours : Types.colour array diff --git a/lib/pipes.ml b/lib/pipes.ml index 0351352..c3bc423 100644 --- a/lib/pipes.ml +++ b/lib/pipes.ml @@ -1,13 +1,13 @@ open Processing -let read_all colours order = +let read_all colours = In_channel.set_binary_mode stdin true; let open Types in - let t = Emitter.create and culr = Culriser.create order [] colours in + let t = Emitter.create and culr = Culriser.create colours in Emitter.serialise t (Ansi [ Fg (Culriser.next culr) ]); Angstrom_unix.parse_many ~buf_size:4096 Parse.culr_parse (fun c -> c |> ansi_filter |> Culriser.serialise_with_colour culr t) stdin |> function | _, Ok _ -> Emitter.flush t - | _ -> () + | _, Error e -> prerr_endline ("error encountered:" ^ e) \ No newline at end of file diff --git a/lib/processing.ml b/lib/processing.ml index 83a8d05..ccb3aaf 100644 --- a/lib/processing.ml +++ b/lib/processing.ml @@ -10,22 +10,6 @@ let ansi_filter s = a) | n -> n -let permute (order : int array) (colours : colour array) = - let olen = length order and clen = length colours in - match (olen, clen) with - (* nothing provided, take default 16 pal colours *) - | 0, 0 -> Seq.ints 0 |> Seq.take 16 |> Seq.map (fun i -> Simple i) |> of_seq - (* colours provided with no order, take them as is *) - | 0, _ -> colours - (* order provided with no colours, map to palette colours *) - | _, 0 -> order |> map (fun o -> Simple o) - (* order and colours provided, apply order to colours and sub palette where - order index exceeds colour array length *) - | _, _ -> - order - |> mapi (fun i o -> - if order.(i) < clen then colours.(order.(i)) else Simple o) - (* TODO: implement this so cli can use a dsl to specify colourising patterns *) type culr = { colours : colour array; sz : int; mutable current : int } @@ -36,13 +20,12 @@ module Culriser = struct let run_filters (f : filter) el = List.fold_left (fun res filt -> if not (filt el) then false else res) true f - let create s f (c : colour array) = + let create ?(filters = []) (c : colour array) = let ( @ ) = append in let colours = - c |> permute s |> fun c -> - if List.length f > 0 then + if List.length filters > 0 then fold_left - (fun acc el -> if run_filters f el then acc @ [| el |] else acc) + (fun acc el -> if run_filters filters el then acc @ [| el |] else acc) [||] c else c in diff --git a/lib/types.ml b/lib/types.ml index e35cf40..b559887 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -10,3 +10,12 @@ type chunk = | Separator of string | Delimiter of string | Ansi of ansi_gfx list + +type order = + | Explicit of int array + | RainbowPair + | RainbowSplit + | TonePair + | Straight + | Random + | Default