now to fix the toplevel library loading...

dune

@@ -13,6 +13,7 @@
  (modules store)
 )
 
+
 (executables
  (names oplevel)
  (modules oplevel secrets perfgraph ogui glfw_types)
@@ -31,9 +32,9 @@
    lwd
  )
  (link_flags (-linkall))
-  (ocamlopt_flags (:standard -O3 -unboxed-types))
+ (ocamlopt_flags (:standard -O3 -unboxed-types))
-  (ocamlc_flags (:standard -verbose))
+ (ocamlc_flags (:standard -verbose))
- (modes byte)
+ (modes byte_complete)
  (preprocess
   (pps ppx_irmin))
 )

dune-project

@@ -1,2 +1,2 @@
-(lang dune 3.4)
+(lang dune 3.6)
 (name oplevel)

ogui.ml

@@ -107,7 +107,7 @@ module TextBuffer = struct
     Lwt.return
       { path = Lwd.var initial_path; tree = Lwd.var tree; repo }
 
-  let of_string ~path ?(repo = None) str =
+  let of_string ~path ?(repo : Store.Sync.db Lwt.t option) str =
     {
       path = Lwd.var path;
       tree = Lwd.var @@ Store.S.Tree.singleton path str;
@@ -141,6 +141,21 @@ module TextBuffer = struct
     Lwd.set tree t;
     Lwt.return_unit
 
+  let insert { path; tree; _ } n str =
+    Store.S.Tree.update (Lwd.peek tree) (Lwd.peek path) (function
+      | Some src ->
+          let srcn = String.length src in
+          assert (n <= srcn);
+          Some
+            String.(
+              cat (cat (sub src 0 n) str) (sub src n (srcn - n)))
+      | None ->
+          F.epr "TextBuffer.insert Tree.update -> Nonep@.";
+          Some str)
+    >>= fun t ->
+    Lwd.set tree t;
+    Lwt.return_unit
+
   let remove { path; tree; _ } (a, b) : unit Lwt.t =
     let a, b = (min a b, max a b) in
     (* F.epr "TextBuffer.remove (%d, %d)@." a b; *)
@@ -200,6 +215,9 @@ module TextBuffer = struct
         Store.S.Tree.get tree path)
     |> lwt_lwd
 
+  let peek { tree; path; _ } =
+    Store.S.Tree.get (Lwd.peek tree) (Lwd.peek path)
+
   let length { path; tree; _ } =
     Store.S.Tree.get (Lwd.peek tree) (Lwd.peek path) >>= fun text ->
     Lwt.return (String.length text)
@@ -634,9 +652,9 @@ module Ui = struct
             ]
     in
 
-    (*Event.(
+    Event.(
       F.epr "Ui.keycallback %a %a %a@." pp_key key pp_key_action state
-        pp_mods mods); *)
+        pp_mods mods);
     match Event.resolve (Key (state, key, mods)) res with
     | Event.Accepted actions ->
         callback_resolver := None;
@@ -658,7 +676,7 @@ module Ui = struct
 
   let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref =
     ref (fun _c ->
-        (* F.epr "chrcallback: '%a'@." pp_uchar _c; *)
+        F.epr "chrcallback: '%a'@." pp_uchar _c;
         Lwt.return_unit)
 
   let chrcallback _t (chr : int) : unit Lwt.t =
@@ -1019,7 +1037,6 @@ module TextEdit = struct
 end
 
 module Layout = struct
-  open Gg
   module Style = Ui.Style
 
   type frame = { t : t; mutable size : size; style : Style.t }
@@ -1031,27 +1048,29 @@ module Layout = struct
     | `TextEdit of TextEdit.t * TextLayout.layout
     | `None ]
 
-  and size = [ `Fixed of size2 | `Max | `Min ]
+  and dim = [ `Ratio of float | `Pixels of float ]
+  and size = dim * dim
 
-  let frame ?(size = `Max) ?(style = Style.default) t : frame =
+  let ratio x y = (`Ratio x, `Ratio y)
+  let pixels x y = (`Pixels (Int.of_float x), `Pixels (Int.of_float y))
+
+  let frame ?(size = ratio 1. 1.) ?(style = Style.default) t : frame =
     { t; size; style }
 
   let none = frame `None
   let join d ?style a b = frame ?style (`Join (d, (a, b)))
 
