made a weird deck a long time ago about this kinda stuff

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))
 

cors_proxy.sh

@@ -4,4 +4,4 @@ if [ ! -f /tmp/key.pem ]; then
   openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout /tmp/key.pem -out /tmp/cert.pem -batch
 fi
 
-npx http-server --cors -S -P https://github.com --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem
+npx http-server --cors -S -P https://gitea.departmentofinter.net --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem

doc/console.drawio

@@ -0,0 +1 @@
+<mxfile host="Electron" modified="2023-03-13T23:21:20.375Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="Z2Mfk2ZBbl7WkBZ1-Pcz" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vttc9o4EP41zPQ6k4xlY2M+BpJcP+RuOpOZa/PpRtgyqJUtzogA/fUn2TK2LBFIwC9tmkyItdabtc8+u1qLgTONt3+mcLn4i4aIDGwr3A6c24FtD32bfwrBLhfYo3EumKc4zEWgFDziH0gKLSld4xCtlIqMUsLwUhUGNElQwBQZTFO6UatFlKijLuEcaYLHABJd+gWHbJFLfdcq5Z8Qni+KkYEl78SwqCwFqwUM6aYicu4GzjSllOVX8XaKiFi7Yl3ydvcH7u4nlqKEndIA3aL7+bd/bD8ef/nu3D7cpA/0SvbyDMlaPjBBjAtSFIjVgoEoJPwvu2nhSClaQhsLJATgmn8gskKiGaGwaPfxuuznQ3IF/pCLwXbFCjO05fOfLFhMuADwyxVL6Xc0pYSmXJLQhNecRJiQmggSPE94MeArgLh88oxShrnubuSNGIehGGayWWCGHpcwEGNuOFC5LKXrJERicfjTTAicIfKZrjDD1NjnQ63Cvu8FTfEPmjBYTD/ihXsYYyIgP6XrFPOObOtvxJU/kevNO0Xbg4oEe3hws0I0Rizd8So71TQ2JR7dAnWLChYdKYPSBOb7nkqU8AsJlFeAxvY01AxsjwgtrpYwUdTr/bcWAM8W5WojZ3cjwEHTWCzZpKzDr+byPynaGDurXnHLz0FRFTrAGjljpHctkMj1xQeWY/AFyIcphrYuMHrozTzX00fnuLnB2WAwFhBMZqvlftDfoiZEZiXvxTlejbAzahZ6vjXzdc1e7UcvYCRJ8MAEahy42uCYwOQQVVW48UVyETelCwWgQpAERWJY/kQELld4lg1rnclGW5VlJDl5OjkNgYGcwLAxdhqb2KkGjV76oLr6znckL9D3QYV6nqpQTZ9GdTamTV2ZUqVV/anreJYJVVQsmBwiPwo0PPA7XuCjWdSkIuyho2jCcTRV2G26fV9bdhTyWFkWacoWdE4TSO5KaQ3gZZ0HSpdSHd8QYzsJe7hmVFUW2mL2VTS/dmXpqXLndit7zgq7opDwx/1aLTxlPYzcoly2y0pFw9cgI4oiOzAiQ3r/Ahlikd6CC77SfAYBeqmipDoG0zl6sUcz0FJEIMPP6vRMuJFNP9Msetkzha/g060BL5++bFPD3n4Sb4ej1wkcD0DL/tWg5baErLMYydWcg6WBojHXELni1+gash/ZXUWe/zTpMoBfcxl6NOYYXIbdmPfu1GcU10+K/zD7jFfF1fUgwUV+ODQhwbdnToaEkjeu3SpzgCO00bidn+pBnGZcyNBWAVvvIZ9XYz5E3yqIDFe+Z5ulhxMZqwwMIo0BwHI7MCUx8rzYRbrK02r1LUuKYTI/uLM4ldRqW8RjSO8wHHYsFSquHg57Bm7zmuI2YNiadEB2DRNX4wQEiqz+MQYadxlpAD1RLjLe7znWsG01/B/p9thqrAEcTUWM/ivTcO8hXwAclSAB0DUyalUjejTe0+ivlW3dydhoMmPwU5Ctvq/L3yC2ZcUzEIaRZdKUfK/UpBW7NVr1NSMeum0a8bBLI75E2u88G345gupDqubkLGDuD36xNKAh5dNTJ/MqnL0ZzP3DJ/BOxafbCD7B+EBc1FKSAejHJa7eSURqj45tEVp9gwW6SUc2E1z23zGB0amGfwBGLYWbI80+QXv22cet/Ug9AjDq+i2C+7O4+IbePPc/i1fkPvu9sSxmWbH0jy1m8fp0mARYoGNfPO6TL76sgb5l99pD/336xvJc/20O3F0VsvU3OU1vLLtJfLxXD1Jsyo6fOLE7dSF6aNjTWOQi6Ybje5QeIunks0vnIslMW3b9PYzVbr7B0aOc3wegX3PQoHaIqrET0LxYfv0r1375HTrn7n8=</diagram></mxfile>

