diff options
Diffstat (limited to 'lib/key.ml')
-rw-r--r-- | lib/key.ml | 72 |
1 files changed, 72 insertions, 0 deletions
diff --git a/lib/key.ml b/lib/key.ml new file mode 100644 index 0000000..85aa282 --- /dev/null +++ b/lib/key.ml | |||
@@ -0,0 +1,72 @@ | |||
1 | open Base | ||
2 | |||
3 | type key = | ||
4 | | Arrow_down | ||
5 | | Arrow_left | ||
6 | | Arrow_right | ||
7 | | Arrow_up | ||
8 | | Backspace | ||
9 | | Ctrl of char | ||
10 | | Delete | ||
11 | | End | ||
12 | | Enter | ||
13 | | Esc | ||
14 | | Home | ||
15 | | Key of char | ||
16 | | Nul | ||
17 | | Page_down | ||
18 | | Page_up | ||
19 | |||
20 | type t = key | ||
21 | |||
22 | let ctrl c = Ctrl c | ||
23 | let key c = Key c | ||
24 | |||
25 | let of_char = function | ||
26 | | '\000' -> Nul | ||
27 | | '\013' -> Enter | ||
28 | | '\027' -> Esc | ||
29 | | '\127' -> Backspace | ||
30 | | c when Char.(c < ' ') -> Char.to_int c + 64 |> Char.of_int_exn |> ctrl | ||
31 | | c -> Key c | ||
32 | |||
33 | let stream = | ||
34 | let step s c = | ||
35 | let open Sequence.Step in | ||
36 | let escaped = function | ||
37 | | 'A' -> Some Arrow_up | ||
38 | | 'B' -> Some Arrow_down | ||
39 | | 'C' -> Some Arrow_right | ||
40 | | 'D' -> Some Arrow_left | ||
41 | | 'F' -> Some End | ||
42 | | 'H' -> Some Home | ||
43 | | _ -> None | ||
44 | and tilda = function | ||
45 | | '1' -> Some Home | ||
46 | | '3' -> Some Delete | ||
47 | | '4' -> Some End | ||
48 | | '5' -> Some Page_up | ||
49 | | '6' -> Some Page_down | ||
50 | | '7' -> Some Home | ||
51 | | '8' -> Some End | ||
52 | | _ -> None | ||
53 | in | ||
54 | match (s, c) with | ||
55 | | `start, Some '\027' -> Skip { state = `esc } | ||
56 | | `esc, None -> Yield { value = Esc; state = `start } | ||
57 | | `esc, Some '[' | `escaped, Some 'O' -> Skip { state = `escaped } | ||
58 | | `escaped, Some i when Char.(i = '1' || ('3' <= i && i <= '8')) -> | ||
59 | Skip { state = `tilda i } | ||
60 | | `escaped, c -> ( | ||
61 | match Option.(c >>= escaped) with | ||
62 | | None -> Skip { state = `state } | ||
63 | | Some c -> Yield { value = c; state = `start }) | ||
64 | | `tilda i, Some '~' -> ( | ||
65 | match tilda i with | ||
66 | | None -> Skip { state = `start } | ||
67 | | Some k -> Yield { value = k; state = `start }) | ||
68 | | `esc, Some _ | `tilda _, _ -> Skip { state = `start } | ||
69 | | _, None -> Skip { state = `start } | ||
70 | | _, Some c -> Yield { value = of_char c; state = `start } | ||
71 | in | ||
72 | Sequence.unfold_with ~init:`start ~f:step Terminal.char_stream | ||