From 6e7d635f6f72b5114e9dfbcf22f42683c446ae5e Mon Sep 17 00:00:00 2001
From: Ryan Kavanagh <rak@rak.ac>
Date: Sun, 7 Jun 2020 21:20:39 -0400
Subject: Switch from curses to notty

---
 bin/dune    |  2 +-
 bin/leda.ml | 32 +++++++++++++++++++-------------
 2 files changed, 20 insertions(+), 14 deletions(-)

(limited to 'bin')

diff --git a/bin/dune b/bin/dune
index 9861cc3..7b136a7 100644
--- a/bin/dune
+++ b/bin/dune
@@ -1,5 +1,5 @@
 (executable
  (public_name leda)
  (name leda)
- (libraries base cmdliner curses gemini lwt lwt_ppx mirage-crypto-rng.lwt)
+ (libraries base cmdliner notty notty.lwt gemini lwt lwt_ppx mirage-crypto-rng.lwt)
  (preprocess (pps lwt_ppx)))
diff --git a/bin/leda.ml b/bin/leda.ml
index abe1839..4b86330 100644
--- a/bin/leda.ml
+++ b/bin/leda.ml
@@ -1,6 +1,11 @@
 open Base
 open Base.Result
 
+open Notty
+open Notty.Infix
+open Notty_lwt
+
+
 module M = Gemini.MimeTextGemini.MimeTextGemini
 
 let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s)
@@ -12,24 +17,25 @@ let () =
   Lwt_main.run begin
     let%lwt () = Mirage_crypto_rng_lwt.initialize () in
     let request : (R.request, string) Base.Result.t = R.make_request (Sys.get_argv()).(1) in
+    let rec loop t =
+      match%lwt Lwt_stream.next (Term.events t) with
+      | `Key _ -> Lwt.return ()
+      | _ -> loop t in
     match request with
     | Ok request ->
-      let w = Curses.initscr () in
-      let () = Curses.wclear w in
+      let t = Term.create () in
       (match%lwt R.session request with
        | Ok r ->
-         let _ = Curses.mvwaddstr w 0 0 ("STATUS: " ^ (R.name_of_response r)) in
-         let _ = Curses.mvwaddstr w 1 0 ("STATUS LINE: " ^ (R.header_of_response r)) in
-         let _ = match r with
-           | SUCCESS (_, c) | SUCCESS_EOCSS (_, c) -> Curses.mvwaddstr w 2 0 c
-           | _ -> false in
-         let _ = Curses.refresh () in
-         let _ = Curses.getch () in
-         let _ = Curses.endwin () in
-         Lwt.return ()
+         let h = (I.string A.empty ("STATUS: " ^ (R.name_of_response r)))
+                  <-> (I.string A.empty ("STATUS LINE: " ^ (R.header_of_response r))) in
+         let c = match r with
+           | SUCCESS (_, c) | SUCCESS_EOCSS (_, c) -> I.string A.empty c
+           | _ -> I.empty in
+         let%lwt () = Term.image t (h <-> c) in
+         let%lwt () = Term.refresh t in
+         loop t
        | Error m ->
-         let _ = Curses.refresh () in
-         let _ = Curses.endwin () in
+         let%lwt () = Term.release t in
          Lwt_io.printl m)
     | Error m -> Lwt_io.printl m
   end
-- 
cgit v1.2.3