diff options
Diffstat (limited to 'lib/terminal.ml')
-rw-r--r-- | lib/terminal.ml | 130 |
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 @@ | |||
1 | open Base | ||
2 | open Unix | ||
3 | open Util | ||
4 | |||
5 | type terminal_size = int * int | ||
6 | type state = { tio : terminal_io; size : terminal_size } | ||
7 | |||
8 | let 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 | |||
22 | let clear_screen = escape 'J' ~args:[ 2 ] | ||
23 | let clear_to_eol = escape 'K' | ||
24 | let move_cursor x y = escape 'H' ~args:[ x; y ] | ||
25 | let move_down n = escape 'B' ~args:[ n ] | ||
26 | let move_right n = escape 'C' ~args:[ n ] | ||
27 | let query_cursor_pos = escape 'n' ~args:[ 6 ] | ||
28 | let reset_cursor = move_cursor 1 1 | ||
29 | |||
30 | let show_cursor show = | ||
31 | let cmd = if show then 'h' else 'l' in | ||
32 | escape cmd ~prefix:"?" ~args:[ 25 ] | ||
33 | |||
34 | let input_bytes = Bytes.create 1 | ||
35 | |||
36 | let 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 | |||
42 | let char_stream : char option Sequence.t = | ||
43 | Sequence.unfold ~init:() ~f:(fun s -> Some (get_char (), s)) | ||
44 | |||
45 | let 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 | |||
52 | let 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 | |||
64 | let cmds_to_sequence l = Sequence.(of_list l |> concat) | ||
65 | |||
66 | let restore_screen () = | ||
67 | cmds_to_sequence [ clear_screen; reset_cursor; show_cursor true ] |> write_seq | ||
68 | |||
69 | let 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 | |||
76 | let get_state () = { tio = handle_unix_error tcgetattr stdin; size = (-1, -1) } | ||
77 | |||
78 | let 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 | |||
94 | let 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 | |||
121 | let restore_status tio = | ||
122 | let syscall () = tcsetattr stdin TCSAFLUSH tio in | ||
123 | handle_unix_error syscall | ||
124 | |||
125 | let 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 () } | ||