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(-)
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