summaryrefslogtreecommitdiff
path: root/lib/terminal.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/terminal.ml')
-rw-r--r--lib/terminal.ml130
1 files changed, 130 insertions, 0 deletions
diff --git a/lib/terminal.ml b/lib/terminal.ml
new file mode 100644
index 0000000..408f7a8
--- /dev/null
+++ b/lib/terminal.ml
@@ -0,0 +1,130 @@
1open Base
2open Unix
3open Util
4
5type terminal_size = int * int
6type state = { tio : terminal_io; size : terminal_size }
7
8let escape ?(prefix = "") ?(args = []) op =
9 let open Bytes in
10 let args = List.map ~f:Int.to_string args |> String.concat ~sep:";" in
11 let lenp = String.length prefix in
12 let lena = String.length args in
13 let lenb = 3 + lena + lenp in
14 let dst = Bytes.create lenb in
15 set dst 0 '\x1b';
16 set dst 1 '[';
17 From_string.blit ~src:prefix ~src_pos:0 ~dst ~dst_pos:2 ~len:lenp;
18 From_string.blit ~src:args ~src_pos:0 ~dst ~dst_pos:(2 + lenp) ~len:lena;
19 set dst (length dst - 1) op;
20 sequence_of_bytes dst
21
22let clear_screen = escape 'J' ~args:[ 2 ]
23let clear_to_eol = escape 'K'
24let move_cursor x y = escape 'H' ~args:[ x; y ]
25let move_down n = escape 'B' ~args:[ n ]
26let move_right n = escape 'C' ~args:[ n ]
27let query_cursor_pos = escape 'n' ~args:[ 6 ]
28let reset_cursor = move_cursor 1 1
29
30let show_cursor show =
31 let cmd = if show then 'h' else 'l' in
32 escape cmd ~prefix:"?" ~args:[ 25 ]
33
34let input_bytes = Bytes.create 1
35
36let get_char () =
37 let syscall () = read stdin input_bytes 0 1 in
38 match handle_unix_error syscall () with
39 | 0 -> None
40 | _ -> Some (Bytes.get input_bytes 0)
41
42let char_stream : char option Sequence.t =
43 Sequence.unfold ~init:() ~f:(fun s -> Some (get_char (), s))
44
45let write_seq =
46 let syscall s =
47 let buf = Sequence.to_list s |> Bytes.of_char_list in
48 single_write stdout buf 0 (Bytes.length buf) |> ignore
49 in
50 handle_unix_error syscall
51
52let write_lines (lines : char Sequence.t Sequence.t) =
53 let crnl = Sequence.of_list [ '\r'; '\n' ] in
54 let clear s = Sequence.append s clear_to_eol in
55 let syscall seq =
56 let buf =
57 Sequence.(map ~f:clear seq |> intersperse ~sep:crnl |> concat |> to_list)
58 |> Bytes.of_char_list
59 in
60 single_write stdout buf 0 (Bytes.length buf) |> ignore
61 in
62 handle_unix_error syscall lines
63
64let cmds_to_sequence l = Sequence.(of_list l |> concat)
65
66let restore_screen () =
67 cmds_to_sequence [ clear_screen; reset_cursor; show_cursor true ] |> write_seq
68
69let redraw screen (x, y) =
70 let pre = cmds_to_sequence [ show_cursor false; reset_cursor ]
71 and post = cmds_to_sequence [ move_cursor x y; show_cursor true ] in
72 write_seq pre;
73 write_lines screen;
74 write_seq post
75
76let get_state () = { tio = handle_unix_error tcgetattr stdin; size = (-1, -1) }
77
78let size =
79 let query () =
80 cmds_to_sequence [ move_right 999; move_down 999; query_cursor_pos ]
81 |> write_seq
82 and get_reply () =
83 Sequence.(
84 char_stream
85 |> take_while ~f:Option.is_some
86 |> Fn.flip drop_eagerly 2 (* Drop escape sequence '<esc>[' *)
87 |> map ~f:(Option.value ~default:'R')
88 |> take_while ~f:(fun c -> Char.(c <> 'R'))
89 |> to_list |> String.of_char_list |> Stdlib.Scanf.sscanf
90 |> fun scanner -> scanner "%d;%d" (fun a b -> (a, b)))
91 in
92 query &> get_reply
93
94let enable_raw_mode tio =
95 let syscall () =
96 tcsetattr stdin TCSAFLUSH
97 {
98 tio with
99 c_brkint = false;
100 c_csize = 8;
101 c_echo = false;
102 c_echonl = false;
103 c_icanon = false;
104 c_icrnl = false;
105 c_ignbrk = false;
106 c_igncr = false;
107 c_inlcr = false;
108 c_inpck = false;
109 c_isig = false;
110 c_istrip = false;
111 c_ixon = false;
112 c_opost = false;
113 c_parenb = false;
114 c_parmrk = false;
115 c_vmin = 0;
116 c_vtime = 1;
117 }
118 in
119 handle_unix_error syscall
120
121let restore_status tio =
122 let syscall () = tcsetattr stdin TCSAFLUSH tio in
123 handle_unix_error syscall
124
125let init () =
126 let state = get_state () in
127 enable_raw_mode state.tio ();
128 restore_status state.tio |> Stdlib.at_exit;
129 restore_screen |> Stdlib.at_exit;
130 { state with size = size () }