basic

.ocamlformat

@@ -0,0 +1,3 @@
+profile = default
+version = 0.26.2
+parse-toplevel-phrases=false

dune

@@ -13,25 +13,32 @@
  (modules store)
 )
 
+
 (executables
  (names oplevel)
- (modules oplevel secrets perfgraph ogui)
+ (modules oplevel secrets perfgraph ogui glfw_types)
  (libraries
    lwt
    store
-   memtrace
+   ;;memtrace
+   glfw-ocaml
    tgls
    tgls.tgles2
    graphv_gles2_native
-   stb_image
-   glfw-ocaml
    gg
    irmin-git
    compiler-libs.toplevel
+   re
+   lwt_react
  )
- (link_flags (-linkall))
+
- (ocamlopt_flags (:standard -O3 -unboxed-types))
+ ;; none of this makes backtraces work
- (modes byte)
+ ;;(flags (-g))
+ ;;(link_flags (-linkall -g))
+ ;;(ocamlopt_flags (:standard -O3 -unboxed-types))
+ ;;(ocamlc_flags (:standard -verbose -g))
+
+ ;;(modes byte_complete) ;; this causes backtraces to not work, but somehow includes the implementation of Toploop
  (preprocess
   (pps ppx_irmin))
 )

dune-project

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

glfw_types.ml

@@ -0,0 +1,149 @@
+open GLFW
+module F = Fmt
+
+let pp_key : key F.t =
+ fun ppf k ->
+  F.pf ppf
+    GLFW.(
+      match k with
+      | Unknown -> "Unknown"
+      | Space -> "Space"
+      | Apostrophe -> "Apostrophe"
+      | Comma -> "Comma"
+      | Minus -> "Minus"
+      | Period -> "Period"
+      | Slash -> "Slash"
+      | Num0 -> "Num0"
+      | Num1 -> "Num1"
+      | Num2 -> "Num2"
+      | Num3 -> "Num3"
+      | Num4 -> "Num4"
+      | Num5 -> "Num5"
+      | Num6 -> "Num6"
+      | Num7 -> "Num7"
+      | Num8 -> "Num8"
+      | Num9 -> "Num9"
+      | Semicolon -> "Semicolon"
+      | Equal -> "Equal"
+      | A -> "A"
+      | B -> "B"
+      | C -> "C"
+      | D -> "D"
+      | E -> "E"
+      | F -> "F"
+      | G -> "G"
+      | H -> "H"
+      | I -> "I"
+      | J -> "J"
+      | K -> "K"
+      | L -> "L"
+      | M -> "M"
+      | N -> "N"
+      | O -> "O"
+      | P -> "P"
+      | Q -> "Q"
+      | R -> "R"
+      | S -> "S"
+      | T -> "T"
+      | U -> "U"
+      | V -> "V"
+      | W -> "W"
+      | X -> "X"
+      | Y -> "Y"
+      | Z -> "Z"
+      | LeftBracket -> "LeftBracket"
+      | Backslash -> "Backslash"
+      | RightBracket -> "RightBracket"
+      | GraveAccent -> "GraveAccent"
+      | World1 -> "World1"
+      | World2 -> "World2"
+      | Escape -> "Escape"
+      | Enter -> "Enter"
+      | Tab -> "Tab"
+      | Backspace -> "Backspace"
+      | Insert -> "Insert"
+      | Delete -> "Delete"
+      | Right -> "Right"
+      | Left -> "Left"
+      | Down -> "Down"
+      | Up -> "Up"
+      | PageUp -> "PageUp"
+      | PageDown -> "PageDown"
+      | Home -> "Home"
+      | End -> "End"
+      | CapsLock -> "CapsLock"
+      | ScrollLock -> "ScrollLock"
+      | NumLock -> "NumLock"
+      | PrintScreen -> "PrintScreen"
+      | Pause -> "Pause"
+      | F1 -> "F1"
+      | F2 -> "F2"
+      | F3 -> "F3"
+      | F4 -> "F4"
+      | F5 -> "F5"
+      | F6 -> "F6"
+      | F7 -> "F7"
+      | F8 -> "F8"
+      | F9 -> "F9"
+      | F10 -> "F10"
+      | F11 -> "F11"
+      | F12 -> "F12"
+      | F13 -> "F13"
+      | F14 -> "F14"
+      | F15 -> "F15"
+      | F16 -> "F16"
+      | F17 -> "F17"
+      | F18 -> "F18"
+      | F19 -> "F19"
+      | F20 -> "F20"
+      | F21 -> "F21"
+      | F22 -> "F22"
+      | F23 -> "F23"
+      | F24 -> "F24"
+      | F25 -> "F25"
+      | Kp0 -> "Kp0"
+      | Kp1 -> "Kp1"
+      | Kp2 -> "Kp2"
+      | Kp3 -> "Kp3"
+      | Kp4 -> "Kp4"
+      | Kp5 -> "Kp5"
+      | Kp6 -> "Kp6"
+      | Kp7 -> "Kp7"
+      | Kp8 -> "Kp8"
+      | Kp9 -> "Kp9"
+      | KpDecimal -> "KpDecimal"
+      | KpDivide -> "KpDivide"
+      | KpMultiply -> "KpMultiply"
+      | KpSubtract -> "KpSubtract"
+      | KpAdd -> "KpAdd"
+      | KpEnter -> "KpEnter"
+      | KpEqual -> "KpEqual"
+      | LeftShift -> "LeftShift"
+      | LeftControl -> "LeftControl"
+      | LeftAlt -> "LeftAlt"
+      | LeftSuper -> "LeftSuper"
+      | RightShift -> "RightShift"
+      | RightControl -> "RightControl"
+      | RightAlt -> "RightAlt"
+      | RightSuper -> "RightSuper"
+      | Menu -> "Menu")
+
+let pp_key_action : GLFW.key_action F.t =
+ fun ppf s ->
+  F.pf ppf
+    GLFW.(
+      match s with
+      | Release -> "Release"
+      | Press -> "Press"
+      | Repeat -> "Repeat")
+
+let pp_mods =
+  F.(
+    list (fun ppf s ->
+        pf ppf
+          GLFW.(
+            match s with
+            | Shift -> "Shift"
+            | Control -> "Control"
+            | Alt -> "Alt"
+            | Super -> "Super")))

