blob: 1384af9da3aaa9a63a6ee7f4a5cd8276d0aec715 (
plain)
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
|
(** Dill - Terminal I/O driver using Eio *)
open Noun
(** Belt event types (keyboard input) *)
type belt =
| Aro of [`d | `l | `r | `u] (* Arrow keys *)
| Bac (* Backspace *)
| Ctl of char (* Control-X *)
| Del (* Delete *)
| Met of char (* Meta/Alt-X *)
| Ret (* Return/Enter *)
| Txt of string list (* Text input *)
(** Blit event types (terminal output) *)
type blit =
| Lin of string (* Line of text *)
| Klr of noun (* Styled text *)
| Mor of blit list (* Multiple blits *)
| Hop of int (* Cursor hop *)
| Clr (* Clear screen *)
type effect = {
wire: noun;
blit: blit;
}
(** Render a blit to the terminal using Eio *)
let rec render_blit ~stdout = function
| Lin text ->
Eio.Flow.copy_string (text ^ "\n") stdout
| Klr _styled ->
(* TODO: Parse styled text and convert to ANSI codes *)
Eio.Flow.copy_string "<styled text>\n" stdout
| Mor blits ->
List.iter (render_blit ~stdout) blits
| Hop n ->
(* ANSI cursor movement *)
let ansi = Printf.sprintf "\x1b[%dC" n in
Eio.Flow.copy_string ansi stdout
| Clr ->
(* ANSI clear screen and home cursor *)
Eio.Flow.copy_string "\x1b[2J\x1b[H" stdout
(** Create a belt event noun from keyboard input *)
let make_belt_event wire belt_type =
let belt_atom = match belt_type with
| Ret -> atom_of_string "ret"
| Bac -> atom_of_string "bac"
| Del -> atom_of_string "del"
| Aro `u -> cell (atom_of_string "aro") (atom_of_string "u")
| Aro `d -> cell (atom_of_string "aro") (atom_of_string "d")
| Aro `l -> cell (atom_of_string "aro") (atom_of_string "l")
| Aro `r -> cell (atom_of_string "aro") (atom_of_string "r")
| Ctl c -> cell (atom_of_string "ctl") (atom (Z.of_int (Char.code c)))
| Met c -> cell (atom_of_string "met") (atom (Z.of_int (Char.code c)))
| Txt strs ->
let rec build_list = function
| [] -> atom Z.zero
| s :: rest ->
(* Each string in the list becomes a character code *)
let code = if String.length s > 0 then Char.code s.[0] else 0 in
cell (atom (Z.of_int code)) (build_list rest)
in
cell (atom_of_string "txt") (build_list strs)
in
let card = cell (atom_of_string "belt") belt_atom in
cell wire card
(** Parse line input into belt event *)
let parse_input line =
if String.length line = 0 then
Ret
else if line = "\x7f" || line = "\x08" then
Bac
else if String.length line = 1 && Char.code line.[0] < 32 then
Ctl line.[0]
else
let char_list = String.to_seq line |> List.of_seq in
let str_list = List.map (String.make 1) char_list in
Txt str_list
(** Run terminal input loop using Eio *)
let input_loop ~stdin ~state ~wire process_effects =
let buf_read = Eio.Buf_read.of_flow stdin ~max_size:4096 in
let rec loop () =
(* Read a line from terminal *)
try
let line = Eio.Buf_read.line buf_read in
let belt = parse_input (String.trim line) in
let ovum = make_belt_event wire belt in
(* Poke Arvo with belt event *)
let result = State.poke state ovum in
(* Process effects *)
process_effects result;
loop ()
with End_of_file -> ()
in
loop ()
(** Render effects to terminal *)
let render_effects ~stdout effects_noun =
(* Parse effects and filter for Dill *)
let rec parse_effects_list = function
| Atom z when Z.equal z Z.zero -> []
| Cell (Cell (wire, card), rest) ->
(* Check if this is a Dill effect *)
let is_dill = match wire with
| Cell (Atom d, Cell (Atom term, _)) ->
Z.equal d (Z.of_int (Char.code 'd')) &&
Z.equal term (Z.of_string "0x6d726574") (* 'term' *)
| _ -> false
in
if is_dill then
(wire, card) :: parse_effects_list rest
else
parse_effects_list rest
| _ -> []
in
let dill_effects = parse_effects_list effects_noun in
(* Render each blit *)
List.iter (fun (_wire, card) ->
match card with
| Cell (Atom tag, blit_noun) when Z.equal tag (Z.of_string "0x74696c62") (* 'blit' *) ->
(* Parse and render blit *)
let blit = match blit_noun with
| Cell (Atom lin_tag, Cell (Cell (_, text), _))
when Z.equal lin_tag (Z.of_string "0x6e696c") -> (* 'lin' *)
let str = match text with
| Atom z ->
if Z.equal z Z.zero then ""
else Z.to_bits z
| _ -> "(complex text)"
in
Lin str
| _ -> Lin "(unparsed blit)"
in
render_blit ~stdout blit
| _ -> ()
) dill_effects
|
