diff options
Diffstat (limited to 'ocaml/lib/dill.ml')
| -rw-r--r-- | ocaml/lib/dill.ml | 146 |
1 files changed, 146 insertions, 0 deletions
diff --git a/ocaml/lib/dill.ml b/ocaml/lib/dill.ml new file mode 100644 index 0000000..1384af9 --- /dev/null +++ b/ocaml/lib/dill.ml @@ -0,0 +1,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 |
