scroll, but need to deal with text disappearing when tabs are under cursor?

ogui.ml

@@ -492,23 +492,21 @@ module TextLayout = struct
 
   let cursor_default = { index = 0; last_col = 0 }
 
-  let cursor ?(row : int option) ?(last_col = 0) index : cursor =
+  let cursor ?(last_col = 0) index : cursor =
-    F.epr "cursor row=%a last_col=%d index=%d@."
+    F.epr "cursor last_col=%d index=%d@." last_col index;
-      F.(option int)
-      row last_col index;
     { index; last_col }
 
-  let simple text ?(format = format_default) wrap_width : layout Lwt.t
+  let simple text ?(start = 0) ?(format = format_default) wrap_width :
-      =
+      layout Lwt.t =
-    TextBuffer.length text >>= fun textlen ->
+    TextBuffer.fold_string text (fun s ->
-    Lwt.return
+        {
-      {
+          layout_default with
-        layout_default with
+          text;
-        text;
+          sections =
-        sections = [ { byte_range = (0, textlen); format } ];
+            [ { byte_range = (start, String.length s); format } ];
-        wrap =
+          wrap =
-          { (default_text_wrapping ()) with max_width = wrap_width };
+            { (default_text_wrapping ()) with max_width = wrap_width };
-      }
+        })
 
   let cursor_color = ref (Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.)
 
@@ -731,6 +729,8 @@ module TextEdit = struct
     mutable text : TextBuffer.t;
     mutable cursor : TextLayout.cursor;
     mutable mark : int option;
+    mutable scroll : int;
+    mutable rows : int;
     text_format : TextLayout.format;
     formatter :
       (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option;
@@ -750,27 +750,55 @@ module TextEdit = struct
 
   let col t =
     TextBuffer.fold_string t.text (fun s ->
-        Str.search_backward (Str.regexp "^") s t.cursor.index)
+        t.cursor.index
+        - Str.search_backward (Str.regexp "^") s t.cursor.index)
 
