1 files changed, 195 insertions, 62 deletions

diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
index ea89fb9..e1706dd 100644
--- a/lib/editorBuffer.ml
+++ b/lib/editorBuffer.ml
@@ -5,104 +5,237 @@ open Util
 
 type kind = File of string | No_name | Scratch
 type error = No_such_file | Other
-type buffer = { kind : kind; content : (char zipper zipper, error) Result.t }
+
+type buffer = {
+  kind : kind;
+  content : (char zipper zipper, error) Result.t;
+  rendered : char Sequence.t zipper;
+}
+
 type t = buffer
 
 let empty =
-  { kind = No_name; content = empty |> push_after empty |> Result.return }
+  {
+    kind = No_name;
+    content = empty |> push empty |> Result.return;
+    rendered = push Sequence.empty empty;
+  }
+
+let render =
+  let open Sequence in
+  let tabsize = 8 in
+  let f i = function
+    | '\t' ->
+        let width = tabsize - (i % tabsize) in
+        (i + width, take (repeat '.') width)
+    | c -> (i + 1, singleton c)
+  in
+  folding_map ~init:0 ~f &> join
+
+let cursor ?(rendered = true) b =
+  match b.content with
+  | Error _ -> (0, 0)
+  | Ok c ->
+      let hlen z =
+        if rendered then
+          Sequence.(length (before z |> to_list_rev |> of_list |> render))
+        else left_length z
+      in
+      (left_length c, apply_focus_or ~default:0 hlen c)
 
 module Action = struct
   let on_content f b = { b with content = Result.map ~f b.content }
+  let on_rendered f b = { b with rendered = f b.rendered }
+
+  (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *)
 
-  let move_up, move_down, move_left, move_right =
-    let vertical f ?(n = 1) =
+  let update_render_at_cursor b =
+    match b.content with
+    | Error _ -> b
+    | Ok c ->
+        let l = apply_focus_or ~default:Sequence.empty (to_seq &> render) c in
+        { b with rendered = swap_focus l b.rendered }
+
+  let move_up ?(n = 1) =
+    let change_content =
+      on_content (fun z ->
+          let col = apply_focus_or ~default:0 left_length z in
+          Fn.apply_n_times ~n left z |> map_focus (goto col))
+    and change_rendered = on_rendered (Fn.apply_n_times ~n left) in
+    change_content &> change_rendered
+
+  let move_down ?(n = 1) =
+    let change_content =
       on_content (fun z ->
-          let col = focus_or ~default:Zipper.empty z |> left_length in
-          Fn.apply_n_times ~n f z |> map_focus (goto col))
-    and horizontal f ?(n = 1) =
-      Fn.apply_n_times ~n (map_focus f) |> on_content
+          let col = apply_focus_or ~default:0 left_length z in
+          Fn.apply_n_times ~n right z |> map_focus (goto col))
+    and change_rendered = on_rendered (Fn.apply_n_times ~n right) in
+    change_content &> change_rendered
+
+  let move_left, move_right =
+    let horizontal f ?(n = 1) =
+      let change_content = map_focus (Fn.apply_n_times ~n f) |> on_content in
+      change_content &> update_render_at_cursor
     in
-    (vertical left, vertical right, horizontal left, horizontal right)
+    (horizontal left, horizontal right)
 
   let bol = map_focus far_left |> on_content
   let eol = map_focus far_right |> on_content
-  let bof = far_left |> on_content
-  let eof = far_right |> on_content
-  let insert k = map_focus (push k) |> on_content
+
+  let bof =
+    let change_content = far_left |> on_content
+    and change_rendered = far_left |> on_rendered in
+    change_content &> change_rendered
+
+  let eof =
+    let change_content = far_right |> on_content
+    and change_rendered = far_right |> on_rendered in
+    change_content &> change_rendered
+
+  let insert k =
+    let change_content = map_focus (push_before k) |> on_content in
+    change_content &> update_render_at_cursor
+
   (* let replace k = () *)
 
-  let delete_after ?(cross_lines = false) ~n =
-    let aux z =
-      let line = focus_or ~default:Zipper.empty z in
-      if cross_lines && is_far_right line && not (is_far_right z) then
-        pop_after z |> map_focus_or ~default:line (far_left &> join line)
-      else map_focus pop_after z
+  let join_lines ?(n = 2) =
+    let change_content =
+      let join_2_lines z =
+        if right_length z < 2 then z
+        else
+          let to_join = right z |> focus_or ~default:Zipper.empty in
+          map_focus (join ~z2:to_join) z |> pop_after
+      in
+      Fn.apply_n_times ~n:(n - 1) join_2_lines |> on_content
+    and change_rendered = pop_after ~n:(n - 1) |> on_rendered in
+    change_content &> change_rendered &> update_render_at_cursor
+
+  let delete_after ?(cross_lines = false) ~n b =
+    let lines_to_delete =
+      match b.content with
+      | Error _ -> 0
+      | Ok z -> (
+          match Sequence.next (after z) with
+          | None -> 0
+          | Some (h, t) ->
+              let init = right_length h
+              and f acc z =
+                let acc' = acc + length z + 1 in
+                (acc', acc')
+              in
+              Sequence.shift_right (Sequence.folding_map t ~init ~f) init
+              |> Sequence.findi ~f:(fun _ a -> n <= a)
+              |> Option.map ~f:fst
+              |> Option.value ~default:(Sequence.length t))
     in