opam_switch

@@ -0,0 +1,275 @@
+opam-version: "2.0"
+compiler: ["ocaml-variants.5.1.1+options"]
+roots: [
+  "camlp5.8.03.00"
+  "gg.1.0.0"
+  "glfw-ocaml.3.3.1-2"
+  "graphv_gles2_native.0.1.1"
+  "irmin-git.3.9.0"
+  "lablgtk3.3.1.4"
+  "lablgtk3-sourceview3.3.1.4"
+  "lwd.0.3"
+  "lwt_glib.1.1.1"
+  "memtrace.0.2.3"
+  "merlin.4.14-501"
+  "ocamlformat.0.26.2"
+  "odig.0.0.9"
+  "stb_image.0.5"
+  "tgls.0.8.6"
+  "tuareg.3.0.1"
+  "user-setup.0.7"
+  "utop.2.14.0"
+]
+installed: [
+  "angstrom.0.16.0"
+  "arp.3.1.1"
+  "asn1-combinators.0.2.6"
+  "astring.0.8.5"
+  "awa.0.3.0"
+  "awa-mirage.0.3.0"
+  "b0.0.0.5"
+  "base.v0.16.3"
+  "base-bigarray.base"
+  "base-bytes.base"
+  "base-domains.base"
+  "base-nnp.base"
+  "base-threads.base"
+  "base-unix.base"
+  "base64.3.5.1"
+  "bheap.2.0.0"
+  "bigarray-compat.1.1.0"
+  "bigstringaf.0.9.1"
+  "biniou.1.2.2"
+  "bos.0.2.1"
+  "ca-certs.0.2.3"
+  "ca-certs-nss.3.98"
+  "cairo2.0.6.4"
+  "camlp-streams.5.0.1"
+  "camlp5.8.03.00"
+  "camlp5-buildscripts.0.03"
+  "carton.0.7.1"
+  "carton-git.0.7.1"
+  "carton-lwt.0.7.1"
+  "cf.0.5.0"
+  "cf-lwt.0.5.0"
+  "checkseum.0.5.2"
+  "cmdliner.1.2.0"
+  "cohttp.5.3.1"
+  "cohttp-lwt.5.3.0"
+  "cohttp-lwt-unix.5.3.0"
+  "conduit.6.2.2"
+  "conduit-lwt.6.2.2"
+  "conduit-lwt-unix.6.2.2"
+  "conf-bash.1"
+  "conf-cairo.1"
+  "conf-emacs.1"
+  "conf-gles2.1"
+  "conf-glfw3.2"
+  "conf-glib-2.1"
+  "conf-gmp.4"
+  "conf-gmp-powm-sec.3"
+  "conf-gtk3.18"
+  "conf-gtksourceview3.0+2"
+  "conf-libffi.2.0.0"
+  "conf-m4.1"
+  "conf-perl.2"
+  "conf-pkg-config.3"
+  "conf-which.1"
+  "cppo.1.6.9"
+  "crunch.3.3.1"
+  "csexp.1.5.2"
+  "cstruct.6.2.0"
+  "cstruct-lwt.6.2.0"
+  "cstruct-unix.6.2.0"
+  "ctypes.0.20.2"
+  "ctypes-foreign.0.18.0"
+  "decompress.1.5.3"
+  "digestif.1.2.0"
+  "dispatch.0.5.0"
+  "dns.7.0.3"
+  "dns-client.7.0.3"
+  "dns-client-lwt.7.0.3"
+  "dns-client-mirage.7.0.3"
+  "domain-name.0.4.0"
+  "dot-merlin-reader.4.9"
+  "duff.0.5"
+  "dune.3.15.2"
+  "dune-build-info.3.15.2"
+  "dune-configurator.3.15.2"
+  "duration.0.2.1"
+  "easy-format.1.3.4"
+  "either.1.0.0"
+  "emile.1.1"
+  "encore.0.8"
+  "eqaf.0.9"
+  "ethernet.3.2.0"
+  "faraday.0.8.2"
+  "fix.20230505"
+  "fmt.0.9.0"
+  "fpath.0.7.3"
+  "fsevents.0.3.0"
+  "fsevents-lwt.0.3.0"
+  "functoria-runtime.4.4.2"
+  "gg.1.0.0"
+  "git.3.15.0"
+  "git-mirage.3.15.0"
+  "git-paf.3.15.0"
+  "git-unix.3.15.0"
+  "glfw-ocaml.3.3.1-2"
+  "gmap.0.3.0"
+  "graphql.0.14.0"
+  "graphql-cohttp.0.14.0"
+  "graphql-lwt.0.14.0"
+  "graphql_parser.0.14.0"
+  "graphv_core.0.1.1"
+  "graphv_core_lib.0.1.1"
+  "graphv_font.0.1.1"
+  "graphv_font_stb_truetype.0.1.1"
+  "graphv_gles2.0.1.1"
+  "graphv_gles2_native.0.1.1"
+  "graphv_gles2_native_impl.0.1.1"
+  "h2.0.11.0"
+  "happy-eyeballs.0.6.0"
+  "happy-eyeballs-lwt.0.6.0"
+  "happy-eyeballs-mirage.0.6.0"
+  "hashcons.1.4.0"
+  "hex.1.5.0"
+  "hkdf.1.0.4"
+  "hpack.0.11.0"
+  "httpaf.0.7.1"
+  "hxd.0.3.2"
+  "index.1.6.2"
+  "inotify.2.5"
+  "integers.0.7.0"
+  "ipaddr.5.5.0"
+  "ipaddr-cstruct.5.5.0"
+  "ipaddr-sexp.5.5.0"
+  "irmin.3.9.0"
+  "irmin-fs.3.9.0"
+  "irmin-git.3.9.0"
+  "irmin-graphql.3.9.0"
+  "irmin-pack.3.9.0"
+  "irmin-tezos.3.9.0"
+  "irmin-watcher.0.5.0"
+  "jsonm.1.0.2"
+  "ke.0.6"
+  "lablgtk3.3.1.4"
+  "lablgtk3-sourceview3.3.1.4"
+  "lambda-term.3.3.2"
+  "logs.0.7.0"
+  "lru.0.3.1"
+  "lwd.0.3"
+  "lwt.5.7.0"
+  "lwt-dllist.1.0.1"
+  "lwt_glib.1.1.1"
+  "lwt_react.1.2.0"
+  "macaddr.5.5.0"
+  "macaddr-cstruct.5.5.0"
+  "magic-mime.1.3.1"
+  "memtrace.0.2.3"
+  "menhir.20231231"
+  "menhirCST.20231231"
+  "menhirLib.20231231"
+  "menhirSdk.20231231"
+  "merlin.4.14-501"
+  "merlin-lib.4.14-501"
+  "metrics.0.4.1"
+  "metrics-lwt.0.4.1"
+  "mew.0.1.0"
+  "mew_vi.0.5.0"
+  "mimic.0.0.6"
+  "mimic-happy-eyeballs.0.0.6"
+  "mirage-clock.4.2.0"
+  "mirage-clock-unix.4.2.0"
+  "mirage-crypto.0.11.3"
+  "mirage-crypto-ec.0.11.3"
+  "mirage-crypto-pk.0.11.3"
+  "mirage-crypto-rng.0.11.3"
+  "mirage-crypto-rng-lwt.0.11.3"
+  "mirage-device.2.0.0"
+  "mirage-flow.3.0.0"
+  "mirage-kv.6.1.1"
+  "mirage-net.4.0.0"
+  "mirage-no-solo5.1"
+  "mirage-random.3.0.0"
+  "mirage-runtime.4.5.1"
+  "mirage-time.3.0.0"
+  "mirage-unix.5.0.1"
+  "mtime.2.0.0"
+  "not-ocamlfind.0.13"
+  "num.1.5"
+  "ocaml.5.1.1"
+  "ocaml-compiler-libs.v0.12.4"
+  "ocaml-config.3"
+  "ocaml-syntax-shims.1.0.0"
+  "ocaml-variants.5.1.1+options"
+  "ocaml-version.3.6.7"
+  "ocamlbuild.0.14.3"
+  "ocamlfind.1.9.6"
+  "ocamlformat.0.26.2"
+  "ocamlformat-lib.0.26.2"
+  "ocamlgraph.2.1.0"
+  "ocp-indent.1.8.1"
+  "ocplib-endian.1.2"
+  "odig.0.0.9"
+  "odoc.2.4.2"
+  "odoc-parser.2.4.2"
+  "optint.0.3.0"
+  "paf.0.5.0"
+  "parsexp.v0.16.0"
+  "pbkdf.1.2.0"
+  "pecu.0.7"
+  "ppx_derivers.1.2.1"
+  "ppx_deriving.5.2.1"
+  "ppx_enumerate.v0.16.0"
+  "ppx_irmin.3.9.0"
+  "ppx_repr.0.7.0"
+  "ppx_sexp_conv.v0.16.0"
+  "ppxlib.0.32.1"
+  "progress.0.4.0"
+  "psq.0.2.1"
+  "ptime.1.1.0"
+  "randomconv.0.1.3"
+  "re.1.11.0"
+  "react.1.2.2"
+  "repr.0.7.0"
+  "result.1.5"
+  "rresult.0.7.0"
+  "rusage.1.0.0"
+  "semaphore-compat.1.0.1"
+  "seq.base"
+  "sexplib.v0.16.0"
+  "sexplib0.v0.16.0"
+  "stb_image.0.5"
+  "stb_truetype.0.7"
+  "stdio.v0.16.0"
+  "stdlib-shims.0.3.0"
+  "stringext.1.6.0"
+  "tcpip.8.0.0"
+  "terminal.0.4.0"
+  "tezos-base58.1.0.0"
+  "tgls.0.8.6"
+  "tls.0.17.3"
+  "tls-lwt.0.17.3"
+  "tls-mirage.0.17.3"
+  "topkg.1.0.7"
+  "trie.1.0.0"
+  "tuareg.3.0.1"
+  "tyxml.4.6.0"
+  "uchar.0.0.2"
+  "uri.4.4.0"
+  "uri-sexp.4.4.0"
+  "user-setup.0.7"
+  "utop.2.14.0"
+  "uucp.15.1.0"
+  "uuseg.15.1.0"
+  "uutf.1.0.3"
+  "vector.1.0.0"
+  "webmachine.0.7.0"
+  "x509.0.16.5"
+  "xdg.3.15.2"
+  "yaml.3.2.0"
+  "yojson.2.1.2"
+  "zarith.1.13"
+  "zed.3.2.3"
+]

