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)

glfw_types.ml

@@ -1,7 +1,7 @@
 open GLFW
 module F = Fmt
 
-let pp_key : GLFW.key F.t =
+let pp_key : key F.t =
  fun ppf k ->
   F.pf ppf
     GLFW.(

oplevel.ml

@@ -53,7 +53,7 @@ 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 ();
 
@@ -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
-         (F.str "%s/console/rootstore.git" Secrets.giturl))
+    Store.init_default
+      (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;
@@ -115,17 +103,19 @@ let () =
     Layout.(
       vbox
         [
-          frame
-            (`TextEdit
+          textedit
+            (TextEdit.multiline ui
+               (TextBuffer.of_repo ~path:[ "README" ] ~repo:rootrepo));
+          textedit
             (TextEdit.multiline ui
                (TextBuffer.of_repo
-                    ~path:[ "README" ] (*[ ".config"; "init.ml" ] *)
-                    ~repo:rootrepo)));
+                  ~path:[ ".config"; "init.ml" ]
+                  ~repo:rootrepo));
         ])
   in
 
   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
     Lwt_main.run
@@ -166,6 +156,8 @@ let () =
          Gc.major_slice 0 |> ignore;
          GLFW.swapBuffers ~window;
          GLFW.pollEvents ();
+         Unix.sleepf
+           Float.(max 0. (period_min -. GLFW.getTime () +. !t));
          Lwt.return_unit)
          ())
   done;

store.ml

@@ -21,4 +21,8 @@ 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.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