urgh... stuck with how to implement cursor/focus etc. Decided to try to integrate Nottui and Nottui_widgets directly istead of reinventing another wheel.

boot_js.ml

@@ -27,12 +27,8 @@ let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
   canvas##.style##.width := width;
   canvas##.style##.height := height
 
-let _ =
+let webgl_initialize canvas =
-  let canvas =
-    Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
-  in
   scale_canvas canvas;
-  let webgl_ctx =
   (* Graphv requires a stencil buffer to work properly *)
   let attrs = WebGL.defaultContextAttributes in
   attrs##.stencil := Js._true;
@@ -43,7 +39,8 @@ let _ =
       print_endline "Sorry your browser does not support WebGL";
       raise Exit
   | Some ctx -> ctx
-  in
+
+let graphv_initialize webgl_ctx =
   let open NVG in
   let vg =
     create
@@ -53,55 +50,55 @@ let _ =
   (* File in this case is actually the CSS font name *)
   Text.create vg ~name:"sans" ~file:"sans" |> ignore;
   webgl_ctx##clearColor 0.3 0.3 0.32 1.;
+  vg
 
-  (*
+let request_animation_frame () =
-    let render ev =
+  let t, s = Lwt.wait () in
-    webgl_ctx##clear
+  let (_ : Dom_html.animation_frame_request_id) =
-      (webgl_ctx##._COLOR_BUFFER_BIT_
-      lor webgl_ctx##._DEPTH_BUFFER_BIT_
-      lor webgl_ctx##._STENCIL_BUFFER_BIT_);
-    let device_ratio = Dom_html.window##.devicePixelRatio in
-    begin_frame vg ~width:canvas##.width ~height:canvas##.height
-      ~device_ratio;
-    Transform.scale vg ~x:device_ratio ~y:device_ratio;
-    ignore Human.Panel.Ui.(panel vg Gg.P2.o test ev);
-    (*
-    Path.begin_ vg ;
-    Path.rect vg ~x:40. ~y:40. ~w:320. ~h:320. ;
-    set_fill_color vg ~color:Color.(rgba ~r:154 ~g:203 ~b:255 ~a:200) ;
-    fill vg ;
-    Transform.translate vg ~x:200. ~y:200. ;
-    Transform.rotate vg ~angle:(time *. 0.0005) ;
-    Text.set_font_face vg ~name:"sans" ;
-    Text.set_size vg ~size:48. ;
-    Text.set_align vg ~align:Align.(center lor middle) ;
-    set_fill_color vg ~color:Color.white ;
-    Text.text vg ~x:0. ~y:0. "Hello World!" ; *)
-    NVG.end_frame vg
-  in
     Dom_html.window##requestAnimationFrame
-    (Js.wrap_callback (fun _ -> render Human.Event.empty))
+      (Js.wrap_callback (fun (time : float) -> Lwt.wakeup s time))
-  |> ignore;*)
+  in
-  let open Js_of_ocaml_lwt.Lwt_js_events in
+  t
-  async (fun () ->
+
-      buffered_loop (make_event Dom_html.Event.keydown)
+let request_render canvas webgl_ctx vg
-        Dom_html.document (fun ev _ ->
+    (render : NVG.t -> ?time:float -> Gg.p2 -> Gg.p2 Lwt.t) =
+  request_animation_frame () >>= fun time ->
   webgl_ctx##clear
     (webgl_ctx##._COLOR_BUFFER_BIT_
     lor webgl_ctx##._DEPTH_BUFFER_BIT_
     lor webgl_ctx##._STENCIL_BUFFER_BIT_);
   let device_ratio = Dom_html.window##.devicePixelRatio in
-          begin_frame vg ~width:canvas##.width ~height:canvas##.height
+  NVG.begin_frame vg ~width:canvas##.width ~height:canvas##.height
     ~device_ratio;
-          Transform.scale vg ~x:device_ratio ~y:device_ratio;
+  NVG.Transform.scale vg ~x:device_ratio ~y:device_ratio;
-          Human.Panel.Ui.(
+  render vg ~time Gg.P2.o >>= fun _p ->
-            render_lwt vg Gg.P2.o
+  (*  Logs.debug (fun m -> m "Drawing finished at point: %a" Gg.V2.pp p); *)
-              (Human.Event_js.evt_of_jskey `Press ev))
-          >>= fun p ->
-          Logs.debug (fun m ->
-              m "Drawing finished at point: %a" Gg.V2.pp p);
   NVG.end_frame vg;
-          Lwt.return_unit))
+  Lwt.return_unit
+
+let _ =
+  let canvas =
+    Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
+  in
+  let webgl_ctx = webgl_initialize canvas in
+  let vg = graphv_initialize webgl_ctx in
+  let open Js_of_ocaml_lwt.Lwt_js_events in
+  let page_var = Lwd.var Human.Panel.Ui.empty in
+
+  async (fun () ->
+      Human.Panel.Ui.boot_page >>= fun page ->
+      Lwd.set page_var page;
+      let render = Human.Panel.Ui.renderer page_var in
+      request_render canvas webgl_ctx vg render >>= fun () ->
+      buffered_loop
+        (make_event Dom_html.Event.keydown)
+        Dom_html.document
+        Human.(
+          fun ev _ ->
+            Lwd.set page_var
+              (Panel.Ui.handle_event (Lwd.peek page_var)
+                 (Event_js.evt_of_jskey `Press ev));
+            request_render canvas webgl_ctx vg render))
 
 (* Dom_html.document##.onkeydown
    := Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) ->

human.ml

@@ -1,10 +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]
-
+   - non-magical systems (NMS) un-magical
-   
+   - console is an interface to allow you to program your computer more easily.
   
 describe exactly every case you can think of that you want this drawing and layout system to handle:
    
@@ -984,7 +985,7 @@ module Panel = struct
 
     open Gg
 
-    type draw_context = { vg : NVG.t; style : Style.t }
+    type draw_context = { vg : NVG.t; style : Style.t; time : float }
     and draw = draw_context -> Gg.p2 -> Gg.p2
 
     module Page = struct
@@ -994,7 +995,6 @@ module Panel = struct
 
       and step = [ `Next | `Left | `Right ]
       and path = step list
-      and cursor = { path : path; root : t }
 
       and atom =
         [ (*`Lwd of t
@@ -1019,13 +1019,15 @@ module Panel = struct
         [ `Char | `Word | `Phrase | `Line | `Page | `Text ]
 
       and style = Style.t
-      and handler = t -> Event.t -> Event.t option
+      and handler = t -> Event.t -> t
 
       let sub_left = function
         | `Atom _ as n -> n
         | `Attr (_, n) -> n
         | `Join (_, a, _) -> a
 
+      let sub = sub_left
+
       let sub_right = function
         | `Atom _ as n -> n
         | `Attr (_, n) -> n
@@ -1178,12 +1180,10 @@ module Panel = struct
           encode `End;
           let text = Bytes.to_string (Buffer.to_bytes b) in
           let open NVG in
-          let bounds = Text.bounds vg ~x:(V2.x t) ~y:(V2.y t) text in
           let metrics = Text.metrics vg in
           let x, y = (V2.x t, V2.y t +. metrics.ascender) in
-          Text.text vg ~x ~y text;
+          let twidth = Text.text_w vg ~x ~y text in
-          P2.v
+          P2.v twidth
-            (P2.x t +. bounds.advance)
             (P2.y t +. metrics.ascender +. metrics.descender
            +. metrics.line_height)
 
@@ -1245,10 +1245,10 @@ module Panel = struct
             | `Attr a -> attr vg b a
             | `Join a -> join vg b a
           in
-          ignore
+          (* ignore
              (path_box vg.vg
                 (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
-               (Box2.of_pts b b'));
+                (Box2.of_pts b b')); *)
           b'
       end
 
@@ -1292,7 +1292,6 @@ module Panel = struct
              | `Style _ -> "`Style"
              | `Pad _ -> "`Pad"
              | `Shift _ -> "`Shift"
-             | `Cursor -> "`Cursor"
              | `Handler _ -> "`Handler"
              | `Draw _ -> "`Draw"))
             ppf ()
@@ -1351,9 +1350,14 @@ module Panel = struct
 
     type node = Page.t
     type t = node Lwd.t
+    type path = Page.path Lwd.t
+    type cursor = { path : Page.path Lwd.var; root : node Lwd.var }
 
     let empty = Lwd.pure Page.empty
     let pad v = Lwd.map ~f:(Page.pad v)
+    let attr a n = Lwd.map ~f:(Page.attr a) n
+    let handler f (n : t) : t = attr (`Handler f) n
+    let atom a = Lwd.map ~f:Page.atom a
     let join d = Lwd.map2 ~f:(Page.join d)
     let join_x, join_y, join_z = (join `X, join `Y, join `Z)
     let ( ^^ ) = join_x
@@ -1377,8 +1381,8 @@ module Panel = struct
 
       and t =
         [ `Move of segment
-        | `Insert of t
+        | `Insert of node
-        | `Overwrite of t
+        | `Overwrite of node
         | `Yank of segment
         | `Kill of segment
         | `Ascend
@@ -1436,12 +1440,11 @@ module Panel = struct
           ppf ()
     end
 
-    let perform_action (a : Action.t) ({ path; root } : Page.cursor) :
+    let perform_action (a : Action.t) (path : path) (node : node) :
         node option =
       match a with
       | `Move (`Forward `Line) ->
-          (*
+          (* let i = ref 0 in
-          let i = ref 0 in
              ignore
                (search_backward
                   (function
@@ -1503,10 +1506,11 @@ module Panel = struct
       (*      | `Descend -> Some (sub c.sel) *)
       (*       | `Ascend -> option_of_parent c.sel.parent*)
       | `Custom _s -> None
+      | _ -> None
 
     type event_status = [ `Handled | `Event of Event.t ]
 
-    let textedit_bindings =
+    let default_bindings =
       let open Key.Bind in
       empty
       |> add [ ([ Ctrl ], C 'f') ] [ `Move (`Forward `Char) ]
@@ -1543,17 +1547,6 @@ module Panel = struct
     let cursor_attr =
       `Style Style.(bg NVG.Color.(rgbaf ~r:1. ~g:1. ~b:0. ~a:1.))
 
-    (* this was a hack?
-       let draw_node_structure (doc : node Lwd.var) : node =
-             let open Gg in
-             attr
-               (`Draw
-                 (fun (t : draw_context) (b : P2.t) ->
-                   Draw.node t b
-                     (Text.lines
-                        (Fmt.to_to_string pp_node_structure (Lwd.peek doc)))))
-               (atom `Empty) *)
-
     let node_structure root =
       Lwd.map
         ~f:(fun node ->
@@ -1566,26 +1559,12 @@ module Panel = struct
           Page.Text.lines (Fmt.to_to_string pp_path path))
         path
 
-    let textedit ?(bindings = textedit_bindings)
+    let nav_handler ?(bindings = default_bindings)
-        (initial : node * Page.path) =
+        ((page, path) : node Lwd.t * Page.path) =
-      Format.pp_set_max_boxes F.stderr 64;
+      let page, path = (Lwd.var page, Lwd.var path) in
-      (*full screen fynn  *)
+      let bind = Key.Bind.init bindings in
-      Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230;
+      handler
-      let doc = Lwd.var (fst initial) in
+        (fun (root : node) (e : Event.t) : node ->
-      let path = Lwd.var (snd initial) in
-      join_y
-        (pad 5. (Lwd.get doc))
-        (join_y
-           (pad 5. (draw_path (Lwd.get path)))
-           (pad 5. (node_structure (Lwd.get doc))))
-
-    (* let bind = Key.Bind.init bindings in
-       let sel = insert_attr cursor_attr n in
-       let c = { root = attr (`Handler (fun _ _ -> None)) sel; sel } in
-       c.root.t <-
-         `Attr
-           ( `Handler
-               (fun (_ : node) (e : Event.t) : Event.t option ->
           let a =
             match Key.Bind.resolve_events bind [ e ] with
             | x :: _ -> Some x
@@ -1594,68 +1573,48 @@ module Panel = struct
                 | `Key (`Press, (k : Key.keystate)) -> (
                     match k.code with
                     | `Uchar c ->
-                               Some (`Insert (atom (`Uchar c)))
+                        Some (`Insert (Page.atom (`Uchar c)))
                     | _ -> None)
                 | _ -> None)
           in
-                 let r =
           match a with
-                   | Some x ->
+          | Some x -> (
-                       c.sel <- remove_attr c.sel;
+              match perform_action x (Lwd.get path) root with
-                       (match perform_action x c with
               | Some n' ->
-                           F.epr "textedit action @[%a@] Success@."
+                  Log.info (fun m ->
-                             Action.pp_t x;
+                      m "nav_handler action @[%a@] Success@."
-                           c.sel <- n'
-                       | None ->
-                           F.epr "textedit action @[%a@] Failure@."
                         Action.pp_t x);
-                       c.sel <- insert_attr cursor_attr c.sel;
+                  n'
-                       None
+              | None ->
-                   | None -> None
+                  Log.warn (fun m ->
-                 in
+                      m "nav_handler action @[%a@] Failure@."
-                 r),
+                        Action.pp_t x);
-             n );
+                  root)
-       join_y (pad 5. c.root)
+          | None -> root)
         (join_y
-            (pad 5. (draw_cursor_sel c))
+           (pad 5. (Lwd.join @@ Lwd.get page))
-            (pad 5. (draw_cursor_root c))) *)
+           (join_y
+              (pad 5. (draw_path (Lwd.get path)))
+              (pad 5. (node_structure (Lwd.join @@ Lwd.get page)))))
 
-    (*
+    let is_handler (n : node) : Page.handler option =
-    let is_handler (n : node) : handler option =
       match n with `Attr (`Handler f, _) -> Some f | _ -> None
+
     (* * receives a node document and event and returns a node document where that event is handled *)
     let handle_event (n : t) (ev : Event.t) : t =
       Lwd.map
-        ~f:
+        ~f:(fun t ->
-          (fold_preorder
+          let handlers =
-             (fun ev' n' ->
+            Page.fold_preorder
+              (fun acc n' ->
                 match is_handler n' with
-               | Some f -> f n' ev'
+                | Some f -> Some (f :: acc)
-               | None -> None)
+                | None -> Some acc)
-             ev)
+              [] t
+          in
+          List.fold_left (fun acc f -> f acc ev) t handlers)
         n
 
-    let panel (vg : NVG.t) (p : P2.t) (t : t) (ev : Event.t) : P2.t =
-      (match handle_event t ev with
-      | `Handled -> F.epr "Handled %s@." (Event.to_string ev)
-      | `Event _e ->
-          F.epr "Unhandled event: %s@." (Event.to_string _e));
-      Draw.node { vg; style = Style.dark } p t
-      *)
-    (* I feel like the Wall module from github.com/let-def/wall includes another layer on top
-       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 Text = struct
       let lines = Lwd.map ~f:Page.Text.lines
       let of_string = Lwd.map ~f:Page.Text.of_string
@@ -1705,28 +1664,33 @@ module Panel = struct
                    (Lwd.peek var)));
         Lwd.get var
 
-      let draw (vg, p) (t : node Lwd.t) : Page.Draw.p Lwt.t =
+      let draw (vg, p) (root : node Lwd.root) : Page.Draw.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 (Page.Draw.node vg p (Lwd.quick_sample root))
     end
 
     open Lwt.Infix
 
-    let render_lwt (vg : NVG.t) (p : Gg.p2) (_ev : Event.t) :
+    (* event handler just needs to result in a Lwd.set on some portion of the doc root
-        Gg.p2 Lwt.t =
+       and then trigger a request animation frame *)
-      let t = { vg; style = Style.dark } in
+    let renderer (root : t Lwd.var) :
+        NVG.t -> ?time:float -> Gg.p2 -> Gg.p2 Lwt.t =
+      let root =
+        Lwd.observe
+          ~on_invalidate:(fun _ ->
+            Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
+          (Lwd.join (Lwd.get root))
+      in
+      fun vg ?(time = 0.) p ->
+        View.draw ({ vg; style = Style.dark; time }, p) root
+
+    let boot_page : node Lwd.t Lwt.t =
       Nav.test_pull () >>= fun tree ->
-      View.of_tree tree >>= fun doc ->
+      View.of_tree tree >>= fun tv ->
-      View.draw (t, p)
+      Lwt.return
-        (Lwd_utils.reduce pack_y
+        (vcat
            [
-             doc.doc;
+             nav_handler (tv.doc, []);
-             View.of_path (Lwd.peek doc.cursor);
+             View.of_path (Lwd.peek tv.cursor);
              View.list_logs Logs_reporter.hook;
            ])
   end