oplevel.ml

@@ -2,6 +2,7 @@ open Lwt.Infix
 module F = Fmt
 open Tgles2
 module Gv = Graphv_gles2_native
+open Ogui
 
 module GLFWExtras = struct
   open Ctypes
@@ -17,7 +18,7 @@ end
 let errorcb error desc =
   Printf.printf "GLFW error %d: %s\n%!" error desc
 
-let load_data vg =
+let load_fonts vg =
   let _ = Gv.Text.create vg ~name:"mono" ~file:"./assets/mono.ttf" in
   let _ =
     Gv.Text.create vg ~name:"icons" ~file:"./assets/entypo.ttf"
@@ -37,7 +38,7 @@ let load_data vg =
   Gv.Text.add_fallback vg ~name:"sans-bold" ~fallback:"emoji";
   Gv.Text.set_font_face vg ~name:"mono"
 
-let () =
+let main =
   GLFW.init ();
   at_exit GLFW.terminate;
   let _res = GLFWExtras.glfwSetErrorCallback errorcb in
@@ -52,51 +53,160 @@ let () =
   GLFW.makeContextCurrent ~window:(Some window);
   GLFW.swapInterval ~interval:0;
 
-  Gl.clear_color 0.3 0.3 0.32 1.;
+  Gl.clear_color 0.1 0.2 0.2 1.;
-
-  Memtrace.trace_if_requested ();
 