doc/deck_example.ml

@@ -0,0 +1,17 @@
+let rec copy_blocks buffer r w =
+  match%lwt Lwt_io.read_into r buffer 0 (Bytes.length buffer) with
+  | 0 -> Lwt.return_unit
+  | bytes_read ->
+    let%lwt () = Lwt_io.write_from_exactly w buffer 0 bytes_read in
+    copy_blocks buffer r w
+
+let run () =
+  ((let%lwt server =
+      Lwt_io.establish_server (Lwt_unix.ADDR_INET (Unix.inet_addr_any, 8765))
+        (fun (r, w) ->
+           let buffer = Bytes.create (16 * 1024) in
+           copy_blocks buffer r w)
+    in
+    Lwt.return server) : Lwt_io.server Lwt.t) |> ignore
+
+let () =  Lwt_main.run   run ();

doc/factorial.drawio

@@ -0,0 +1 @@
+<mxfile host="Electron" modified="2023-03-14T02:21:12.395Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="kySTQQLOUsgllAWFhiTX" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vtbb6M4FP41kdKRWmEIhDy2Tbv70F2NNNLO9GnlgEk8dXCWOE06v35tMOFik9AkXGY6rVrhg318Od+5+BgPrPvl7o8IrhZ/UR+RgWn4u4E1HZimMwH8vyC8JQRrMkkI8wj7CQlkhC/4B5JEQ1I32EfrQkVGKWF4VSR6NAyRxwo0GEV0W6wWUFLsdQXnSCF88SBRqV+xzxYJ1bWNjP4nwvNF2jMw5JslTCtLwnoBfbrNkayHgXUfUcqSp+XuHhGxdum6JO0eK97uBxahkNVpgKbocf79H9NdTr6+WNOn2+iJXksur5Bs5IQJYpwQIU+sFvQYjTAUbEL+F9dwCO/ubhbxp7l4Sik+fhWzZG9y6Zz/NlS+z54KLdYrGGqbzKD3Mo/oJvSvPUpoNLBuxURCzMRYKljC5Yo/hLP1Ki4bOMiPWojFYAskCOCG/0NkjWIw/RsQCpms++mmNO1heA2u0gHzxU3GXJwHJ8eTT6lmYVImQztBX7AlH/sUiImziL6g+2Rq05CGvOZdgAkpkSDB85AXCQoEh1cUMcyheSvJjIqpbheYoS8r6InutlwJOS1eOyQEz2d/R+AMkc90zZePinYeRwyKcgyfShWW2PfF6O8WfBl+0JDBdOQBLzzCJSZCne/pJsKckWn8jbb7mQumaFcJUrCHPjcZiC4Ri954lbSBVJZtpmv2SNIWOT1LaVCq93zPKdMA/iCV4B0KYTqKRhyFq1iU660cnUBqSKNlNVBJ2uaouhgS/YXXFjDG1gSprHOw3eMy6Sbt2rhA774zc2xH7Z3j5hbHnZUV8TepAZJS1kv8oN2SKNCKGTquMXM1+I0BLk1mRacl+7fe4iWBsUHT2aqcXTxoXcRLGR8AoBpHPgsCV2s8i7s1LmuOZPCiM08joDFPoDn7NNHZpxIYLu6AFI+RuqC9pzjuhcryO9+VHDDglRJ1nIJEHUWeWnE2Jk1VmFKkefkV1/EsHcqJWNhyiNzAU/DA3ziei2ZBk4IwR1ZBEpaliMLUiMJqShSusuzI5zsBWaQRW9A5DSF5yKglgGd1nqiIzGJxfEeMvUnYww2jRWGhHWbfRPMbW5aec2+mO8k5LrylhZBP91u+8BxzGNtpOWsXl9KG70FGEASmp0WG9P8pMsQinYILvtJ8BB46VFGaOgajOTrIUQ+0CBHI8GtxeDrcyKafaRy/7C2FW8CnXQJeMnzZpoS9/SBOh6PTCRwroGX+atCyW0LWWRbJVpyDoYCiMdcQ2OJX6xriH8kuR09+mnQZwC25DDUaszQuw2zMe3fqM9Ln54L/0PuMdwXW5SDBRq4/0iHBNWdWjITMbtzYecsBjpiNxvW8rgexmnEhI7MI2DKHZFyN+RB1qyByYln+riqVsY7BIPZ5AKx2A10aI8mkXYRVkogrb1kiDMN55c6irlEr7RGPIb3DcNgyilCx1XDY0dg2pynbBjRbkw6MXcOGq3EDBNIzi2MWaNJlpAHUYwCRI//IsYZpFsP/saqPrcYawFJElB1dfIR8ASgZSABUiYxblYgajfc0+mtlW1cbG01mDH4KY6vu63InN22p8gz4fmDoxCWPl5pU5bJtdVVNNtvU5FGXmnyJ3N95inw4jOpDvqZ2KjBxCr9YLlCT9+mpp3kXzk4Gc//wCZy6+LQbwSdwKoKjljINQP1q4vpjhKWT8bFtQqunWKCblGQzAWb//RIY19X7ChS1FHKOFfUE7alnL7f3xc8Axl2fJNg/i4dv6PS5/5m8NP/Z781lOsqcpn9qMZPXpw9KgAE69sWTPvniyyroKZvXHvrv+vvKc/23Pm63i5Atn+Y0va/sJu/xUT1Iuic7/tWJ2akLUUPDnsYiF8k2HN+j9BBJtb9fOhdJerNlls9ijHbTDZYa5fz+CPo9Hxu4xe/aO/4K2lLPNqtuoQ2TC13JdTB2tS+kd7ji1pobauULFcP4dtgwdz0s5lWnaZkkL5UNwc3JLORdtOEwfxvtZG4nk+LLb+12OVTu2l01O4B67K8aMB8f7xJfKarN3+kzdPblhJ0YL2Y3aBP3kl1Dth7+Bw==</diagram></mxfile>

