support colour reinsert after resets, switch to intrinsics by default

lib/debug.ml

@@ -20,4 +20,4 @@ let print_ansi =
 
 let debug_print = function
   | Text s | Separator s | Delimiter s -> print_endline ("parsed '" ^ s ^ "'")
-  | Ansi a -> print_ansi () a
+  | Ansi a -> print_ansi () a | _ -> ()

lib/emitter.ml

@@ -11,7 +11,8 @@ let write_ansi a =
   and string_of_colour ?(bg = false) c =
     let prefix = if bg then "4" else "3" and si = string_of_int in
     c |> function
-    | Intrinsic i -> prefix ^ si i
+    | Intrinsic i ->
+        if i <= 8 then prefix ^ si i else (if bg then "10" else "9") ^ si (i - 8)
     | Simple i -> prefix ^ "8;5;" ^ si i
     | RGB (r, g, b) -> prefix ^ "8;2;" ^ si r ^ ";" ^ si g ^ ";" ^ si b
   in
@@ -35,18 +36,21 @@ let flush t =
     t.pos <- 0)
 
 let serialise t chunk =
-  let input =
-    match chunk with
-    | Text s -> s
-    | Separator s -> s
-    | Delimiter s -> s
-    | Ansi a -> write_ansi a
-  and sz = Bytes.length t.buf in
-  let input_sz = String.length input in
-  if t.pos + input_sz > sz then flush t;
-  if input_sz > sz then print_string input
-  else (
-    Bytes.blit_string input 0 t.buf t.pos input_sz;
-    t.pos <- t.pos + input_sz)
+  if chunk != Empty then (
+    let input =
+      match chunk with
+      | Text s -> s
+      | Separator s -> s
+      | Delimiter s -> s
+      | Ansi a -> write_ansi a
+      | Empty -> assert false
+    and sz = Bytes.length t.buf in
+    let input_sz = String.length input in
+    if t.pos + input_sz > sz then flush t;
+    if input_sz > sz then print_string input
+    else (
+      Bytes.blit_string input 0 t.buf t.pos input_sz;
+      t.pos <- t.pos + input_sz))
+  else ()
 
 let create = { buf = Bytes.create 4096; pos = 0 }

lib/env.ml

@@ -28,30 +28,30 @@ 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
+  let make_intrinsic = map (fun i -> Intrinsic 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)
+             if index < clen then colours.(index) else Intrinsic index)
   | RainbowPair ->
-      [| 1; 9; 3; 11; 2; 10; 6; 14; 4; 12; 5; 13; 7; 15 |] |> make_simple
+      [| 1; 9; 3; 11; 2; 10; 6; 14; 4; 12; 5; 13; 7; 15 |] |> make_intrinsic
   | RainbowSplit ->
-      [| 1; 3; 2; 6; 4; 5; 9; 11; 10; 14; 12; 13; 7; 15 |] |> make_simple
+      [| 1; 3; 2; 6; 4; 5; 9; 11; 10; 14; 12; 13; 7; 15 |] |> make_intrinsic
   | TonePair ->
       let open Seq in
       let lows = ints 1 |> take 8 in
       let highs = lows |> map (fun i -> i + 8) in
-      interleave lows highs |> Array.of_seq |> make_simple
+      interleave lows highs |> Array.of_seq |> make_intrinsic
   | Straight ->
       let open Seq in
-      ints 0 |> take 16 |> Array.of_seq |> make_simple
+      ints 0 |> take 16 |> Array.of_seq |> make_intrinsic
   | Default ->
       let open Seq in
       ints 0 |> take 16
       |> filter (fun i -> not (i = 0 || i = 8))
-      |> Array.of_seq |> make_simple
+      |> Array.of_seq |> make_intrinsic
   | Random ->
       Random.self_init ();
       shuffle ~rand:Random.int colours;
@@ -60,7 +60,7 @@ let permute (order : order) (colours : colour array) =
 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_default_colours = to_sixteen (map (fun x -> Types.Intrinsic x))
   and init_order_for_colours c =
     let open Seq in
     ints 0 |> take (Array.length c) |> Array.of_seq

lib/pipes.ml

@@ -6,7 +6,7 @@ let read_all colours =
   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)
+    (fun c -> c |> ansi_filter culr |> Culriser.serialise_with_colour culr t)
     stdin
   |> function
   | _, Ok _ -> Emitter.flush t

lib/processing.ml

@@ -1,15 +1,6 @@
 open Types
 open Array
 
-let ansi_filter s =
-  s |> function
-  | Ansi a ->
-      Types.Ansi
-        (List.filter
-           (function Fg _ | Bg _ -> false | _ -> true)
-           a)
-  | n -> n
-
 (* TODO: implement this so cli can use a dsl to specify colourising patterns *)
 type culr = { colours : colour array; sz : int; mutable current : int }
 
@@ -31,6 +22,8 @@ module Culriser = struct
     in
     { colours; sz = length colours; current = 0 }
 
+  let current t = t.colours.(t.current)
+
   let next t =
     let ret = t.current and nv = t.current + 1 in
     if nv >= t.sz then t.current <- 0 else t.current <- nv;
@@ -47,3 +40,26 @@ module Culriser = struct
     | _ -> ());
     Emitter.serialise serialiser chunk
 end
+
+let ansi_filter t s =
+  s |> function
+  | Ansi a -> (
+      let open List in
+      let ol = length a
+      and result =
+        a
+        |> filter (function Fg _ | Bg _ -> false | _ -> true)
+        |> fold_left
+             (fun acc el ->
+               if el = Reset then acc @ [ el; Fg (Culriser.current t) ]
+               else acc @ [ el ])
+             []
+      in
+      let rl = length result in
+      match (rl, ol) with
+      (* empty ansi code is equivalent to a reset *)
+      | 0, 0 -> Ansi [ Reset; Fg (Culriser.current t) ]
+      (* if we filtered everything out of it produce no tokens *)
+      | 0, _ -> Empty
+      | _, _ -> Ansi result)
+  | n -> n

lib/types.ml

@@ -10,6 +10,7 @@ type chunk =
   | Separator of string
   | Delimiter of string
   | Ansi of ansi_gfx list
+  | Empty
 
 type order =
   | Explicit of int array