+  (*Memtrace.trace_if_requested (); *)
   let ctx =
     Gv.create ~flags:Gv.CreateFlags.(antialias lor stencil_strokes) ()
   in
 
   let graph = Perfgraph.init Perfgraph.FPS "Frame Time" in
-  let _odata = load_data ctx in
-  let continue = ref true in
   let min_fps = ref Float.max_float in
   let max_fps = ref Float.min_float in
-  let blowup = ref false in
 
-  (* Thread which is woken up when the main window is closed. *)
+  let rootrepo =
-  let _waiter, _wakener = Lwt.wait () in
-
-  Lwt_main.run
-    ((fun () ->
     Store.init_default
       (F.str "%s/console/rootstore.git" Secrets.giturl)
-       >>= fun t ->
+  in
-       Store.S.tree t >>= fun rootstore ->
+
-       (try Store.S.Tree.get rootstore [ ".config"; "init.ml" ] with
+  let ui =
-       | Not_found | Invalid_argument _ ->
+    Ogui.Ui.window ctx ~window Gg.(Box2.v P2.o (P2.v 500. 500.))
-           Lwt.return
+  in
-             "print_newline \"rootstore://.config/init.ml not \
+
-              found\";;"
+  load_fonts ui.gv;
-       | exc ->
+
-           Lwt.return
+  (* Format.safe_set_geometry ~max_indent:(500 - 1) ~margin:500; *)
-             (F.str ".config/init.ml load exception: %s"
+  let event_stream, event_push = Lwt_stream.create () in
-                (Printexc.to_string exc)))
+  Ogui.Ui.process_events ui event_stream;
-       >>= fun text ->
   GLFW.setKeyCallback ~window
     ~f:
       (Some
-              (fun _ key _ state _ ->
+         (fun _window key _int state mods ->
-                match (key, state) with
+           (* ignore key releases and capslock *)
-                | GLFW.Space, GLFW.Release -> blowup := not !blowup
+           match (state, key, mods) with
-                | _ -> ()))
+           | Release, _, _ | _, CapsLock, _ -> ()
+           | _ -> event_push (Some (`Key (state, key, mods)))
+           (*Lwt.async (fun () ->
+               Ogui.Ui.keycallback ui state key mods >>= fun _ ->
+               Lwt.return_unit) *)))
   |> ignore;
 
+  GLFW.setCharCallback ~window
+    ~f:
+      (Some
+         (fun _window ch ->
+           event_push (Some (`Char ch))
+           (* Lwt.async (fun () -> Ogui.Ui.chrcallback ui ch) *)))
+  |> 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@.";
+  let initial_path = [ ".config"; "init.ml" ] in
+  TextBuffer.of_repo ~initial_path ~repo:rootrepo >>= fun tb_init ->
+  TextBuffer.of_string ~repo:rootrepo
+    ~path:
+      (List.fold_right
+         (fun a (acc : string list) ->
+           match acc with
+           | [] -> [ F.str "%s.output" a ]
+           | a' -> a :: a')
+         [] initial_path)
+    (F.str "(* --- output:%s --- *)\n\n"
+       (String.concat "/" initial_path))
+  |> Lwt.return
+  >>= fun to_init ->
+  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
+
+  (*F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
+    Toploop.initialize_toplevel_env ();
+    Clflags.debug := true;
+    ignore
+      (Toploop.use_input out_ppf
+         (String "#use \"topfind\";;\n#list;;#require \"lwt\";;")); *)
+  (* toplevel execution binding *)
+  Ui.(
+    append_bindings ui
+      (Lwd.return
+         Event.
+           [
+             pack Fun.id
+               (empty
+               |> adds
+                    [
+                      [
+                        Key (Press, X, [ Control ]);
+                        Key (Press, E, [ Control ]);
+                      ];
+                    ]
+                    [
+                      Custom
+                        ( "toplevel_execute",
+                          fun () ->
+                            TextBuffer.peek tb_init >>= fun _str ->
+                            (*Toploop.use_input out_ppf (String str)
+                              |> F.epr "Toploop.use_input=%b@."; *)
+                            Lwt.return_unit );
+                    ]);
+           ]));
+
+  WindowManager.make ui
+    (Lwd.var
+       (`T
+         ( `Y,
+           WindowManager.
+             [
+               {
+                 t = `TextEdit (TextEdit.multiline ui to_init);
+                 dim = `Ratio 0.333;
+                 bindings = [];
+               };
+               {
+                 t = `TextEdit (TextEdit.multiline ui tb_init);
+                 dim = `Ratio 0.5;
+                 bindings = [];
+               };
+               {
+                 t = `TextEdit (TextEdit.multiline ui to_init);
+                 dim = `Ratio 1.0;
+                 bindings = [];
+               };
+             ] )))
+  >>= fun page ->
+  let page_root = Lwd.observe page in
+
+  let bindings = ui.bindings |> Lwd.observe |> Lwd.quick_sample in
+  F.epr "Bindings:@.";
+  List.iter (fun bs -> F.epr "%a" Ui.pp_pack bs) bindings;
+
+  F.pr "oplevel.ml: entering drawing loop@.";
+  let period_min = 1.0 /. 30. in
   let t = GLFW.getTime () |> ref in
