From fde592dbbb97a89a498feb95f97bee674bd571e8 Mon Sep 17 00:00:00 2001
From: Marc Coquand <marc@mccd.space>
Date: Mon, 13 May 2024 13:35:36 -0500
Subject: Refactor

---
 lib/common.ml    | 166 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lib/dune         |   5 +-
 lib/grep.ml      |  69 +++++++++++++++++++++++
 lib/headlines.ml |  79 ++++++++++++++++++++++++++
 lib/stitch.ml    |  69 -----------------------
 5 files changed, 318 insertions(+), 70 deletions(-)
 create mode 100644 lib/common.ml
 create mode 100644 lib/grep.ml
 create mode 100644 lib/headlines.ml
 delete mode 100644 lib/stitch.ml

(limited to 'lib')

diff --git a/lib/common.ml b/lib/common.ml
new file mode 100644
index 0000000..adfeee6
--- /dev/null
+++ b/lib/common.ml
@@ -0,0 +1,166 @@
+(* Copyright (c) 2016-2017 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md. *)
+
+open Notty
+open Notty.Infix
+
+let pow n e = int_of_float (float n ** float e)
+
+module List = struct
+  include List
+
+  let rec replicate n a = if n < 1 then [] else a :: replicate (n - 1) a
+  let rec range a b = if a > b then [] else a :: range (a + 1) b
+
+  let rec intersperse a = function
+    | ([] | [ _ ]) as t -> t
+    | x :: xs -> x :: a :: intersperse a xs
+
+
+  let rec take n = function
+    | x :: xs when n > 0 -> x :: take (pred n) xs
+    | _ -> []
+
+
+  let rec splitat n = function
+    | x :: xs when n > 0 ->
+      let a, b = splitat (pred n) xs in
+      x :: a, b
+    | xs -> [], xs
+
+
+  let rec chunks n xs =
+    match splitat n xs with
+    | a, [] -> [ a ]
+    | a, b -> a :: chunks n b
+
+
+  let rec zip xs ys =
+    match xs, ys with
+    | [], _ | _, [] -> []
+    | x :: xs, y :: ys -> (x, y) :: zip xs ys
+end
+
+module String = struct
+  include String
+
+  let repeat n str =
+    let b = Buffer.create 16 in
+    for _ = 1 to n do
+      Buffer.add_string b str
+    done;
+    Buffer.contents b
+end
+
+let tile w h i = I.tabulate w h (fun _ _ -> i)
+
+(** A few images used in several places. *)
+module Images = struct
+  let i1 =
+    I.(string A.(fg lightblack) "omgbbq" <-> string A.(fg white ++ bg red) "@")
+    <|> I.(pad ~t:2 @@ string A.(fg green) "xo")
+
+
+  let i2 = I.(hpad 1 1 (hcrop 1 1 @@ tile 3 3 i1) <|> i1)
+  let i3 = tile 5 5 i2
+
+  let i4 =
+    let i = I.(i3 <|> crop ~t:1 i3 <|> i3) in
+    I.(crop ~l:1 i <-> crop ~r:1 i <-> crop ~b:2 i)
+
+
+  let i5 = tile 5 1 List.(range 0 15 |> map (fun i -> I.pad ~t:i ~l:(i * 2) i2) |> I.zcat)
+  let c_gray_ramp = I.tabulate 24 1 (fun g _ -> I.string A.(bg (gray g)) " ")
+
+  let c_cube_ix =
+    I.tabulate 6 1
+    @@ fun r _ ->
+    I.hpad 0 1 @@ I.tabulate 6 6 @@ fun b g -> I.string A.(bg (rgb ~r ~g ~b)) " "
+
+
+  let c_cube_rgb =
+    let f x = [| 0x00; 0x5f; 0x87; 0xaf; 0xd7; 0xff |].(x) in
+    I.tabulate 6 1
+    @@ fun r _ ->
+    I.hpad 0 1
+    @@ I.tabulate 6 6
+    @@ fun b g -> I.string A.(bg (rgb_888 ~r:(f r) ~g:(f g) ~b:(f b))) " "
+
+
+  let c_rainbow w h =
+    let pi2 = 2. *. 3.14159 in
+    let pi2_3 = pi2 /. 3.
+    and f t off = (sin (t +. off) *. 128.) +. 128. |> truncate in
+    let color t = A.rgb_888 ~r:(f t (-.pi2_3)) ~g:(f t 0.) ~b:(f t pi2_3) in
+    I.tabulate (w - 1) 1
+    @@ fun x _ ->
+    let t = (pi2 *. float x /. float w) +. 3.7 in
+    I.char A.(bg (color t)) ' ' 1 h
+
+
+  (* U+25CF BLACK CIRCLE *)
+  let dot color = I.string (A.fg color) "●"
+
+  (* U+25AA BLACK SMALL SQUARE *)
+  let square color = I.string (A.fg color) "▪"
+
+  let rec cantor = function
+    | 0 -> square A.lightblue
+    | n ->
+      let sub = cantor (pred n) in
+      I.hcat (List.replicate (pow 3 n) (square A.lightblue))
+      <-> (sub <|> I.void (pow 3 (n - 1)) 0 <|> sub)
+
+
+  let checker n m i =
+    let w = I.width i in
+    I.(tile (n / 2) (m / 2) (hpad 0 w i <-> hpad w 0 i))
+
+
+  let checker1 = checker 20 20 I.(char A.(bg magenta) ' ' 2 1)
+
+  let rec sierp c n =
+    I.(
+      if n > 1
+      then (
+        let ss = sierp c (pred n) in
+        ss <-> (ss <|> ss))
+      else hpad 1 0 (square c))
+
+
+  let grid xxs = xxs |> List.map I.hcat |> I.vcat
+
+  let outline attr i =
+    let w, h = I.(width i, height i) in
+    let chr x = I.uchar attr (Uchar.of_int x) 1 1
+    and hbar = I.uchar attr (Uchar.of_int 0x2500) w 1
+    and vbar = I.uchar attr (Uchar.of_int 0x2502) 1 h in
+    let a, b, c, d = chr 0x256d, chr 0x256e, chr 0x256f, chr 0x2570 in
+    grid [ [ a; hbar; b ]; [ vbar; i; vbar ]; [ d; hbar; c ] ]
+end
+
+let halfblock = "▄"
+
+let pxmatrix w h f =
+  I.tabulate w h
+  @@ fun x y ->
+  let y = y * 2 in
+  I.string A.(bg (f x y) ++ fg (f x (y + 1))) halfblock
+
+
+module Term = Notty_unix.Term
+
+let simpleterm ~imgf ~f ~s =
+  let term = Term.create () in
+  let imgf (w, h) s = I.(string A.(fg lightblack) "[ESC quits.]" <-> imgf (w, h - 1) s) in
+  let rec go s =
+    Term.image term (imgf (Term.size term) s);
+    match Term.event term with
+    | `End | `Key (`Escape, []) | `Key (`ASCII 'C', [ `Ctrl ]) -> ()
+    | `Resize _ -> go s
+    | #Unescape.event as e ->
+      (match f s e with
+       | Some s -> go s
+       | _ -> ())
+  in
+  go s
diff --git a/lib/dune b/lib/dune
index 0ddfdce..cdc74cc 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,7 +1,10 @@
 (library
  (name stitch)
  (libraries
+  unix
+  cmdliner
   str
+  notty
+  notty.unix
   shexp.process
-  cmdliner
   lambda-term))
diff --git a/lib/grep.ml b/lib/grep.ml
new file mode 100644
index 0000000..a6ba300
--- /dev/null
+++ b/lib/grep.ml
@@ -0,0 +1,69 @@
+let execution_directory =
+  Sys.getenv_opt "STICH_DIRECTORY" |> Option.value ~default:"/home/mccd/notes-example"
+
+
+let grep_cmd = Sys.getenv_opt "STICH_GREP_CMD" |> Option.value ~default:"ugrep"
+
+let run_print ~dir args =
+  let open Shexp_process in
+  let open Shexp_process.Infix in
+  eval (chdir dir (call args |- read_all))
+
+
+let get_headlines () =
+  run_print
+    ~dir:execution_directory
+    [ grep_cmd; "^\\*"; "-H"; "-r"; "-n"; "--separator=|" ]
+
+
+exception Not_A_Tuple of string * string
+
+(** Returns a tuple of file name and Content *)
+let parse_headlines s =
+  String.split_on_char '\n' s
+  (* Testing in utop it seems like there is maybe a bug with bounded_split, 1 doesn't work for ':'. Therefore using a slower implementation. *)
+  |> List.filter_map (fun message ->
+    if String.equal message ""
+    then None
+    else (
+      let split = Str.bounded_split (Str.regexp "|") message 3 in
+      match split with
+      (* file, line, content *)
+      | [ file_name; _; content ] -> Some (file_name, content)
+      | _ -> raise (Not_A_Tuple (String.concat " SPLIT " split, message))))
+  |> Array.of_list
+
+
+(** Used for pretty printing *)
+let get_padding list =
+  Array.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 list
+
+
+let pad str n =
+  let padding = n - String.length str in
+  String.concat "" [ str; String.make padding ' ' ]
+
+
+(** Turns "2024-03-05.org:* Hello world" into "2024-03-05    | * Hello world" *)
+let pretty_format parsed_headlines =
+  let padding = get_padding parsed_headlines in
+  Array.map
+    (fun (file_name, content) -> String.concat " | " [ pad file_name padding; content ])
+    parsed_headlines
+
+
+(** Full body parsing *)
+
+let get_full_content () =
+  run_print
+    ~dir:execution_directory
+    [ grep_cmd; "^\\*"; "-h"; "-r"; "-n"; "-C"; "9999"; "--separator='|'" ]
+
+(* let parse_file_headline collection full = *)
+(*   match full with *)
+(*   | s :: r -> *)
+(*     let split = Str.bounded_split (Str.regexp ":1:") s 1 in *)
+(*     (match split with *)
+(*      (\* file, line, content *\) *)
+(*      | [ file_name; content ] -> file_name, content *)
+(*      | rest ->  *)
diff --git a/lib/headlines.ml b/lib/headlines.ml
new file mode 100644
index 0000000..8fab7f6
--- /dev/null
+++ b/lib/headlines.ml
@@ -0,0 +1,79 @@
+module Grep = Grep
+module Common = Common
+open Notty
+
+let content = Grep.get_headlines () |> Grep.parse_headlines
+let content_pretty = content |> Grep.pretty_format
+
+let rec headline_screen t (((x, y) as pos), scroll) =
+  let img =
+    let dot = I.string A.(fg black) ">" |> I.pad ~l:0 ~t:(y - scroll)
+    and elements =
+      Array.mapi
+        (fun i el -> I.strf ~attr:A.(fg black) "%s" el |> I.pad ~l:2 ~t:i)
+        (Array.to_seq content_pretty |> Seq.drop scroll |> Array.of_seq)
+    in
+    let open I in
+    Array.fold_left (fun sum el -> el </> sum) dot elements
+  in
+  let _, size_y = Common.Term.size t in
+  Common.Term.image t img;
+  let content_length = Array.length content_pretty in
+  let scroll_up () =
+    let scroll = if y - scroll = 0 then max (scroll - 1) 0 else scroll in
+    headline_screen t @@ ((x, max (y - 1) 0), scroll)
+  in
+  let scroll_down () =
+    let scroll = if y - scroll >= size_y - 1 then scroll + 1 else scroll in
+    headline_screen t @@ ((x, min (y + 1) content_length), scroll)
+  in
+  match Common.Term.event t with
+  | `End | `Key (`Escape, []) | `Key (`ASCII 'q', []) | `Key (`ASCII 'C', [ `Ctrl ]) -> ()
+  | `Mouse (`Press (`Scroll s), _, _) ->
+    (match s with
+     | `Down -> scroll_down ()
+     | `Up -> scroll_up ())
+  | `Resize _ -> headline_screen t (pos, scroll)
+  | `Mouse ((`Press _ | `Drag), (_, y), _) ->
+    headline_screen t ((0, min y content_length), scroll)
+  | `Key (`ASCII 'j', []) | `Key (`ASCII 'N', [ `Ctrl ]) -> scroll_down ()
+  | `Key (`ASCII 'k', []) | `Key (`ASCII 'P', [ `Ctrl ]) ->
+    let scroll = if y - scroll = 0 then max (scroll - 1) 0 else scroll in
+    headline_screen t @@ ((x, max (y - 1) 0), scroll)
+  | `Key (`Arrow d, _) ->
+    (match d with
+     | `Up -> scroll_up ()
+     | `Down -> scroll_down ()
+     | _ -> headline_screen t ((x, y), scroll))
+  | `Key (`ASCII 'e', []) | `Key (`Enter, []) ->
+    (* Editor might be set with extra args, in that case we need to separate these *)
+    let[@warning "-8"] (editor :: args) =
+      String.split_on_char ' ' (Sys.getenv "EDITOR")
+    in
+    let selected_file, _ = Array.get content y in
+    let full_path_file = Grep.execution_directory ^ "/" ^ selected_file in
+    let full_args = Array.append (Array.of_list args) [| full_path_file |] in
+    Common.Term.cursor t (Some (0, 0));
+    let _ =
+      Unix.create_process_env
+        editor
+        full_args
+        (Unix.environment ())
+        Unix.stdin
+        Unix.stdout
+        Unix.stderr
+    in
+    let rec run_editor () =
+      match Unix.wait () with
+      | _, _ ->
+        Common.Term.cursor t None;
+        headline_screen t ((x, y), scroll)
+      (* Capture resizing events *)
+      | exception Unix.Unix_error (Unix.EINTR, _, _) -> run_editor ()
+      | exception Unix.Unix_error (_, _, _) -> failwith "ERROR"
+    in
+    run_editor ()
+  | _ -> headline_screen t (pos, scroll)
+
+
+let start () = headline_screen (Common.Term.create ()) ((0, 0), 0)
diff --git a/lib/stitch.ml b/lib/stitch.ml
deleted file mode 100644
index a6ba300..0000000
--- a/lib/stitch.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-let execution_directory =
-  Sys.getenv_opt "STICH_DIRECTORY" |> Option.value ~default:"/home/mccd/notes-example"
-
-
-let grep_cmd = Sys.getenv_opt "STICH_GREP_CMD" |> Option.value ~default:"ugrep"
-
-let run_print ~dir args =
-  let open Shexp_process in
-  let open Shexp_process.Infix in
-  eval (chdir dir (call args |- read_all))
-
-
-let get_headlines () =
-  run_print
-    ~dir:execution_directory
-    [ grep_cmd; "^\\*"; "-H"; "-r"; "-n"; "--separator=|" ]
-
-
-exception Not_A_Tuple of string * string
-
-(** Returns a tuple of file name and Content *)
-let parse_headlines s =
-  String.split_on_char '\n' s
-  (* Testing in utop it seems like there is maybe a bug with bounded_split, 1 doesn't work for ':'. Therefore using a slower implementation. *)
-  |> List.filter_map (fun message ->
-    if String.equal message ""
-    then None
-    else (
-      let split = Str.bounded_split (Str.regexp "|") message 3 in
-      match split with
-      (* file, line, content *)
-      | [ file_name; _; content ] -> Some (file_name, content)
-      | _ -> raise (Not_A_Tuple (String.concat " SPLIT " split, message))))
-  |> Array.of_list
-
-
-(** Used for pretty printing *)
-let get_padding list =
-  Array.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 list
-
-
-let pad str n =
-  let padding = n - String.length str in
-  String.concat "" [ str; String.make padding ' ' ]
-
-
-(** Turns "2024-03-05.org:* Hello world" into "2024-03-05    | * Hello world" *)
-let pretty_format parsed_headlines =
-  let padding = get_padding parsed_headlines in
-  Array.map
-    (fun (file_name, content) -> String.concat " | " [ pad file_name padding; content ])
-    parsed_headlines
-
-
-(** Full body parsing *)
-
-let get_full_content () =
-  run_print
-    ~dir:execution_directory
-    [ grep_cmd; "^\\*"; "-h"; "-r"; "-n"; "-C"; "9999"; "--separator='|'" ]
-
-(* let parse_file_headline collection full = *)
-(*   match full with *)
-(*   | s :: r -> *)
-(*     let split = Str.bounded_split (Str.regexp ":1:") s 1 in *)
-(*     (match split with *)
-(*      (\* file, line, content *\) *)
-(*      | [ file_name; content ] -> file_name, content *)
-(*      | rest ->  *)
-- 
cgit v1.2.3