cleaned up

dune

@@ -26,10 +26,10 @@
    graphv_gles2_native
    gg
    irmin-git
-   compiler-libs.toplevel
+ ;  compiler-libs.toplevel
    re
  )
- (link_flags (-linkall))
+; (link_flags (-linkall))
  ; (ocamlopt_flags (:standard -O3 -unboxed-types))
   (ocamlc_flags (:standard -verbose))
  (modes byte)

ogui.ml

@@ -66,17 +66,21 @@ module TextBuffer = struct
   type t = {
     mutable path : string list;
     mutable tree : Store.S.tree;
-    repo : Store.Sync.db;
+    repo : Store.Sync.db Lwt.t;
   }
 
-  let of_repo ~path ~(repo : Store.Sync.db) =
+  let of_repo ~path ~(repo : Store.Sync.db Lwt.t) =
-    let tree = Lwt_main.run ((fun () -> Store.S.tree repo) ()) in
+    let tree = Lwt_main.run (repo >>= Store.S.tree) in
     { path; tree; repo }
 
   let of_string ~path ?(repo = None) str =
-    Store.S.Repo.v (Irmin_mem.config ()) >>= fun repo' ->
+    {
-    Option.value ~default:Store.S.(empty repo') repo >>= fun repo ->
+      path;
-    Lwt.return { path; tree = Store.S.Tree.singleton path str; repo }
+      tree = Store.S.Tree.singleton path str;
+      repo =
+        ( Store.S.Repo.v (Irmin_mem.config ()) >>= fun repo' ->
+          Option.value ~default:Store.S.(empty repo') repo );
+    }
 
   let insert_uchar t n uc : t Lwt.t =
     F.epr "TextBuffer.insert_uchar %d %a@." n pp_uchar uc;
@@ -361,7 +365,8 @@ end
 
 let pp_color : Gv.Color.t Fmt.t =
   F.(
-    record
+    hbox
+    @@ record
          [
            field "r" (fun (s : Gv.Color.t) -> s.r) float;
            field "g" (fun (s : Gv.Color.t) -> s.g) float;
@@ -386,6 +391,26 @@ module TextLayout = struct
     valign : align;
   }
 
+  type text_wrapping = {
+    max_width : float;
+    max_rows : int;
+    break_anywhere : bool;
+    overflow_character : string option;
+  }
+
+  type section = { byte_range : int * int; format : text_format }
+
+  type layout = {
+    text : TextBuffer.t;
+    sections : section list;
+    wrap : text_wrapping;
+    halign : align;
+    justify : bool;
+    line_height : float option;
+  }
+
+  type cursor = { index : int; last_col : int }
+
   let pp_text_format : text_format F.t =
     F.(
       record
@@ -394,7 +419,9 @@ module TextLayout = struct
           field "extra_letter_spacing"
             (fun s -> s.extra_letter_spacing)
             float;
-          field "line_height" (fun s -> s.line_height) (option float);
+          field "line_height"
+            (fun (s : text_format) -> s.line_height)
+            (option float);
           field "color" (fun s -> s.color) pp_color;
           field "background" (fun s -> s.background) pp_color;
         ])
@@ -415,13 +442,6 @@ module TextLayout = struct
   let text_format_simple font_id color : text_format =
     { text_format_default with font_id; color }
 
-  type text_wrapping = {
-    max_width : float;
-    max_rows : int;
-    break_anywhere : bool;
-    overflow_character : string option;
-  }
-
   let pp_text_wrapping =
     F.(
       record
@@ -443,42 +463,20 @@ module TextLayout = struct
       overflow_character = Some "…";
     }
 
-  type layout_section = {
+  let pp_section : Format.formatter -> 'a -> unit =
-    leading_space : float;
-    byte_range : int * int;
-    format : text_format;
-  }
-
-  let pp_layout_section : Format.formatter -> 'a -> unit =
     F.(
       record
         [
-          field "leading_space" (fun s -> s.leading_space) float;
           field "byte_range"
             (fun s -> s.byte_range)
             (pair ~sep:(any ",") int int);
           field "format" (fun s -> s.format) pp_text_format;
         ])
 
-  let layout_section_default =
+  let section_default =
-    {
+    { byte_range = (0, 0); format = text_format_default }
-      leading_space = 0.0;
-      byte_range = (0, 0);
-      format = text_format_default;
-    }
 
-  type layout_job = {
+  let pp_layout =
-    text : TextBuffer.t;
-    sections : layout_section array;
-    wrap : text_wrapping;
-    first_row_min_height : float;
-    break_on_newline : bool;
-    halign : align;
-    justify : bool;
-    line_height : float option;
-  }
-
-  let pp_layout_job =
     F.(
       record
         [
@@ -487,62 +485,22 @@ module TextLayout = struct
             string;
           field "sections"
             (fun s -> s.sections)
-            (brackets @@ array pp_layout_section);
+            (brackets @@ list pp_section);
           field "wrap" (fun s -> s.wrap) pp_text_wrapping;
-          field "first_row_min_height"
-            (fun s -> s.first_row_min_height)
-            float;
-          field "break_on_newline" (fun s -> s.break_on_newline) bool;
           field "halign" (fun s -> s.halign) Align.pp_t;
           field "justify" (fun s -> s.justify) bool;
         ])
 
-  let layout_job_of_text text =
+  let layout_default =
     {
-      text;
+      text = TextBuffer.of_string ~path:[] "";
-      sections = Array.make 0 layout_section_default;
+      sections = [ section_default ];
       wrap = default_text_wrapping ();
-      first_row_min_height = 0.0;
-      break_on_newline = true;
       halign = Min;
       justify = false;
       line_height = Some 18.;
     }
 
-  type uv_rect = {
-    offset : Gg.v2;
-    size : Gg.v2;
-    min : Gg.p2; (* Top left corner UV in texture *)
-    max : Gg.p2; (* Bottom right corner (exclusive) *)
-  }
-
-  type glyph = {
-    chr : string;
-    pos : Gg.p2;
-    ascent : float;
-    size : Gg.size2;
-    uv_rect : uv_rect;
-    section_index : int;
-  }
-
-  type row_visuals = {
-    (*     mesh : mesh; *)
-    mesh_bounds : Gg.box2;
-    glyph_vertex_range : int * int;
-  }
-
-  let pp_row_visuals =
-    F.(
-      record
-        [
-          field "mesh_bounds"
-            (fun (s : row_visuals) -> s.mesh_bounds)
-            Gg.Box2.pp;
-          field "glyph_vertex_range"
-            (fun (s : row_visuals) -> s.glyph_vertex_range)
-            (pair ~sep:(any ",") int int);
-        ])
-
   let pp_text_row : Format.formatter -> Gv.Text.text_row -> unit =
     F.(
       record
@@ -558,139 +516,24 @@ module TextLayout = struct
           field "maxx" (fun (s : Gv.Text.text_row) -> s.maxx) float;
         ])
 
-  type row = {
+  let cursor_default = { index = 0; last_col = 0 }
-    text_row : Gv.Text.text_row;
-    section_index_at_start : int;
-    glyphs : glyph list;
-    rect : Gg.box2;
-    visuals : row_visuals;
-    ends_with_newline : bool;
-  }
-
-  let pp_row : Format.formatter -> row -> unit =
-    F.(
-      record
-        [
-          field "text_row" (fun s -> s.text_row) pp_text_row;
-          field "section_index_at_start"
-            (fun (s : row) -> s.section_index_at_start)
-            int;
-          field "format" (fun (s : row) -> List.length s.glyphs) int;
-          field "rect" (fun (s : row) -> s.rect) Gg.Box2.pp;
-          field "visuals" (fun (s : row) -> s.visuals) pp_row_visuals;
-          field "ends_with_newline"
-            (fun (s : row) -> s.ends_with_newline)
-            bool;
-        ])
-
-  let row_default () =
-    {
-      text_row =
-        {
-          start_index = 0;
-          end_index = 0;
-          width = 0.;
-          minx = 0.;
-          maxx = 0.;
-          next = 0;
-        };
-      section_index_at_start = 0;
-      glyphs = [];
-      rect = Box2.zero;
-      visuals =
-        { mesh_bounds = Box2.zero; glyph_vertex_range = (0, 0) };
-      ends_with_newline = false;
-    }
-
-  type galley = {
-    job : layout_job;
-    rows : row array;
-    elided : bool;
-    rect : Gg.box2;
-    mesh_bounds : Gg.box2;
-    num_vertices : int;
-    num_indices : int;
-    pixels_per_point : float;
-  }
-
-  type rich_text = {
-    text : string;
-    size : float option;
-    extra_letter_spacing : float;
-    line_height : float option;
-    font : string option;
-    background_color : Gv.Color.t;
-    text_color : Gv.Color.t;
-    code : bool;
-    strong : bool;
-    weak : bool;
-    strikethrough : bool;
-    underline : bool;
-    italics : bool;
-    raised : bool;
-  }
-
-  let rich_text_default =
-    {
-      text = "";
-      size = None;
-      extra_letter_spacing = 0.0;
-      line_height = None;
-      font = None;
-      background_color = Gv.Color.transparent;
-      text_color = Gv.Color.rgbf ~r:0.9 ~g:0.9 ~b:0.9;
-      code = false;
-      strong = false;
-      weak = false;
-      strikethrough = false;
-      underline = false;
-      italics = false;
-      raised = false;
-    }
-
-  type widget_text =
-    | RichText of rich_text
-    | LayoutJob of layout_job
-    | Galley of galley
-
-  type cursor = {
-    index : int;
-    row : int option;
-    last_col : int;
-    prefer_next_row : bool;
-  }
-
-  let cursor_default =
-    { index = 0; row = None; last_col = 0; prefer_next_row = false }
 
   let cursor ?(row : int option) ?(last_col = 0) index : cursor =
     F.epr "cursor row=%a last_col=%d index=%d@."
       F.(option int)
       row last_col index;
-    { index; row; last_col; prefer_next_row = false }
+    { index; last_col }
 
   let simple text ?(format = text_format_default) wrap_width :
-      layout_job Lwt.t =
+      layout Lwt.t =
     TextBuffer.length text >>= fun textlen ->
     Lwt.return
       {
-        (layout_job_of_text text) with
+        layout_default with
-        sections =
+        text;
-          Array.make 1
+        sections = [ { byte_range = (0, textlen); format } ];
-            { leading_space = 0.0; byte_range = (0, textlen); format };
         wrap =
           { (default_text_wrapping ()) with max_width = wrap_width };
-        break_on_newline = true;
-      }
-
-  let singleline (text : TextBuffer.t) (format : text_format) :
-      layout_job Lwt.t =
-    simple text ~format Float.infinity >>= fun simple ->
-    Lwt.return
-      {
-        simple with
-        wrap = default_text_wrapping ();
-        break_on_newline = true;
       }
 
   let cursor_color = ref (Gv.Color.rgbf ~r:0.5 ~g:0.5 ~b:0.)
@@ -702,16 +545,12 @@ module TextLayout = struct
     { f with background = Gv.Color.rgbf ~r:0.3 ~g:0.3 ~b:0.3 }
 
   let with_range ((cs, ce) : int * int)
-      ?(cursor_format = default_cursor_formatter) layout_job :
+      ?(format = default_cursor_formatter) layout : layout =
-      layout_job =
-    (* this is more like a general range application to layout sections, but i don't need it yet *)
     {
-      layout_job with
+      layout with
       sections =
-        Array.of_list
+        List.fold_left
-          (* Lol maybe this is inefficient? (or maybe not) *)
+          (fun (l : section list) sec ->
-          (List.fold_left
-             (fun (l : layout_section list) sec ->
             let s, e = sec.byte_range in
 
             l
@@ -722,8 +561,7 @@ module TextLayout = struct
                else [])
             @ (if
                  cs > s
-                    && cs
+                 && cs <= e (* if cursor start is in this section *)
-                       <= e (* if cursor start is in this section *)
                then [ { sec with byte_range = (s, cs) } ]
                else [])
             @ (if
@@ -732,109 +570,30 @@ module TextLayout = struct
                then
                  [
                    {
-                        sec with
+                     format = format sec.format;
-                        format = cursor_format sec.format;
                      byte_range = (max cs s, min ce e);
                    };
                  ]
                else [])
             @
             if
-                 ce > s
+              ce > s && ce <= e (* if cursor end is in this section *)
-                 && ce <= e (* if cursor end is in this section *)
             then [ { sec with byte_range = (ce, e) } ]
             else [])
-             []
+          [] layout.sections;
-             (Array.to_list layout_job.sections));
     }
 
-  let with_cursor (cur : cursor)
+  let with_cursor (cur : cursor) ?(format = default_cursor_formatter)
-      ?(cursor_format = default_cursor_formatter) layout_job :
+      layout : layout =
-      layout_job =
+    let c = with_range (cur.index, cur.index + 1) ~format layout in
-    let c =
-      with_range (cur.index, cur.index + 1) ~cursor_format layout_job
-    in
     c
 
   let with_mark (mark : int option) (cur : int)
-      ?(cursor_format = default_mark_formatter) layout_job :
+      ?(format = default_mark_formatter) layout : layout =
-      layout_job =
     match mark with
     | Some mark' ->
-        with_range ~cursor_format
+        with_range ~format (min mark' cur, max mark' cur) layout
-          (min mark' cur, max mark' cur)
+    | None -> layout
-          layout_job
-    | None -> layout_job
-
-  let layout (gv : Gv.t) (fonts : Fonts.t) (job : layout_job)
-      (pos : v2) : galley Lwt.t =
-    (* F.epr "TextLayout.layout@.";
-       F.epr "job.wrap.max_width=%f@." job.wrap.max_widtha;
-       F.epr "job.wrap.max_rows=%d@." job.wrap.max_rows; *)
-    if job.wrap.max_rows == 0 then
-      Lwt.return
-        {
-          job;
-          rows = Array.make 1 (row_default ());
-          rect = Box2.move pos Box2.zero;
-          mesh_bounds = Box2.zero;
-          elided = true;
-          num_vertices = 0;
-          num_indices = 0;
-          pixels_per_point = fonts.pixels_per_point;
-        }
-    else
-      let metrics = Gv.Text.metrics gv in
-      let lines = Gv.Text.make_empty_rows job.wrap.max_rows in
-      TextBuffer.contents job.text >>= fun contents ->
-      let row_count =
-        Gv.Text.break_lines gv ~break_width:job.wrap.max_width
-          ~max_rows:job.wrap.max_rows ~lines contents
-      in
-      (* F.epr "row_count=%d@." row_count; *)
-      let height = ref (V2.y pos) in
-      let max_width = ref 0. in
-      let line_height =
-        Option.value ~default:metrics.line_height job.line_height
-      in
-      Lwt.return
-        {
-          job;
-          rows =
-            Array.init row_count (fun n ->
-                let text_row = Array.get lines n in
-                height := !height +. line_height;
-                let rect =
-                  Box2.v
-                    (P2.v (V2.x pos) !height)
-                    (P2.v
-                       (text_row.width +. V2.x pos)
-                       (!height +. line_height))
-                in
-                max_width := Float.max text_row.maxx !max_width;
-                {
-                  text_row;
-                  section_index_at_start = 0;
-                  glyphs = [ (* TODO *) ];
-                  rect;
-                  visuals =
-                    {
-                      mesh_bounds = rect;
-                      glyph_vertex_range =
-                        (text_row.start_index, text_row.end_index);
-                    };
-                  ends_with_newline = false (* TODO *);
-                });
-          rect =
-            Box2.v Size2.zero
-              (P2.v job.wrap.max_width
-                 (Float.of_int row_count *. line_height));
-          elided = row_count > job.wrap.max_rows (* TODO *);
-          mesh_bounds = Box2.v Size2.zero (P2.v !max_width !height);
-          num_indices = 0 (* TODO *);
-          num_vertices = 0 (* TODO *);
-          pixels_per_point = fonts.pixels_per_point;
-        }
 end
 
 let rec nth_tl n = function
@@ -907,7 +666,6 @@ module Ui = struct
 
   let id = ref 0
   let spacing ui = ui.style.spacing
-  let fonts ui (reader : Gv.t -> 'a) : 'a = reader ui
 
   let allocate_space (_gv : Gv.t) (size : Gg.box2) : id * Gg.box2 =
     id := !id + 1;
@@ -971,8 +729,8 @@ module TextEdit = struct
     id : id option;
     id_source : id option;
     text_format : TextLayout.text_format;
-    layouter :
+    formatter :
-      (Ui.t -> TextBuffer.t -> float -> TextLayout.galley) option;
+      (Ui.t -> TextBuffer.t -> float -> TextLayout.layout) option;
     password : bool;
     frame : bool;
     margin : margin;
@@ -1216,7 +974,7 @@ module TextEdit = struct
         id = None;
         id_source = None;
         text_format;
-        layouter = None;
+        formatter = None;
         password = false;
         frame = true;
         margin = Margin.symmetric 4.0 2.0;
@@ -1430,60 +1188,71 @@ module Painter = struct
     Text.set_size t ~size:font_size;
     Text.set_align t ~align:Align.(left lor top)
 
-  let paint_galley (t : Gv.t) (g : TextLayout.galley) : box2 Lwt.t =
+  let text_layout (t : Gv.t) (rect : box2) (g : TextLayout.layout) :
-    TextBuffer.contents g.job.text >>= fun contents ->
+      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
+    let lines = Gv.Text.make_empty_rows max_rows in
+    TextBuffer.contents g.text >>= fun contents ->
     let contents_len = String.length contents in
-    g.rows
+    let row_count =
-    |> ( Array.iter @@ fun (row : TextLayout.row) ->
+      Gv.Text.break_lines t ~break_width:(Box2.w rect) ~max_rows
+        ~lines contents
+    in
+    Seq.fold_left
+      (fun (cur : p2) (row : Gv.Text.text_row) ->
         let sections =
           List.filter
-             (fun (r : TextLayout.layout_section) ->
+            (fun (r : TextLayout.section) ->
-               fst r.byte_range <= row.text_row.end_index
+              fst r.byte_range <= row.end_index
-               && snd r.byte_range > row.text_row.start_index)
+              && snd r.byte_range > row.start_index)
-             Array.(
+            g.sections
-               to_list
-               @@ sub g.job.sections row.section_index_at_start
-               @@ (length g.job.sections - row.section_index_at_start))
         in
-         assert (List.length sections > 0);
-         let y = Box2.miny row.rect in
         List.fold_left
-           (fun x (sec : TextLayout.layout_section) ->
+          (fun (cur' : p2) (sec : TextLayout.section) ->
             let start, end_ =
-               Stdlib.
+              ( row.start_index
-                 ( row.text_row.start_index
                 |> max (fst sec.byte_range)
                 |> min contents_len,
-                   row.text_row.end_index |> min contents_len
+                row.end_index |> min contents_len
                 |> min (snd sec.byte_range) )
             in
-             let metrics = Gv.Text.metrics t in
             let bounds =
-               if start == row.text_row.end_index then
+              if start == row.end_index then
                 (* hack to display cursor at end of row *)
-                 Gv.Text.bounds t ~x ~y:0. " "
+                Gv.Text.bounds t ~x:(P2.x cur') ~y:0. " "
-               else Gv.Text.bounds t ~x ~y:0. ~start ~end_ contents
+              else
+                Gv.Text.bounds t ~x:(P2.x cur') ~y:0. ~start ~end_
+                  contents
             in
-
             let line_height =
-               Option.value ~default:metrics.line_height
+              Option.value ~default:(Gv.Text.metrics t).line_height
                 sec.format.line_height
             in
-
             draw_box t
               ~box:
-                 Box2.(v (V2.v x y) (V2.v bounds.advance line_height))
+                (Box2.v
+                   (V2.v (P2.x cur') (P2.y cur))
+                   (V2.v bounds.advance line_height))
               ~style:
                 Layout.Style.
                   { default with fill = sec.format.background };
-
             set_text_format t sec.format;
             Gv.set_fill_color t ~color:sec.format.color;
-             Gv.Text.text_w t ~x ~y ~start ~end_ contents)
+            V2.v
-           (Box2.minx row.rect) sections
+              (Gv.Text.text_w t ~x:(P2.x cur') ~y:(P2.y cur) ~start
-         |> ignore )
+                 ~end_ contents)
-    |> ignore;
+              Float.(max (P2.y cur +. line_height) (P2.y cur')))
-    Lwt.return g.rect
+          P2.(v (Box2.minx rect) (y cur))
+          sections
+        |> fun cur'' -> V2.(v (max (x cur) (x cur'')) (y cur'')))
+      (Box2.o rect)
+      (Seq.take row_count (Array.to_seq lines))
+    |> Box2.(of_pts (o rect))
+    |> Lwt.return
 
   let rec layout (box : box2) (ui : Ui.t) (frame : frame) : box2 Lwt.t
       =
@@ -1494,38 +1263,25 @@ module Painter = struct
           (fun (c : box2) f ->
             layout c ui f >>= fun r ->
             let c' =
-              let open Box2 in
+              Box2.(
                 match dir with
-              | `V -> Box2.of_pts (V2.v (minx c) (maxy r)) (max c)
+                | `V -> of_pts (V2.v (minx c) (maxy r)) (max c)
-              | `H -> Box2.of_pts (V2.v (maxx r) (miny c)) (max c)
+                | `H -> of_pts (V2.v (maxx r) (miny c)) (max c)
-              | `Z -> box
+                | `Z -> box)
             in
-
             Lwt.return c')
           box' ll
     | `TextEdit t ->
-        let font =
-          match Gv.Text.find_font ui.gv ~name:"mono" with
-          | Some gv -> Fonts.{ gv; pixels_per_point = 1.0 }
-          | None -> failwith "can't find font 'mono'"
-        in
-        (if t.multiline then
-           TextLayout.simple t.text ~format:t.text_format
-             (Option.value ~default:(Box2.w box') t.desired_width)
-         else TextLayout.singleline t.text t.text_format)
-        >>= fun layout_job ->
-        Ui.fonts ui.gv
         TextLayout.(
-            fun gv ->
+          simple t.text ~format:t.text_format
-              (layout gv font
+            (Option.value ~default:(Box2.w box') t.desired_width)
-                 (with_cursor t.cursor
+          >>= fun layout ->
-                    (with_mark t.mark t.cursor.index layout_job)))
+          with_cursor t.cursor layout
-                (Box2.o box'))
+          |> with_mark t.mark t.cursor.index
-        >>= fun galley -> paint_galley ui.gv galley
+          |> text_layout ui.gv box')
     | _ -> Lwt.return box)
     >>= fun r ->
-    F.epr "@[<v>layout@;box=%a@;box'=%a@;r=%a@;%a@]@." Box2.pp box
+    let r' = Margin.outer frame.style.margin r in
-      Box2.pp box' Box2.pp r pp_frame frame;
+    draw_box ui.gv ~box:r' ~style:frame.style;
-    draw_box ui.gv ~box:r ~style:frame.style;
+    Lwt.return r'
-    Lwt.return r
 end

oplevel.ml

@@ -69,13 +69,12 @@ let () =
 
   (* Thread which is woken up when the main window is closed. *)
   let _waiter, _wakener = Lwt.wait () in
-  F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
-  Toploop.initialize_toplevel_env ();
 
+  (* F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
+     Toploop.initialize_toplevel_env (); *)
   let rootrepo =
-    Lwt_main.run
+    Store.init_default
-      (Store.init_default
+      (F.str "%s/console/rootstore.git" Secrets.giturl)
-         (F.str "%s/console/rootstore.git" Secrets.giturl))
   in
 
   let ui =
@@ -86,10 +85,6 @@ let () =
     ~f:
       (Some
          (fun _window key _int state mods ->
-           (* F.epr
-              "GLFW.setKeyCallback ~f: _win key=%a int=%d state=%a \
-               mods=%a@."
-              pp_key key int pp_key_action state pp_mods mods; *)
            Lwt.async (fun () ->
                Ogui.Ui.keycallback ui state key mods >>= fun _ ->
                Lwt.return_unit)))
@@ -99,13 +94,6 @@ let () =
     ~f:
       (Some
          (fun _window ch ->
-           (* let uc = Uchar.of_int ch in
-
-              F.epr "GLFW.setCharCallback ~f: _win ch=%d(%a)@." ch
-                 F.(option string)
-                 (if Uchar.is_char uc then
-                    Some (String.make 1 @@ Uchar.to_char uc)
-                  else None); *)
            Lwt.async (fun () ->
                Ogui.Ui.chrcallback ui ch >>= fun _ -> Lwt.return_unit)))
   |> ignore;