-       while (not GLFW.(windowShouldClose ~window)) && !continue do
+
+  let rec draw_loop () =
     let now = GLFW.getTime () in
     let dt = now -. !t in
     t := now;
@@ -108,71 +218,47 @@ let () =
       min_fps := Float.min avg !min_fps;
       max_fps := Float.max avg !max_fps);
 
-         let _mx, _my = GLFW.getCursorPos ~window in
     let win_w, win_h = GLFW.getWindowSize ~window in
-
     Gl.viewport 0 0 win_w win_h;
     Gl.clear
       (Gl.color_buffer_bit lor Gl.depth_buffer_bit
      lor Gl.stencil_buffer_bit);
-
     Gl.enable Gl.blend;
     Gl.blend_func Gl.src_alpha Gl.one_minus_src_alpha;
     Gl.enable Gl.cull_face_enum;
     Gl.disable Gl.depth_test;
-
+    let page = Lwd.quick_sample page_root in
-         let win_w, win_h = (float win_w, float win_h) in
+    let win_w, win_h = GLFW.getWindowSize ~window in
-         Gv.begin_frame ctx ~width:win_w ~height:win_h
+    let width, height = (float win_w, float win_h) in
-           ~device_ratio:1.;
+    let box = Gg.(Box2.v V2.zero Size2.(v width (height -. 20.))) in
-
+    Gv.begin_frame ctx ~width ~height ~device_ratio:1.;
-         Perfgraph.render graph ctx (win_w -. 205.) 5.;
+    Perfgraph.render graph ctx (width -. 205.) 5.;
-
+    (*F.epr "Painter.layout=%a@." Gg.Box2.pp box; *)
-         let ui =
+    Painter.layout box ui page >>= fun _ ->
-           Ogui.Ui.window ctx Gg.(Box2.v P2.o (P2.v 500. 500.))
-         in
-         ignore Ogui.TextEdit.(show (multiline (String text)) ui);
     (* Demo.render_demo ctx mx my win_w win_h now !blowup data; *)
     Gv.end_frame ctx;
