summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFederico Igne <undyamon@disroot.org>2024-01-23 18:08:56 +0100
committerFederico Igne <undyamon@disroot.org>2024-01-23 18:08:56 +0100
commit482e8b80fa66e328e252567c915f5e96e727f7cf (patch)
tree4b712f227ae1926a744f2dc2e2df85ece3da1e43
parent7d009e0ca4a1af10cc6d31fb5982e38dcab9ee71 (diff)
downloadsandy-482e8b80fa66e328e252567c915f5e96e727f7cf.tar.gz
sandy-482e8b80fa66e328e252567c915f5e96e727f7cf.zip
feat: add simple status bar with timed status message support
-rw-r--r--bin/main.ml2
-rw-r--r--lib/editor.ml85
-rw-r--r--lib/editorBuffer.ml14
-rw-r--r--lib/terminal.ml9
-rw-r--r--lib/terminal.mli21
-rw-r--r--lib/util.ml7
6 files changed, 131 insertions, 7 deletions
diff --git a/bin/main.ml b/bin/main.ml
index 932c452..e763f70 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -4,5 +4,5 @@ let () =
4 let open Editor in 4 let open Editor in
5 let cli = Config.parse Sys.argv in 5 let cli = Config.parse Sys.argv in
6 let editor = Editor.init cli in 6 let editor = Editor.init cli in
7 let rec loop () = Action.(render *> handle_next_command >>= loop) in 7 let rec loop () = Action.(render *> handle_next_command *> tick >>= loop) in
8 Action.eval ~editor loop 8 Action.eval ~editor loop
diff --git a/lib/editor.ml b/lib/editor.ml
index 69dc666..c34d558 100644
--- a/lib/editor.ml
+++ b/lib/editor.ml
@@ -2,7 +2,7 @@ open Base
2module Buffer = EditorBuffer 2module Buffer = EditorBuffer
3open Util 3open Util
4 4
5type mode = Normal | Insert 5type mode = Normal | Insert | Control
6type cursor = int * int 6type cursor = int * int
7 7
8type editor = { 8type editor = {
@@ -15,6 +15,10 @@ type editor = {
15 pending : Key.t Sequence.t; 15 pending : Key.t Sequence.t;
16 i_pending : Command.t Sequence.t; 16 i_pending : Command.t Sequence.t;
17 n_pending : Command.t Sequence.t; 17 n_pending : Command.t Sequence.t;
18 status_size : int;
19 message : string option;
20 message_timestamp : float;
21 message_duration : float;
18} 22}
19 23
20type t = editor 24type t = editor
@@ -30,8 +34,57 @@ let init (c : Config.t) : editor =
30 pending = Key.stream; 34 pending = Key.stream;
31 i_pending = Command.i_stream; 35 i_pending = Command.i_stream;
32 n_pending = Command.n_stream; 36 n_pending = Command.n_stream;
37 status_size = 2;
38 message = Some "Hello, control line!";
39 message_timestamp = Unix.time ();
40 message_duration = 5.;
33 } 41 }
34 42
43let string_of_mode = function
44 | Insert -> " I "
45 | Normal -> " N "
46 | Control -> " C "
47
48let statusbar e =
49 let open Text in
50 (* let open Sequence.Infix in *)
51 let w = e.term.size |> snd in
52 let status =
53 let mode = e.mode |> string_of_mode |> sequence_of_string in
54 let msize = Sequence.length mode
55 and path =
56 Buffer.(
57 e.buffer |> Option.map ~f:kind
58 |> Option.value ~default:No_name
59 |> string_of_kind |> sequence_of_string)
60 and br, bc =
61 Option.(e.buffer |> map ~f:Buffer.size |> value ~default:(0, 0))
62 and cr, cc =
63 Option.(
64 e.buffer
65 |> map ~f:(Buffer.cursor ~rendered:false)
66 |> value ~default:(0, 0))
67 in
68 let perc =
69 match cr with
70 | 0 -> "Top"
71 | n when n = br -> "Bot"
72 | n -> Printf.sprintf "%2d%%" (100 * n / br)
73 in
74 let nav =
75 Printf.sprintf "%d/%d %2d/%2d [%s] " cr br cc bc perc
76 |> sequence_of_string
77 in
78 let nsize = Sequence.length nav in
79 spread ~l:(bold mode) ~lsize:msize ~c:path ~r:(bold nav) ~rsize:nsize
80 ~fill:' ' w
81 |> invert
82 and control =
83 let msg = Option.value ~default:"" e.message |> sequence_of_string in
84 spread ~l:msg ~fill:' ' w
85 in
86 Sequence.(take (of_list [ status; control ]) e.status_size)
87
35type 'a action = t -> 'a * t 88type 'a action = t -> 'a * t
36 89
37module Action = struct 90module Action = struct
@@ -71,6 +124,8 @@ module Action = struct
71 let update_cursor = 124 let update_cursor =
72 let aux e = 125 let aux e =
73 let dx, dy = e.offset and rs, cs = e.term.size in 126 let dx, dy = e.offset and rs, cs = e.term.size in
127 (* Limit cursor to buffer view *)
128 let rs = rs - e.status_size in
74 match Option.map ~f:Buffer.cursor e.buffer with 129 match Option.map ~f:Buffer.cursor e.buffer with
75 | None -> { e with cursor = (1, 1); offset = (0, 0) } 130 | None -> { e with cursor = (1, 1); offset = (0, 0) }
76 | Some (cx, cy) -> 131 | Some (cx, cy) ->
@@ -107,22 +162,41 @@ module Action = struct
107 let x, y = e.offset 162 let x, y = e.offset
108 and ((r, c) as size) = e.term.size 163 and ((r, c) as size) = e.term.size
109 and fill = Sequence.singleton '~' 164 and fill = Sequence.singleton '~'
165 and status = statusbar e
110 and limit = 166 and limit =
111 Buffer.(if e.rendered then rendered_view else unrendered_view) 167 Buffer.(if e.rendered then rendered_view else unrendered_view)
112 in 168 in
113 let view = 169 let ssize = e.status_size in
170 let bufview =
114 Option.( 171 Option.(
115 e.buffer >>| limit x y r c 172 e.buffer
173 >>| limit x y (r - ssize) c
116 |> value ~default:(welcome size) 174 |> value ~default:(welcome size)
117 |> Text.extend ~fill r) 175 |> Text.extend ~fill r
176 |> Fn.flip Sequence.take (r - ssize))
118 in 177 in
119 Terminal.redraw view e.cursor 178 let screen = Sequence.append bufview status in
179 Terminal.redraw screen e.cursor
120 in 180 in
121 get >>| aux 181 get >>| aux
122 182
123 (* TODO: save logic *) 183 (* TODO: save logic *)
124 let quit n = Stdlib.exit n 184 let quit n = Stdlib.exit n
125 185
186 (* Statusbar *)
187 let set_message m e =
188 ((), { e with message = m; message_timestamp = Unix.time () })
189
190
191 let tick =
192 let check_message_timestamp e =
193 let now = Unix.time () in
194 let expired = Float.(e.message_timestamp < now - e.message_duration) in
195 if Option.is_some e.message && expired then { e with message = None }
196 else e
197 in
198 get >>| check_message_timestamp >>= put
199
126 (* Debug *) 200 (* Debug *)
127 let get_rendered e = (e.rendered, e) 201 let get_rendered e = (e.rendered, e)
128 let set_rendered r e = ((), { e with rendered = r }) 202 let set_rendered r e = ((), { e with rendered = r })
@@ -376,6 +450,7 @@ let handle_next_command m e =
376 match Sequence.next e.n_pending with 450 match Sequence.next e.n_pending with
377 | None -> ((), e) 451 | None -> ((), e)
378 | Some (h, t) -> handle_normal_command h { e with n_pending = t }) 452 | Some (h, t) -> handle_normal_command h { e with n_pending = t })
453 | Control -> failwith "unimplemented"
379 454
380let handle_next_command = 455let handle_next_command =
381 let open Action in 456 let open Action in
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
index e1706dd..c492b8b 100644
--- a/lib/editorBuffer.ml
+++ b/lib/editorBuffer.ml
@@ -21,6 +21,18 @@ let empty =
21 rendered = push Sequence.empty empty; 21 rendered = push Sequence.empty empty;
22 } 22 }
23 23
24let kind b = b.kind
25
26let string_of_kind = function
27 | No_name -> "[No Name]"
28 | Scratch -> "[Scratch]"
29 | File name -> name
30
31let size e =
32 match e.content with
33 | Error _ -> (0, 0)
34 | Ok z -> (length z, apply_focus_or ~default:0 length z)
35
24let render = 36let render =
25 let open Sequence in 37 let open Sequence in
26 let tabsize = 8 in 38 let tabsize = 8 in
@@ -235,7 +247,7 @@ let unrendered_view x y h w b =
235 247
236let rendered_view x y h w b = 248let rendered_view x y h w b =
237 let window from len seq = Sequence.(take (drop_eagerly seq from) len) in 249 let window from len seq = Sequence.(take (drop_eagerly seq from) len) in
238 let cx, _ = cursor b in 250 let cx, _ = cursor ~rendered:false b in
239 context ~l:(cx - x) ~r:(x + h - cx) b.rendered 251 context ~l:(cx - x) ~r:(x + h - cx) b.rendered
240 |> to_seq 252 |> to_seq
241 |> Sequence.map ~f:(window y w) 253 |> Sequence.map ~f:(window y w)
diff --git a/lib/terminal.ml b/lib/terminal.ml
index c8312b6..96103f5 100644
--- a/lib/terminal.ml
+++ b/lib/terminal.ml
@@ -31,6 +31,15 @@ let show_cursor show =
31 let cmd = if show then 'h' else 'l' in 31 let cmd = if show then 'h' else 'l' in
32 escape cmd ~prefix:"?" ~args:[ 25 ] 32 escape cmd ~prefix:"?" ~args:[ 25 ]
33 33
34(* Incomplete. See https://stackoverflow.com/a/33206814 for a full list
35 of escape codes related to terminal formatting capabilities *)
36let fmt_reset = escape 'm'
37let fmt_bold_on = escape ~args:[ 1 ] 'm'
38let fmt_bold_off = escape ~args:[ 22 ] 'm'
39let fmt_underline = escape ~args:[ 4 ] 'm'
40let fmt_blink = escape ~args:[ 5 ] 'm'
41let fmt_inverted_on = escape ~args:[ 7 ] 'm'
42let fmt_inverted_off = escape ~args:[ 27 ] 'm'
34let input_bytes = Bytes.create 1 43let input_bytes = Bytes.create 1
35 44
36let get_char () = 45let get_char () =
diff --git a/lib/terminal.mli b/lib/terminal.mli
index 0fd11ed..cf8f61d 100644
--- a/lib/terminal.mli
+++ b/lib/terminal.mli
@@ -13,6 +13,27 @@ type state = {
13} 13}
14(** Global state of the terminal window. *) 14(** Global state of the terminal window. *)
15 15
16val fmt_reset : char Sequence.t
17(** Escape sequence: reset text formatting *)
18
19val fmt_bold_on : char Sequence.t
20(** Escape sequence: turn on bold text*)
21
22val fmt_bold_off : char Sequence.t
23(** Escape sequence: turn off bold text*)
24
25val fmt_underline : char Sequence.t
26(** Escape sequence: underlined text*)
27
28val fmt_blink : char Sequence.t
29(** Escape sequence: blinking text*)
30
31val fmt_inverted_on : char Sequence.t
32(** Escape sequence: turn on inverted text*)
33
34val fmt_inverted_off : char Sequence.t
35(** Escape sequence: turn off inverted text*)
36
16val get_char : unit -> char option 37val get_char : unit -> char option
17(** Non-blocking request for a keypress. 38(** Non-blocking request for a keypress.
18 Use {!val:Terminal.char_stream} for an infinite sequence of input 39 Use {!val:Terminal.char_stream} for an infinite sequence of input
diff --git a/lib/util.ml b/lib/util.ml
index 9ad3b59..b86119b 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -24,3 +24,10 @@ let sequence_of_bytes (b : Bytes.t) : char Sequence.t =
24 loop 0 () 24 loop 0 ()
25 in 25 in
26 traverse b |> run 26 traverse b |> run
27
28(** Turn a string into a sequence.
29
30 @param s the input string.
31 @return a sequence of bytes. *)
32let sequence_of_string (s : string) : char Sequence.t =
33 s |> String.to_list |> Sequence.of_list