-  let cursor_set (t : t) (index : int) : unit Lwt.t =
+  let rec newlines (s : string) (i : int) : int list =
+    match String.index_from_opt s i '\n' with
+    | Some i' -> i :: newlines s i'
+    | None -> []
+
+  let rec index_rows_from (s : string) (start : int) (rows : int) :
+      int option =
+    match String.index_from_opt s start '\n' with
+    | Some start' ->
+        if rows - 1 > 0 then index_rows_from s (start' + 1) (rows - 1)
+        else Some (start' + 1)
+    | None -> None
+
+  let scroll_update ({ text; cursor; scroll; rows; _ } as t : t) :
+      unit Lwt.t =
+    F.epr "scroll_update cursor=%d scroll=%d rows=%d" cursor.index
+      scroll rows;
+    TextBuffer.fold_string text (fun s ->
+        (if cursor.index < scroll then
+           match String.rindex_from_opt s cursor.index '\n' with
+           | Some i' -> t.scroll <- i' + 1
+           | None -> t.scroll <- 0
+         else
+           match index_rows_from s scroll rows with
+           | None -> (* eof *) ()
+           | Some eow -> (
+               F.epr " eow=%d" eow;
+               if cursor.index > eow then
+                 match String.index_from_opt s cursor.index '\n' with
+                 | None -> ()
+                 | Some i' -> t.scroll <- i' + 1));
+        F.epr "@.")
+
+  let cursor_update (t : t) (f : int -> int) : unit Lwt.t =
+    col t >>= fun last_col ->
     TextBuffer.fold_string t.text (fun s ->
-        let index' = index |> max 0 |> min (String.length s) in
         t.cursor <-
-          TextLayout.cursor
+          TextLayout.cursor ~last_col
-            ~last_col:
+            (f t.cursor.index |> max 0 |> min (String.length s)))
-              (index' - Str.search_backward (Str.regexp "^") s index')
+    >>= fun () -> scroll_update t
-            index')
 
   let cursor_move (t : t) (amt : int) : unit Lwt.t =
-    TextBuffer.fold_string t.text (fun s ->
+    cursor_update t (( + ) amt)
-        let index' =
+
-          t.cursor.index + amt |> max 0 |> min (String.length s)
+  let cursor_set (t : t) (index : int) : unit Lwt.t =
-        in
+    cursor_update t (Fun.const index)
-        t.cursor <-
-          TextLayout.cursor
-            ~last_col:
-              (index' - Str.search_backward (Str.regexp "^") s index')
-            index')
 
   let default_bindings (t : t) (ui : Ui.t) : unit Lwt.t =
     let open GLFW in
@@ -815,21 +843,12 @@ module TextEdit = struct
                        let next_line_len =
                          seol s next_bol - next_bol
                        in
-                       (* F.epr
+                       next_bol
-                          "Down: index=%d last_col=%d eol=%d eol'=%d \
+                       +
-                           bol=%d @."
+                       if t.cursor.last_col > next_line_len then
-                           t.cursor.index last_col  eol' bol; *)
+                         next_line_len
-                       t.cursor <-
+                       else min next_line_len t.cursor.last_col)
-                         {
+                   >>= cursor_set t);
-                           t.cursor with
-                           index =
-                             (next_bol
-                             +
-                             if t.cursor.last_col > next_line_len then
-                               next_line_len
-                             else min next_line_len t.cursor.last_col
-                             );
-                         }));
              ]
         |> adds
              [
@@ -853,17 +872,14 @@ module TextEdit = struct
                            "up: index=%d bol=%d prev_bol=%d \
                             prev_line_len=%d @."
                            t.cursor.index bol prev_bol prev_line_len;
-                         t.cursor <-
+
-                           {
+                         prev_bol
-                             t.cursor with
+                         +
-                             index =
+                         if t.cursor.last_col > prev_line_len then
-                               (prev_bol
+                           prev_line_len
-                               +
+                         else min prev_line_len t.cursor.last_col)
-                               if t.cursor.last_col > prev_line_len
+                       else t.cursor.index)
-                               then prev_line_len
+                   >>= cursor_set t);
-                               else
-                                 min prev_line_len t.cursor.last_col);
-                           })));
              ]
         |> adds (* EOL *)
              [
@@ -988,6 +1004,8 @@ module TextEdit = struct
         text;
         cursor = TextLayout.cursor 0;
         mark = None;
+        scroll = 0;
+        rows = 0;
         text_format;
         formatter = None;
         password = false;
@@ -1106,13 +1124,14 @@ module Painter = struct
     Text.set_size t ~size:font_size;
     Text.set_align t ~align:Align.(left lor top)
 
-  let text_layout (t : Gv.t) (rect : box2) (g : TextLayout.layout) :
+  let text_layout (t : Gv.t) (rect : box2) (te : TextEdit.t)
-      box2 Lwt.t =
+      (g : TextLayout.layout) : box2 Lwt.t =
     let line_height =
       Option.value ~default:(Gv.Text.metrics t).line_height
         g.line_height
     in
     let max_rows = Int.of_float (Box2.h rect /. line_height) in
+    te.rows <- max_rows;
     let lines = Gv.Text.make_empty_rows max_rows in
     TextBuffer.contents g.text >>= fun contents ->
     let contents_len = String.length contents in
@@ -1191,12 +1210,12 @@ module Painter = struct
           box' ll
     | `TextEdit t ->
         TextLayout.(
-          simple t.text ~format:t.text_format
+          simple t.text ~start:t.scroll ~format:t.text_format
             (Option.value ~default:(Box2.w box') t.desired_width)
           >>= fun layout ->
           with_cursor t.cursor layout
           |> with_mark t.mark t.cursor.index
-          |> text_layout ui.gv box')
+          |> text_layout ui.gv box' t)
     | _ -> Lwt.return box)
     >>= fun r ->
     let r' = Margin.outer frame.style.margin r in

oplevel.ml

@@ -104,14 +104,14 @@ let () =
       Layout.(
         vbox
           [
-            textedit
-              (TextEdit.multiline ui
-                 (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo));
             textedit
               (TextEdit.multiline ui
                  (TextBuffer.of_repo
                     ~path:[ ".config"; "init.ml" ]
                     ~repo:rootrepo));
+            textedit
+              (TextEdit.multiline ui
+                 (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo));
           ])
   in