aboutsummaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorMarc Coquand <marc@mccd.space>2024-05-13 13:35:36 -0500
committerMarc Coquand <marc@mccd.space>2024-05-13 13:35:36 -0500
commitfde592dbbb97a89a498feb95f97bee674bd571e8 (patch)
treea5eb1e01a897bdb68ab4690ae75d07ca76dc8cec /bin
parent2b47b301cbf234eabfcebd28f069e5d154441354 (diff)
downloadstitch-fde592dbbb97a89a498feb95f97bee674bd571e8.tar.gz
stitch-fde592dbbb97a89a498feb95f97bee674bd571e8.tar.bz2
stitch-fde592dbbb97a89a498feb95f97bee674bd571e8.zip
Refactor
Diffstat (limited to 'bin')
-rw-r--r--bin/common.ml166
-rw-r--r--bin/main.ml78
2 files changed, 2 insertions, 242 deletions
diff --git a/bin/common.ml b/bin/common.ml
deleted file mode 100644
index adfeee6..0000000
--- a/bin/common.ml
+++ /dev/null
@@ -1,166 +0,0 @@
-(* 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/bin/main.ml b/bin/main.ml
index 404c63e..bb7dc1e 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,77 +1,3 @@
-open Notty
-open Common
+open Stitch
-let content = Stitch.get_headlines () |> Stitch.parse_headlines
-let content_pretty = content |> Stitch.pretty_format
-
-let rec main 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 = Term.size t in
- 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
- main 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
- main t @@ ((x, min (y + 1) content_length), scroll)
- in
- match 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 _ -> main t (pos, scroll)
- | `Mouse ((`Press _ | `Drag), (_, y), _) -> main 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
- main t @@ ((x, max (y - 1) 0), scroll)
- | `Key (`Arrow d, _) ->
- (match d with
- | `Up -> scroll_up ()
- | `Down -> scroll_down ()
- | _ -> main 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 = Stitch.execution_directory ^ "/" ^ selected_file in
- let full_args = Array.append (Array.of_list args) [| full_path_file |] in
- 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
- | _, _ ->
- Term.cursor t None;
- main t ((x, y), scroll)
- (* Capture resizing events *)
- | exception Unix.Unix_error (Unix.EINTR, _, _) -> run_editor ()
- | exception Unix.Unix_error (_, _, _) -> failwith "ERROR"
- in
- run_editor ()
- | _ -> main t (pos, scroll)
-
-
-let () = main (Term.create ()) ((0, 0), 0)
+let () = Headlines.start ()