-
     Gc.major_slice 0 |> ignore;
-
     GLFW.swapBuffers ~window;
-         GLFW.pollEvents ()
+    GLFW.pollEvents ();
-         (*continue := false;*)
+    Lwt_unix.sleep
-       done;
+      Float.(max 0. (period_min -. GLFW.getTime () +. !t))
-
+    >>= fun () ->
+    if not GLFW.(windowShouldClose ~window) then draw_loop ()
+    else Lwt.return_unit
+  in
+  (try draw_loop ()
+   with e ->
+     F.epr "draw_loop Exception: %s@.Backtrace:@.%s@."
+       (Printexc.to_string e)
+       (Printexc.get_backtrace ())
+     |> Lwt.return)
+  >>= fun () ->
   Printf.printf "MIN %.2f\n" !min_fps;
   Printf.printf "MAX %.2f\n%!" !max_fps;
+  Lwt.return_unit
 
-       if Array.length Sys.argv = 1 then
+let () =
-         while not GLFW.(windowShouldClose ~window) do
+  try Lwt_main.run main
-           GLFW.pollEvents ();
+  with e ->
-           Unix.sleepf 0.25
+    F.epr "Exception: %s@.Backtrace:@.%s@." (Printexc.to_string e)
-         done;
+      (Printexc.get_backtrace ())
-       F.pr "oplevel.ml: Toploop.initialize_toplevel_env@.";
-       Toploop.initialize_toplevel_env ();
-
-       (* 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;;")); *)
-       (* ignore (Toploop.use_input Format.std_formatter (String text)); *)
-       (* Wait for it to be closed. *)
-       Lwt.return ())
-       ())

store.ml

@@ -19,6 +19,11 @@ let test_populate () : t Lwt.t =
 
 let init_default upstream_url : Sync.db Lwt.t =
   S.Repo.v (Irmin_git.Conf.init "../rootstore") >>= fun repo ->
-  S.of_branch repo "lablgtk" >>= fun t ->
+  S.of_branch repo "ogui" >>= fun t ->
   S.remote upstream_url >>= fun upstream ->
-  Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return t
+  (* (try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit
+      with Invalid_argument a ->
+        F.epr "Sync.pull_exn raised Invalid_argument(%s)" a;
+        Lwt.return_unit)
+     >>= fun () -> *)
+  Lwt.return t