little re-arranging

boot_js.ml

@@ -3,10 +3,12 @@ open Lwt.Infix
 module NVG = Graphv_webgl
 
 let _ =
-  Logs.set_reporter (Human.Logs_browser.console_reporter ());
+  Logs.set_reporter (Human.Logs_reporter.console_reporter ());
   Logs.set_level (Some Debug);
   Logs.debug (fun m -> m "hello")
 
+module Log = (val Logs.src_log Logs.default : Logs.LOG)
+
 (* This scales the canvas to match the DPI of the window,
    it prevents blurriness when rendering to the canvas *)
 let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
@@ -95,7 +97,9 @@ let _ =
           Human.Panel.Ui.(
             render_lwt vg Gg.P2.o
               (Human.Event_js.evt_of_jskey `Press ev))
-          >>= fun () ->
+          >>= fun p ->
+          Logs.debug (fun m ->
+              m "Drawing finished at point: %a" Gg.V2.pp p);
           NVG.end_frame vg;
           Lwt.return_unit))
 

dune

@@ -16,16 +16,16 @@
    graphv_webgl
    js_of_ocaml-lwt
    digestif.ocaml
+   checkseum.ocaml
    irmin.mem
    git 
    irmin-git
-   httpaf
-   cohttp
    cohttp-lwt-jsoo
    mimic
    uri
    zed
    gg
+   wall
 
 ))
 

human.ml

@@ -1,5 +1,11 @@
 (*
+names?:
+   - universal tool, unitool [was thinking about how this is trying to unify a lot of my "tools for thought"]
+     * because it has always bothered me that it's easier to use google search as a calculator than the purpose built app!!!!!!!!
+   - universal console, unicon (UNICOrN) [unicon is nice ;3]
 
+   
+  
 describe exactly every case you can think of that you want this drawing and layout system to handle:
    
 * draw text on variously coloured backgrounds that can be defined locally or globally
@@ -32,13 +38,11 @@ open Js_of_ocaml
 module F = Fmt
 module NVG = Graphv_webgl
 
-module Logs_browser = struct
+module Logs_reporter = struct
   (* Console reporter *)
 
   open Jsoo_runtime
 
-  let console_obj = Js.pure_js_expr "console"
-
   let console : Logs.level -> string -> unit =
    fun level s ->
     let meth =
@@ -49,7 +53,11 @@ module Logs_browser = struct
       | Logs.Debug -> "debug"
       | Logs.App -> "log"
     in
-    ignore (Js.meth_call console_obj meth [| Js.string s |])
+    ignore
+      (Js.meth_call
+         (Js.pure_js_expr "console")
+         meth
+         [| Js.string s |])
 
   let ppf, flush =
     let b = Buffer.create 255 in
@@ -60,9 +68,13 @@ module Logs_browser = struct
     in
     (Format.formatter_of_buffer b, flush)
 
+  let log_buf = Buffer.create 4096
+
   let console_report _src level ~over k msgf =
     let k _ =
-      console level (flush ());
+      let s = flush () in
+      console level s;
+      Buffer.add_string log_buf s;
       over ();
       k ()
     in
@@ -76,7 +88,7 @@ module Logs_browser = struct
 end
 
 let _ =
-  Logs.set_reporter (Logs_browser.console_reporter ());
+  Logs.set_reporter (Logs_reporter.console_reporter ());
   Logs.set_level (Some Debug);
   Logs.debug (fun m -> m "hello")
 
@@ -421,6 +433,9 @@ module Nav = struct
   module Sync = Irmin.Sync.Make (S)
 
   type t = S.tree
+  type tree = t
+  type step = S.step
+  type path = step list
 
   let init () = S.Repo.v (Irmin_mem.config ()) >>= S.main >>= S.tree
 
@@ -435,14 +450,13 @@ module Nav = struct
     Firebug.console##log (Js.string "Nav.test_pull()\n");
     S.Repo.v (Config.init "") >>= fun repo ->
     Firebug.console##log (Js.string "Nav.test_pull(2)\n");
-    S.of_branch repo "main" >>= fun t ->
+    S.of_branch repo "master" >>= fun t ->
     Firebug.console##log (Js.string "Nav.test_pull(3)\n");
     Git_console_http.connect Mimic.empty >>= fun ctx ->
     Firebug.console##log (Js.string "Nav.test_pull(4)\n");
     let upstream =
-      S.remote ~ctx "https://localhost:8080/mirage/irmin.git"
+      S.remote ~ctx "https://localhost:8080/ryugyong/pocketbrain"
     in
-
     Firebug.console##log (Js.string "Nav.test_pull(5)\n");
     Sync.fetch_exn t upstream >>= fun _ -> S.tree t
   (* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)
@@ -985,13 +999,14 @@ module Panel = struct
       | `Handler of handler
       | `Draw of draw ]
 
+    and p = P2.t
     and dir = [ `X | `Y | `Z ]
     and image = NVG.Image.image
     and boundary = [ `Char | `Word | `Phrase | `Line | `Page | `Text ]
     and style = Style.t
     and handler = node -> Event.t -> Event.t option
     and draw_context = { vg : NVG.t; style : Style.t }
-    and draw = draw_context -> P2.t -> P2.t
+    and draw = draw_context -> p -> p
 
     let node_count = ref 0
 
@@ -1726,22 +1741,40 @@ module Panel = struct
           F.epr "Unhandled event: %s@." (Event.to_string _e));
       Draw.node { vg; style = Style.dark } p t
 
-    let storetree = ref (Nav.test_pull ())
+    (* I feel like the Wall module from github.com/let-def/wall includes another layer on top
-    let storecursor = ref []
+       of the drawing functions, missing from graphv, that
+       specificall allows the composability and cache-ability i want, so instead of writing in from
+       scratch i will try to steal it.
+    *)
+
+    module View = struct
+      open Lwt.Infix
+
+      let tree = ref (Nav.test_pull ())
+      let cursor = ref []
+
+      let contents tree =
+        Nav.S.Tree.list tree !cursor >>= fun l ->
+        Lwt.return
+          (String.concat "\n" (List.map (fun (step, _t') -> step) l))
+
+      type t = { tree : Nav.tree; mutable cursor : Nav.step }
+
+      let draw (vg, p) tree : p Lwt.t =
+        contents tree >>= fun contents ->
+        Lwt.return (Draw.node vg p (textedit (Text.lines contents)))
+    end
 
     open Lwt.Infix
 
-    let render_lwt (vg : NVG.t) (p : P2.t) (_ev : Event.t) :
+    let render_lwt (vg : NVG.t) (p : p) (_ev : Event.t) : p Lwt.t =
-        unit Lwt.t =
+      let t = { vg; style = Style.dark } in
-      !storetree >>= fun tree ->
+      !View.tree >>= fun tree ->
-      Nav.S.Tree.list tree !storecursor >>= fun l ->
+      View.draw (t, p) tree >>= fun p ->
-      let contents =
+      let module Buffer = Stdlib.Buffer in
-        String.concat "\n" (List.map (fun (step, _t') -> step) l)
+      Lwt.return
-      in
+        (Draw.node t p
-
+           (Text.lines (Buffer.contents Logs_reporter.log_buf)))
-      Draw.node { vg; style = Style.dark } p (Text.lines contents)
-      |> ignore;
-      Lwt.return_unit
   end
 end