dune

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

human.ml

@@ -1,4 +1,10 @@
 (*
+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:
    
@@ -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,15 @@ module Logs_browser = struct
     in
     (Format.formatter_of_buffer b, flush)
 
+  let hook =
+    ref (fun level s ->
+        ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
+
   let console_report _src level ~over k msgf =
     let k _ =
-      console level (flush ());
+      let s = flush () in
+      console level s;
+      !hook level s;
       over ();
       k ()
     in
@@ -76,10 +90,11 @@ 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")
 
+module Log = Logs
 module Cohttp_backend = Cohttp_lwt_jsoo
 
 module Git_af = struct
@@ -272,7 +287,10 @@ module Git_console_http = struct
       match git_scheme with
       | `Git | `SSH | `Scheme _ -> Lwt.return_none
       | `HTTP | `HTTPS ->
-          let headers = git_http_headers in
+          let headers =
+            ("content-type", "application/x-git-upload-pack-request")
+            :: git_http_headers
+          in
           let handshake ~uri0 ~uri1 = function
             | T.T flow -> (
                 Firebug.console##log
@@ -421,6 +439,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 +456,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 "current" >>= 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/console/rootstore.git"
     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 +1005,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 +1747,100 @@ 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.
+    *)
+
+    (* we need to determine how "document types" should be implemented:
+       * as a module that implements a common interface which allows
+       production of a Ui.t which is then rendered.
+         * this will require exposing the Ui and all drawing related functions.
+         *
+    *)
+
+    module View = struct
+      type path = Nav.path
+
+      type t = {
+        tree : Nav.tree;
+        view : path list Lwd.var;
+        cursor : Nav.path Lwd.var;
+        doc : node Lwd.t;
+      }
 
       open Lwt.Infix
 
-    let render_lwt (vg : NVG.t) (p : P2.t) (_ev : Event.t) :
+      let pack_x = Lwd_utils.lift_monoid (empty_node (), join_x)
-        unit Lwt.t =
+      let pack_y = Lwd_utils.lift_monoid (empty_node (), join_y)
-      !storetree >>= fun tree ->
+      let pack_z = Lwd_utils.lift_monoid (empty_node (), join_z)
-      Nav.S.Tree.list tree !storecursor >>= fun l ->
-      let contents =
-        String.concat "\n" (List.map (fun (step, _t') -> step) l)
-      in
 
-      Draw.node { vg; style = Style.dark } p (Text.lines contents)
+      module DText = struct
-      |> ignore;
+        let lines = Lwd.map ~f:Text.lines
-      Lwt.return_unit
+        let of_string = Lwd.map ~f:Text.of_string
+      end
+
+      let of_path path =
+        Lwd.map2 ~f:join_x
+          (DText.of_string (Lwd.pure "/"))
+          (Lwd_utils.map_reduce
+             (fun step ->
+               Lwd_utils.pack
+                 (empty_node (), join_x)
+                 [
+                   DText.of_string (Lwd.pure "/");
+                   DText.of_string (Lwd.pure step);
+                 ])
+             pack_x path)
+
+      let of_tree ?(path = []) tree =
+        Nav.S.Tree.list tree path >>= fun l ->
+        Lwt.return
+          {
+            tree;
+            view = Lwd.var [ path ];
+            cursor = Lwd.var path;
+            doc =
+              Lwd_utils.map_reduce
+                (fun (step, _t') -> DText.of_string (Lwd.pure step))
+                pack_y l;
+          }
+
+      let list_logs hook =
+        let var = Lwd.var (empty_node ()) in
+        (hook :=
+           fun level s ->
+             Lwd.set var
+               (join_y
+                  (Text.of_string
+                     (Logs.level_to_string (Some level) ^ ": " ^ s))
+                  (Lwd.peek var)));
+        Lwd.get var
+
+      let draw (vg, p) (t : node Lwd.t) : p Lwt.t =
+        let root =
+          Lwd.observe
+            ~on_invalidate:(fun _ ->
+              Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
+            t
+        in
+        Lwt.return (Draw.node vg p (Lwd.quick_sample root))
+    end
+
+    open Lwt.Infix
+
+    let render_lwt (vg : NVG.t) (p : p) (_ev : Event.t) : p Lwt.t =
+      let t = { vg; style = Style.dark } in
+      Nav.test_pull () >>= fun tree ->
+      View.of_tree tree >>= fun doc ->
+      View.draw (t, p)
+        (Lwd_utils.reduce View.pack_y
+           [
+             doc.doc;
+             View.of_path (Lwd.peek doc.cursor);
+             View.list_logs Logs_reporter.hook;
+           ])
   end
 end
 

index.html

@@ -1,4 +1,4 @@
-<!DOCTYPE>
+<!DOCTYPE html>
 <html>
   <head>
     <style>

notes.org

@@ -0,0 +1,26 @@
+* mvp todo
+
+
+** toplevel repl in js_of_ocaml
+** git pull from gitea.departmentofinter.net/console/boot
+** git push to gitea.departmentofinter.net/console/boot
+** execute a git file execution in top level
+** display arbitrary git file from pulled repo
+** edit arbitrary file with common emacs bindings
+*** move left and right by character
+*** move up and down by line
+
+
+
+
+
+
+* other todo
+*** yank (to clipboard) next char
+*** move left and right by word and sentance
+*** region select
+
+
+* principles?
+an "anywhere" programming environment
+