1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
open Core
type clear_line =
| To_line_end
| To_line_start
| Whole_line
[@@deriving compare ~localize, equal ~localize, quickcheck, sexp]
type clear_screen =
| To_screen_end
| To_screen_start
| Whole_screen
| Screen_and_scrollback
[@@deriving compare ~localize, equal ~localize, quickcheck, sexp]
type t =
| CursorUp of int option
| CursorDown of int option
| CursorForward of int option
| CursorBackward of int option
| CursorNextLine of int option
| CursorPrevLine of int option
| CursorToCol of int option
| CursorToPos of int option * int option
| EraseDisplay of clear_screen option
| EraseLine of clear_line option
| ScrollUp of int option
| ScrollDown of int option
| Unknown of
{ params : int option list
; terminal : char
}
[@@deriving compare ~localize, equal ~localize, quickcheck, sexp]
let quickcheck_generator =
let open Base_quickcheck.Generator in
let open Base_quickcheck.Generator.Let_syntax in
let nonneg_int_option = Option.quickcheck_generator (int_inclusive 0 999) in
let gen_unknown =
let%bind params =
List.quickcheck_generator (Option.quickcheck_generator (int_inclusive 0 999))
in
let%bind terminal = of_list [ 'p'; 'q'; 'r'; 's'; 't'; 'u' ] in
return (Unknown { params; terminal })
in
union
[ map nonneg_int_option ~f:(fun n -> CursorUp n)
; map nonneg_int_option ~f:(fun n -> CursorDown n)
; map nonneg_int_option ~f:(fun n -> CursorForward n)
; map nonneg_int_option ~f:(fun n -> CursorBackward n)
; map nonneg_int_option ~f:(fun n -> CursorNextLine n)
; map nonneg_int_option ~f:(fun n -> CursorPrevLine n)
; map nonneg_int_option ~f:(fun n -> CursorToCol n)
; (let%bind n = nonneg_int_option in
let%bind m = nonneg_int_option in
return (CursorToPos (n, m)))
; map [%quickcheck.generator: clear_screen option] ~f:(fun c -> EraseDisplay c)
; map [%quickcheck.generator: clear_line option] ~f:(fun c -> EraseLine c)
; map nonneg_int_option ~f:(fun n -> ScrollUp n)
; map nonneg_int_option ~f:(fun n -> ScrollDown n)
; gen_unknown
]
;;
let of_csi_params params ~terminal =
let n = List.hd params |> Option.join in
let unknown () = Unknown { params; terminal } in
match terminal with
| 'A' -> CursorUp n
| 'B' -> CursorDown n
| 'C' -> CursorForward n
| 'D' -> CursorBackward n
| 'E' -> CursorNextLine n
| 'F' -> CursorPrevLine n
| 'G' -> CursorToCol n
| 'H' ->
let m = List.nth params 1 |> Option.join in
CursorToPos (n, m)
| 'J' ->
(match n with
| None -> EraseDisplay None
| Some 0 -> EraseDisplay (Some To_screen_end)
| Some 1 -> EraseDisplay (Some To_screen_start)
| Some 2 -> EraseDisplay (Some Whole_screen)
| Some 3 -> EraseDisplay (Some Screen_and_scrollback)
| Some _ -> unknown ())
| 'K' ->
(match n with
| None -> EraseLine None
| Some 0 -> EraseLine (Some To_line_end)
| Some 1 -> EraseLine (Some To_line_start)
| Some 2 -> EraseLine (Some Whole_line)
| Some _ -> unknown ())
| 'S' -> ScrollUp n
| 'T' -> ScrollDown n
| _ -> unknown ()
;;
let to_string = function
| CursorUp None -> "\027[A"
| CursorUp (Some n) -> sprintf "\027[%dA" n
| CursorDown None -> "\027[B"
| CursorDown (Some n) -> sprintf "\027[%dB" n
| CursorForward None -> "\027[C"
| CursorForward (Some n) -> sprintf "\027[%dC" n
| CursorBackward None -> "\027[D"
| CursorBackward (Some n) -> sprintf "\027[%dD" n
| CursorNextLine None -> "\027[E"
| CursorNextLine (Some n) -> sprintf "\027[%dE" n
| CursorPrevLine None -> "\027[F"
| CursorPrevLine (Some n) -> sprintf "\027[%dF" n
| CursorToCol None -> "\027[G"
| CursorToCol (Some n) -> sprintf "\027[%dG" n
| CursorToPos (None, None) -> "\027[H"
| CursorToPos (Some n, None) -> sprintf "\027[%dH" n
| CursorToPos (None, Some m) -> sprintf "\027[;%dH" m
| CursorToPos (Some n, Some m) -> sprintf "\027[%d;%dH" n m
| EraseDisplay None -> "\027[J"
| EraseDisplay (Some To_screen_end) -> "\027[0J"
| EraseDisplay (Some To_screen_start) -> "\027[1J"
| EraseDisplay (Some Whole_screen) -> "\027[2J"
| EraseDisplay (Some Screen_and_scrollback) -> "\027[3J"
| EraseLine None -> "\027[K"
| EraseLine (Some To_line_end) -> "\027[0K"
| EraseLine (Some To_line_start) -> "\027[1K"
| EraseLine (Some Whole_line) -> "\027[2K"
| ScrollUp None -> "\027[S"
| ScrollUp (Some n) -> sprintf "\027[%dS" n
| ScrollDown None -> "\027[T"
| ScrollDown (Some n) -> sprintf "\027[%dT" n
| Unknown { params; terminal } ->
let params_str =
List.map params ~f:(function
| None -> ""
| Some i -> Int.to_string i)
|> String.concat ~sep:";"
in
sprintf "\027[%s%c" params_str terminal
;;
let to_string_hum = function
| CursorUp None -> "(CursorUp)"
| CursorUp (Some n) -> sprintf "(CursorUp:%d)" n
| CursorDown None -> "(CursorDown)"
| CursorDown (Some n) -> sprintf "(CursorDown:%d)" n
| CursorForward None -> "(CursorForward)"
| CursorForward (Some n) -> sprintf "(CursorForward:%d)" n
| CursorBackward None -> "(CursorBackward)"
| CursorBackward (Some n) -> sprintf "(CursorBackward:%d)" n
| CursorNextLine None -> "(CursorNextLine)"
| CursorNextLine (Some n) -> sprintf "(CursorNextLine:%d)" n
| CursorPrevLine None -> "(CursorPrevLine)"
| CursorPrevLine (Some n) -> sprintf "(CursorPrevLine:%d)" n
| CursorToCol None -> "(CursorToCol:1)"
| CursorToCol (Some n) -> sprintf "(CursorToCol:%d)" n
| CursorToPos (None, None) -> "(CursorToPos:1;1)"
| CursorToPos (Some n, None) -> sprintf "(CursorToPos:%d;1)" n
| CursorToPos (None, Some m) -> sprintf "(CursorToPos:1;%d)" m
| CursorToPos (Some n, Some m) -> sprintf "(CursorToPos:%d;%d)" n m
| EraseDisplay None | EraseDisplay (Some To_screen_end) -> "(EraseScreen:ToEnd)"
| EraseDisplay (Some To_screen_start) -> "(EraseScreen:ToStart)"
| EraseDisplay (Some Whole_screen) -> "(EraseScreen)"
| EraseDisplay (Some Screen_and_scrollback) -> "(EraseScreen:AndScrollback)"
| EraseLine None | EraseLine (Some To_line_end) -> "(EraseLine:ToEnd)"
| EraseLine (Some To_line_start) -> "(EraseLine:ToStart)"
| EraseLine (Some Whole_line) -> "(EraseLine)"
| ScrollUp None -> "(ScrollUp)"
| ScrollUp (Some n) -> sprintf "(ScrollUp:%d)" n
| ScrollDown None -> "(ScrollDown)"
| ScrollDown (Some n) -> sprintf "(ScrollDown:%d)" n
| Unknown { params; terminal } ->
let params_str =
List.map params ~f:(function
| None -> ""
| Some i -> Int.to_string i)
|> String.concat ~sep:";"
in
sprintf "(ANSI-CSI:%s%c)" params_str terminal
;;