-  let box d ?style =
-    List.fold_left (fun acc a -> join d ?style a acc) none
-
   (*  let hbox, vbox, zbox = (box `X, box `Y, box `Z) *)
-  let pack_x ?style () = (none, join `X ?style)
+  let pack ?style d = (none, join d ?style)
-  let pack_y ?style () = (none, join `Y ?style)
+  let pack_x ?style () = pack `X ?style
-  let pack_z ?style () = (none, join `Z ?style)
+  let pack_y ?style () = pack `Y ?style
-  let hcat ?style = Lwd_utils.reduce (pack_x ?style ())
+  let pack_z ?style () = pack `Z ?style
+  let cat ?style d = Lwd_utils.reduce (pack ?style d)
+  let hcat ?style = cat ?style `X
   let vcat ?style = Lwd_utils.reduce (pack_y ?style ())
   let zcat ?style = Lwd_utils.reduce (pack_z ?style ())
-  let hbox ?style = Lwd_utils.pack (pack_x ?style ())
+  let box ?style d = Lwd_utils.pack (pack ?style d)
-  let vbox ?style = Lwd_utils.pack (pack_y ?style ())
+  let hbox, vbox, zbox = (box `X, box `Y, box `Z)
-  let zbox ?style = Lwd_utils.pack (pack_z ?style ())
 
   let textedit_style =
     Style.
@@ -1073,6 +1092,59 @@ module Layout = struct
     |> Lwd.map ~f:(fun tl -> frame ?size ~style (`TextEdit (t, tl)))
     |> Lwt.return
 
+  let tiling ui ?(style = textedit_style) d (telist : TextEdit.t list)
+      =
+    let cursor = Lwd.var 0 in
+    let len = List.length telist in
+    Ui.update_bindings ui (fun a ->
+        a
+        |> Event.adds
+             [
+               (*[ Key (Press, X, [Control])];
+                 [ Key (Release, X, [Control])];*)
+               [ Key (Press, O, [ Control ]) ];
+             ]
+             [
+               Ui.Custom
+                 (fun () ->
+                   Lwd.set cursor
+                     (if Lwd.peek cursor < len - 1 then
+                        Lwd.peek cursor + 1
+                      else 0);
+                   TextEdit.default_bindings
+                     (List.nth telist (Lwd.peek cursor))
+                     ui;
+                   Lwt.return_unit);
+             ]);
+    let teln = List.length telist in
+    let ratio n = `Ratio (1. /. float (teln - (n + 1))) in
+    Lwt_list.mapi_s
+      (fun n te ->
+        textedit
+          ~size:
+            (match d with
+            | `X -> (`Ratio 0.5, `Ratio 1.)
+            | `Y -> (`Ratio 1., `Ratio 0.5)
+            | `Z -> (`Ratio 1., `Ratio 1.))
+          te
+        >>= fun tl ->
+        Lwd.map2 tl (Lwd.get cursor) ~f:(fun tl cursor ->
+            {
+              tl with
+              style =
+                {
+                  tl.style with
+                  stroke =
+                    ( fst style.stroke,
+                      if n == cursor then
+                        Gv.Color.(transf (snd style.stroke) 0.5)
+                      else snd style.stroke );
+                };
+            })
+        |> Lwt.return)
+      telist
+    >>= fun framelist -> box ~style d framelist |> Lwt.return
+
   let pp_dir ppf (t : [ `X | `Y | `Z ]) =
     F.pf ppf "%s"
       (match t with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
@@ -1086,10 +1158,13 @@ module Layout = struct
       | `String s -> F.str "`String %s" s
       | `None -> "`None")
 
-  let pp_size ppf = function
+  let pp_size ppf (x, y) =
-    | `Fixed p -> F.pf ppf "`Fixed %a" Gg.V2.pp p
+    (match x with
-    | `Max -> F.pf ppf "`Max"
+    | `Pixels p -> F.pf ppf "`Pixels %f.2, " p
-    | `Min -> F.pf ppf "`Min"
+    | `Ratio p -> F.pf ppf "`Ratio %f.2, " p);
+    match y with
+    | `Pixels p -> F.pf ppf "`Pixels %f.2" p
+    | `Ratio p -> F.pf ppf "`Ratio %f.2" p
 
   let pp_frame =
     F.(
@@ -1206,8 +1281,18 @@ module Painter = struct
     |> Box2.(of_pts (o rect))
     |> Lwt.return
 
-  let rec layout (box : box2) (ui : Ui.t) ({ t; style; _ } : frame) :
+  let rec layout (box : box2) (ui : Ui.t)
-      box2 Lwt.t =
+      ({ t; style; size = sx, sy } : frame) : box2 Lwt.t =
+    let box =
+      Box2.v (Box2.o box)
+        (V2.v
+           (match sx with
+           | `Ratio r -> Box2.w box *. r
+           | `Pixels p -> p)
+           (match sy with
+           | `Ratio r -> Box2.h box *. r
+           | `Pixels p -> p))
+    in
     let box' = Margin.inner style.margin box in
     (match t with
     | `Join (dir, (a, b)) ->
@@ -1217,8 +1302,8 @@ module Painter = struct
             let c' =
               Box2.(
                 match dir with
-                | `X -> of_pts (V2.v (minx c) (maxy r)) (max c)
+                | `X -> of_pts (V2.v (maxx r) (miny c)) (max c)
-                | `Y -> of_pts (V2.v (maxx r) (miny c)) (max c)
+                | `Y -> of_pts (V2.v (minx c) (maxy r)) (max c)
                 | `Z -> box)
             in
             Lwt.return c')

oplevel.ml

@@ -70,6 +70,7 @@ let main =
 
   F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
   Toploop.initialize_toplevel_env ();
+
   let rootrepo =
     Store.init_default
       (F.str "%s/console/rootstore.git" Secrets.giturl)
@@ -98,24 +99,80 @@ let main =
                Ogui.Ui.chrcallback ui ch >>= fun _ -> Lwt.return_unit)))
   |> ignore;
 
+  GLFW.setWindowSizeCallback ~window
+    ~f:
+      (Some
+         Gg.(
+           fun _window x y ->
+             Lwd.set ui.rect
+               (Box2.v V2.zero (V2.v (float x) (float y)))))
+  |> ignore;
+
   F.pr "oplevel.ml: building initial page@.";
-  TextBuffer.of_repo
+  let initial_path = [ ".config"; "init.ml" ] in
-    ~initial_path:[ ".config"; "init.ml" ]
+  TextBuffer.of_repo ~initial_path ~repo:rootrepo >>= fun tb_init ->
-    ~repo:rootrepo
+  TextBuffer.of_string ~repo:rootrepo
-  >>= fun tb_init ->
+    ~path:
-  Layout.textedit (TextEdit.multiline ui tb_init) >>= fun te_init ->
+      (List.fold_right
-  let page =
+         (fun a (acc : string list) ->
-    Layout.(
+           match acc with
-      vbox
+           | [] -> [ F.str "%s.output" a ]
-        ~style:
+           | a' -> a :: a')
-          Style.{ default with margin = Margin.symmetric 10.0 10.0 }
+         [] initial_path)
-        [
+    (F.str "(* --- output:%s --- *)\n\n"
-          te_init;
+       (String.concat "/" initial_path))
-          (*textedit
+  |> Lwt.return
-            (TextEdit.multiline ui
+  >>= fun to_init ->
-               (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo)); *)
+  let out_ppf =
-        ])
+    let insert s =
+      Lwt.async (fun () ->
+          TextBuffer.length to_init >>= fun len ->
+          (* TKTK if buffer is modified here during yield from >>= it could be weird *)
+          TextBuffer.insert to_init len s)
+    in
+    Format.formatter_of_out_functions
+      Format.
+        {
+          out_string = (fun s _ _ -> insert s);
+          out_flush = (fun () -> ());
+          out_indent = (fun n -> insert (String.make (n * 2) ' '));
+          out_newline = (fun () -> insert "\n");
+          out_spaces = (fun n -> insert (String.make n ' '));
+        }
   in
+
+  ignore
+    (Toploop.use_input out_ppf (String "#use \"topfind\";;\n#list;;"));
+  (* toplevel execution binding *)
+  Ui.(
+    update_bindings ui
+      Event.(
+        fun a ->
+          a
+          |> adds
+               [
+                 [
+                   Key (Press, X, [ Control ]);
+                   Key (Release, X, [ Control ]);
+                   Key (Press, E, [ Control ]);
+                 ];
+               ]
+               [
+                 Custom
+                   (fun () ->
+                     F.epr "Ctrl-X Ctrl-E@.";
+                     TextBuffer.peek tb_init >>= fun str ->
+                     Toploop.use_input out_ppf (String str)
+                     |> F.epr "Toploop.use_input=%b@.";
+                     Lwt.return_unit);
+               ]));
+
+  Layout.(
+    tiling ui `Y
+      ~style:
+        Style.{ default with margin = Margin.symmetric 10.0 10.0 }
+      [ TextEdit.multiline ui tb_init; TextEdit.multiline ui to_init ])
+  >>= fun page ->
   let page_root = Lwd.observe page in
 
   let open GLFW in
@@ -178,25 +235,5 @@ let main =
   Printf.printf "MIN %.2f\n" !min_fps;
   Printf.printf "MAX %.2f\n%!" !max_fps;
   Lwt.return_unit
-(* let out_ppf =
-     Format.formatter_of_out_functions
-       Format.
-         {
-           out_string = (fun s _ _ -> output_buffer#insert s);
-           out_flush = (fun () -> ());
-           out_indent =
-             (fun n ->
-               for _ = 0 to n do
-                 output_buffer#insert "  "
-               done);
-           out_newline = (fun () -> output_buffer#insert "\n");
-           out_spaces =
-             (fun n -> output_buffer#insert (String.make n ' '));
-         }
-   in *)
-
-(* ignore
-   (Toploop.use_input out_ppf
-      (String "#use \"topfind\";;\n#list;;")); *)
 
 let () = Lwt_main.run main