-    Fn.apply_n_times ~n aux |> on_content
-
-  let delete_before ?(cross_lines = false) ~n =
-    let aux z =
-      let line = focus_or ~default:Zipper.empty z in
-      if cross_lines && is_far_left line && not (is_far_left z) then
-        pop_after z |> left |> map_focus (far_right &> Fn.flip join line)
-      else map_focus pop z
+    let change_content =
+      let delete_1_after z =
+        let line = focus_or ~default:Zipper.empty z in
+        if cross_lines && is_far_right line && not (is_far_right z) then
+          let to_join = right z |> focus_or ~default:Zipper.empty in
+          map_focus (join ~z2:to_join) z |> pop_after
+        else map_focus pop z
+      in
+      Fn.apply_n_times ~n delete_1_after |> on_content
+    and change_rendered =
+      if cross_lines then pop_after ~n:lines_to_delete |> on_rendered else Fn.id
     in
-    Fn.apply_n_times ~n aux |> on_content
+    b |> change_content |> change_rendered |> update_render_at_cursor
+
+  let delete_before ?(cross_lines = false) ~n b =
+    let lines_to_delete =
+      match b.content with
+      | Error _ -> 0
+      | Ok z ->
+          let init = apply_focus_or ~default:0 left_length z
+          and f acc z =
+            let acc' = acc + length z + 1 in
+            (acc', acc')
+          in
+          Sequence.shift_right (Sequence.folding_map (before z) ~init ~f) init
+          |> Sequence.findi ~f:(fun _ a -> n <= a)
+          |> Option.map ~f:fst
+          |> Option.value ~default:(left_length z)
+    in
+    let change_content =
+      let delete_1_before z =
+        let line = focus_or ~default:Zipper.empty z in
+        if cross_lines && is_far_left line && not (is_far_left z) then
+          left z |> map_focus (join ~z2:line) |> pop_after
+        else map_focus pop_before z
+      in
+      Fn.apply_n_times ~n delete_1_before |> on_content
+    and change_rendered =
+      if cross_lines then pop_before ~n:lines_to_delete |> on_rendered
+      else Fn.id
+    in
+    b |> change_content |> change_rendered |> update_render_at_cursor
+
+  let delete_to_eol =
+    map_focus (split &> fst) |> on_content &> update_render_at_cursor
 
-  let delete_to_eol = map_focus (split &> fst) |> on_content
-  let delete_to_bol = map_focus (split &> snd) |> on_content
-  let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content
-  let delete_lines_before ~n = Fn.apply_n_times ~n pop_before |> on_content
+  let delete_to_bol =
+    map_focus (split &> snd) |> on_content &> update_render_at_cursor
+
+  let delete_lines ~n =
+    let change_content = pop ~n |> on_content
+    and change_rendered = pop ~n |> on_rendered in
+    change_content &> change_rendered
+
+  let delete_lines_before ~n =
+    let change_content = pop_before ~n |> on_content
+    and change_rendered = pop_before ~n |> on_rendered in
+    change_content &> change_rendered
 
   let newline =
-    let aux z =
-      let l1, l2 = focus_or ~default:Zipper.empty z |> split in
-      push_before l1 z |> map_focus (Fn.const l2)
-    in
-    on_content aux
-
-  let join_lines ~n =
-    let aux z =
-      if is_far_right z || is_far_right (right z) then z
-      else
-        let line = focus_or ~default:Zipper.empty z |> far_right in
-        pop_after z |> map_focus (far_left &> join line)
+    let change_content =
+      let aux z =
+        let default = (Zipper.empty, Zipper.empty) in
+        let l1, l2 = apply_focus_or ~default split z in
+        push_before l1 z |> swap_focus l2
+      in
+      on_content aux
+    and change_rendered b =
+      match b.content with
+      | Error _ -> b
+      | Ok c -> (
+          match Sequence.next (before c) with
+          | None -> failwith "newline > change_rendered: unreachable"
+          | Some (h, _) ->
+              { b with rendered = push_before (to_seq h |> render) b.rendered })
     in
-    Fn.apply_n_times ~n aux |> on_content
+    change_content &> change_rendered &> update_render_at_cursor
 
   (* let save_history_to ?(clear = true) r = () *)
 end
 
 let from_file f =
   let lines =
+    let line_to_seq l = String.to_list l |> Sequence.of_list in
     try
       let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in
       let ic = Unix.in_channel_of_descr fd in
       let lines = In_channel.input_lines ic in
       In_channel.close ic;
-      lines
-    with Unix.Unix_error (ENOENT, _, _) -> []
+      Sequence.(of_list lines |> map ~f:line_to_seq)
+    with Unix.Unix_error (ENOENT, _, _) -> Sequence.empty
   in
-  let content =
-    let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in
-    Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq
-  in
-  { kind = File f; content = Ok content }
-
-let cursor b =
-  let open Option in
-  let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0)
-  and y =
-    Result.(map ~f:focus b.content |> ok)
-    |> join |> map ~f:left_length |> value ~default:0
-  in
-  (x, y)
+  let rendered = Sequence.map ~f:render lines |> of_seq in
+  let content = Sequence.map ~f:of_seq lines |> of_seq in
+  { kind = File f; content = Ok content; rendered }
 
-let view x y h w b =
+let unrendered_view x y h w b =
   match b.content with
   | Error _ -> Sequence.empty
   | Ok z ->
       let cx, _ = cursor b in
-      context ~b:(cx - x) ~a:(x + h - cx) z
+      context ~l:(cx - x) ~r:(x + h - cx) z
       |> to_seq
       |> Sequence.map ~f:(window ~from:y ~len:w)
+
+let rendered_view x y h w b =
+  let window from len seq = Sequence.(take (drop_eagerly seq from) len) in
+  let cx, _ = cursor b in
+  context ~l:(cx - x) ~r:(x + h - cx) b.rendered
+  |> to_seq
+  |> Sequence.map ~f:(window y w)