From 055c743c55bde27f4475d3434c26d8383c0c3ea1 Mon Sep 17 00:00:00 2001 From: Federico Igne Date: Thu, 11 Jan 2024 19:31:31 +0100 Subject: bulk: add PoC of vim-like modular editor --- lib/editor.ml | 271 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 271 insertions(+) create mode 100644 lib/editor.ml (limited to 'lib/editor.ml') diff --git a/lib/editor.ml b/lib/editor.ml new file mode 100644 index 0000000..c3e298e --- /dev/null +++ b/lib/editor.ml @@ -0,0 +1,271 @@ +open Base +module Buffer = EditorBuffer +open Util + +type mode = Normal | Insert +type cursor = int * int + +type editor = { + term : Terminal.state; + mode : mode; + offset : int * int; + cursor : cursor; + buffer : Buffer.t option; + pending : Key.t Sequence.t; + i_pending : Command.t Sequence.t; + n_pending : Command.t Sequence.t; +} + +type t = editor + +let init (c : Config.t) : editor = + { + term = Terminal.init (); + mode = Normal; + offset = (0, 0); + cursor = (1, 1); + buffer = List.hd c.files |> Option.map ~f:Buffer.from_file; + pending = Key.stream; + i_pending = Command.i_stream; + n_pending = Command.n_stream; + } + +type 'a action = t -> 'a * t + +module Action = struct + let run ~editor action = action () editor + let eval ~editor action = run ~editor action |> fst + let exec ~editor action = run ~editor action |> snd + + include Applicative.Make (struct + type 'a t = 'a action + + let return a s = (a, s) + + let apply f a e = + let f, e' = f e in + let x, e'' = a e' in + (f x, e'') + + let map = `Define_using_apply + end) + + include Monad.Make (struct + type 'a t = 'a action + + let return x s = (x, s) + + let bind a ~f x = + let y, a' = a x in + f y a' + + let map = `Define_using_bind + end) + + let get e = (e, e) + let put e _ = ((), e) + let modify ~f e = ((), f e) + + let update_cursor = + let aux e = + let dx, dy = e.offset and rs, cs = e.term.size in + match Option.map ~f:Buffer.cursor e.buffer with + | None -> { e with cursor = (1, 1); offset = (0, 0) } + | Some (cx, cy) -> + let dx' = Int.clamp_exn ~min:(cx - rs) ~max:cx dx + and dy' = Int.clamp_exn ~min:(cy - cs) ~max:cy dy in + { e with cursor = (cx - dx' + 1, cy - dy' + 1); offset = (dx', dy') } + in + modify ~f:aux + + let get_mode s = (s.mode, s) + let set_mode m s = ((), { s with mode = m }) + let get_focused_buffer e = (e.buffer, e) + let set_focused_buffer b e = ((), { e with buffer = Some b }) + + let on_focused_buffer f = + let f e = { e with buffer = Option.map ~f e.buffer } in + modify ~f *> update_cursor + + let on_focused_buffer_or_new f = + (get_focused_buffer + >>| Option.value ~default:Buffer.empty + >>| f >>= set_focused_buffer) + *> update_cursor + + let render = + let welcome (r, c) = + let open Text in + let hfill = ' ' and vfill = Sequence.empty in + "Welcome to the sand editor!" |> String.to_list |> Sequence.of_list + |> center ~fill:hfill c |> Sequence.singleton |> center ~fill:vfill r + in + let aux e = + let x, y = e.offset + and ((r, c) as size) = e.term.size + and fill = Sequence.singleton '~' in + let view = + Option.( + e.buffer >>| Buffer.view x y r c + |> value ~default:(welcome size) + |> Text.extend ~fill r) + in + Terminal.redraw view e.cursor + in + get >>| aux + + (* TODO: save logic *) + let quit n = Stdlib.exit n + let noop = return () +end + +let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) = + (x + down - up, y + right - left) + +let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy) + +(* let get_next_command s = *) +(* match Sequence.next s.pending with *) +(* | None -> (None, s) *) +(* | Some (h, t) -> (Some h, { s with pending = t }) *) + +(* let handle_insert_key = *) +(* let open Action in *) +(* let open Key in *) +(* function *) +(* | Arrow_down -> Buffer.Action.down |> on_focused_buffer *) +(* | Arrow_left -> Buffer.Action.left |> on_focused_buffer *) +(* | Arrow_right -> Buffer.Action.right |> on_focused_buffer *) +(* | Arrow_up -> Buffer.Action.up |> on_focused_buffer *) +(* | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *) +(* | Ctrl 'Q' -> quit 0 *) +(* | Delete -> Buffer.Action.delete_after |> on_focused_buffer *) +(* | Enter -> Buffer.Action.newline |> on_focused_buffer *) +(* | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *) +(* | Key k -> Buffer.Action.insert k |> on_focused_buffer *) +(* | _ -> noop *) + +(* let handle_normal_key = *) +(* let open Action in *) +(* let open Key in *) +(* function *) +(* | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *) +(* | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *) +(* | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *) +(* | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *) +(* | Ctrl 'Q' -> quit 0 *) +(* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *) +(* | Key 'A' -> *) +(* (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *) +(* | Key 'a' -> *) +(* (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *) +(* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) +(* | Key 'I' -> *) +(* noop *) +(* (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *) +(* | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *) +(* | Key 's' -> *) +(* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) +(* *> set_mode Insert *) +(* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *) +(* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *) +(* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *) +(* | _ -> noop *) + +(* let handle_next_command = *) +(* let f m = function *) +(* | None -> Action.return () *) +(* | Some k -> ( *) +(* match m with *) +(* | Insert -> handle_insert_key k *) +(* | Normal -> handle_normal_key k) *) +(* in *) +(* Action.(map2 ~f get_mode get_next_command |> join) *) + +let handle_insert_command = + let open Command in + let open Action in + function + | Simple Arrow_down -> Buffer.Action.down |> on_focused_buffer + | Simple Arrow_left -> Buffer.Action.left |> on_focused_buffer + | Simple Arrow_right -> Buffer.Action.right |> on_focused_buffer + | Simple Arrow_up -> Buffer.Action.up |> on_focused_buffer + | Simple Backspace -> Buffer.Action.delete_before ~n:1 |> on_focused_buffer + | Simple (Ctrl 'Q') -> quit 0 + | Simple Delete -> Buffer.Action.delete_after ~n:1 |> on_focused_buffer + | Simple Enter -> Buffer.Action.newline |> on_focused_buffer + | Simple Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal + | Type k -> Buffer.Action.insert k |> on_focused_buffer + | _ -> noop + +let handle_normal_command = + let open Command in + let open Action in + function + (* Movements *) + | Chord (_, n, Noop, _, Down) -> Buffer.Action.down ?n |> on_focused_buffer + | Chord (_, n, Noop, _, Left) -> Buffer.Action.left ?n |> on_focused_buffer + | Chord (_, n, Noop, _, Right) -> Buffer.Action.right ?n |> on_focused_buffer + | Chord (_, n, Noop, _, Up) -> Buffer.Action.up ?n |> on_focused_buffer + | Simple (Ctrl 'Q') -> quit 0 + (* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *) + | Simple (Key 'A') -> + (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert + | Simple (Key 'a') -> + (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert + (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *) + (* | Key 'I' -> noop *) + | Simple (Key 'i') -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert + (* | Key 's' -> *) + (* (Buffer.Action.delete_after |> on_focused_buffer_or_new) *) + (* *> set_mode Insert *) + (* | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *) + (* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *) + (* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *) + | Shortcut (_, n, Change, Line) -> + let n = Option.value ~default:1 n - 1 in + (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol) + |> on_focused_buffer_or_new) + *> set_mode Insert + | Shortcut (_, _, Change, To_eol) -> + (Buffer.Action.delete_to_eol |> on_focused_buffer_or_new) + *> set_mode Insert + | Shortcut (_, _, Change, To_bol) -> + (Buffer.Action.delete_to_bol |> on_focused_buffer_or_new) + *> set_mode Insert + (* Delete *) + | Chord (_, n1, Delete, n2, Down) -> + let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in + Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new + | Chord (_, n1, Delete, n2, Left) -> + let n = Option.(value ~default:1 n1 * value ~default:1 n2) in + Buffer.Action.delete_before ~n |> on_focused_buffer_or_new + | Chord (_, n1, Delete, n2, Right) -> + let n = Option.(value ~default:1 n1 * value ~default:1 n2) in + Buffer.Action.delete_after ~n |> on_focused_buffer_or_new + | Chord (_, n1, Delete, n2, Up) -> + let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in + Buffer.Action.delete_lines_before ~n |> on_focused_buffer_or_new + | Shortcut (_, n, Delete, Line) -> + Buffer.Action.delete_lines ~n:Option.(value ~default:1 n) + |> on_focused_buffer_or_new + | Shortcut (_, _, Delete, To_eol) -> + Buffer.Action.delete_to_eol |> on_focused_buffer_or_new + | Shortcut (_, _, Delete, To_bol) -> + Buffer.Action.delete_to_bol |> on_focused_buffer_or_new + | _ -> noop + +let handle_next_command2 m e = + match m with + | Insert -> ( + match Sequence.next e.i_pending with + | None -> ((), e) + | Some (h, t) -> handle_insert_command h { e with i_pending = t }) + | Normal -> ( + match Sequence.next e.n_pending with + | None -> ((), e) + | Some (h, t) -> handle_normal_command h { e with n_pending = t }) + +let handle_next_command2 = + let open Action in + get_mode >>= handle_next_command2 -- cgit v1.2.3