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 canvas =
-    Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
-  in
+let webgl_initialize canvas =
   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 render ev =
-    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
-      ~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
+let request_animation_frame () =
+  let t, s = Lwt.wait () in
+  let (_ : Dom_html.animation_frame_request_id) =
     Dom_html.window##requestAnimationFrame
-    (Js.wrap_callback (fun _ -> render Human.Event.empty))
-  |> ignore;*)
-  let open Js_of_ocaml_lwt.Lwt_js_events in
-  async (fun () ->
-      buffered_loop (make_event Dom_html.Event.keydown)
-        Dom_html.document (fun ev _ ->
+      (Js.wrap_callback (fun (time : float) -> Lwt.wakeup s time))
+  in
+  t
+
+let request_render canvas webgl_ctx vg
+    (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;
-          Human.Panel.Ui.(
-            render_lwt vg Gg.P2.o
-              (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.Transform.scale vg ~x:device_ratio ~y:device_ratio;
+  render vg ~time Gg.P2.o >>= 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:
    
@@ -976,24 +977,30 @@ module Panel = struct
   end
 
   module Ui = struct
-    (* Tree-like structure of Ui elements, from the entire display down to individual glyphs. *)
-    (* i think this is gonna end up being a binary tree?? *)
+    (* Tree-like document structure of Ui elements, from the top level window down
+       to individual glyphs, and built with Lwd.
 
-    (* TODO make sure this is LCRS: https://en.wikipedia.org/wiki/Left-child_right-sibling_binary_tree *)
+       Probably an LCRS binary tree.
+    *)
 
     open Gg
 
-    type t =
-      [ `Atom of atom
-      | `Attr of attr * node
-      | `Join of dir * node * node ]
+    type draw_context = { vg : NVG.t; style : Style.t; time : float }
+    and draw = draw_context -> Gg.p2 -> Gg.p2
 
-    and node = { mutable parent : parent; mutable t : t; n : int }
-    and parent = [ `Left of node | `Right of node | `None ]
-    and cursor = { root : node; mutable sel : node }
+    module Page = struct
+      type t =
+        (* TODO figure out how to allow extending `node` with custom document tree combinators *)
+        [ `Atom of atom | `Attr of attr * t | `Join of dir * t * t ]
+
+      and step = [ `Next | `Left | `Right ]
+      and path = step list
 
       and atom =
-      [ `Image of image
+        [ (*`Lwd of t
+            | *)
+          `Image of
+          image
         | `Uchar of Uchar.t
         | `Boundary of boundary
         | `Hint of [ `Line | `Other ]
@@ -1005,341 +1012,96 @@ 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 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 -> p -> p
+      and handler = t -> Event.t -> t
 
-    let node_count = ref 0
-
-    let node_n () =
-      node_count := !node_count + 1;
-      !node_count - 1
-
-    let set_parent_on_children n : node =
-      (match n.t with
-      | `Atom _ -> ()
-      | `Attr (_, a) -> a.parent <- `Left n
-      | `Join (_, a, b) ->
-          a.parent <- `Left n;
-          b.parent <- `Right n);
-      n
-
-    let sub (n : node) : node =
-      match n.t with
-      | `Atom _ -> n
+      let sub_left = function
+        | `Atom _ as n -> n
         | `Attr (_, n) -> n
         | `Join (_, a, _) -> a
 
-    let super (n : node) : node =
-      match n.parent with `Left n' | `Right n' -> n' | `None -> n
+      let sub = sub_left
 
-    let set_children_on_parent n =
-      match n.parent with
-      | `Left ({ t = `Attr (a, _); _ } as s)
-      | `Right ({ t = `Attr (a, _); _ } as s) ->
-          s.t <- `Attr (a, n);
-          n
-      | `Left ({ t = `Join (d, _, b); _ } as s) ->
-          s.t <- `Join (d, n, b);
-          n
-      | `Right ({ t = `Join (d, a, _); _ } as s) ->
-          s.t <- `Join (d, a, n);
-          n
-      | _ -> n
+      let sub_right = function
+        | `Atom _ as n -> n
+        | `Attr (_, n) -> n
+        | `Join (_, _, b) -> b
 
-    let option_of_parent = function
-      | `None -> None
-      | `Left a | `Right a -> Some a
-
-    let node (t : t) =
-      set_parent_on_children { parent = `None; t; n = node_n () }
-
-    let atom (a : atom) = node (`Atom a)
-    let attr (a : attr) (child : node) = node (`Attr (a, child))
-    let join (d : dir) (a : node) (b : node) = node (`Join (d, a, b))
-    let empty_image = V2.zero
-    let empty_node () = node (`Atom `Empty)
-    let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
+      let atom (a : atom) : t = `Atom a
+      let attr (a : attr) (child : t) : t = `Attr (a, child)
+      let join (d : dir) (a : t) (b : t) : t = `Join (d, a, b)
+      let empty = `Atom `Empty
+      let style (s : Style.t) t = attr (`Style s) t
       let pad v n = attr (`Pad (Pad.all v)) n
 
-    let rec node_up_ (d : [ `Left | `Right ]) n' =
-      match (d, n'.parent) with
-      | _, `None -> None
-      | ( _,
-          ( `Left ({ t = `Attr _; _ } as p)
-          | `Right ({ t = `Attr _; _ } as p) ) ) ->
-          node_up_ d p
-      | `Right, `Right ({ t = `Join _; _ } as p)
-      | `Left, `Left ({ t = `Join _; _ } as p) ->
-          node_up_ d p
-      | `Left, `Right { t = `Join (_, l, _); _ } -> Some l
-      | `Right, `Left { t = `Join (_, _, r); _ } -> Some r
-      | _, (`Left { t = `Atom _; _ } | `Right { t = `Atom _; _ }) ->
-          assert false
+      (* left child, right sibiling *)
+      let rec fold_preorder : ('a -> t -> 'a option) -> 'a -> t -> 'a
+          =
+       fun f acc n ->
+        match f acc n with
+        | Some acc' -> (
+            match n with
+            | `Atom _ -> acc'
+            | `Attr (_, n'') -> fold_preorder f acc' n''
+            | `Join (_, a, b) ->
+                fold_preorder f (fold_preorder f acc' a) b)
+        | None -> acc
 
-    let node_next_ (d : [ `Left | `Right ]) (n : node) =
-      match (d, n.t) with
-      | _, `Atom _ -> node_up_ d n
-      | _, `Attr (_, n') -> Some n'
-      | `Right, `Join (_, _, r) -> Some r
-      | `Left, `Join (_, l, _) -> Some l
+      (* let rec fold_inorder : ('a -> node -> 'a option) -> 'a -> node -> 'a  =
+          fun f acc n ->
+           match n with
+           | `Atom _ -> (match f acc n with
+               Some acc' -> acc'
+               | None -> acc)
+           | `Attr (_, n') ->
+             let acc' = (fold_inorder f acc n') in
+             (match f acc' n with
+               | Some acc'' -> acc''
+               | None -> acc')
+           | `Join (_, a, b) ->
+               fold_inorder f (f (fold_inorder f acc a) n) b
 
-    let rec search_preorder (f : node -> 'a option) (n : node) :
-        'a option =
-      match f n with
-      | None -> (
-          match node_next_ `Left n with
-          | Some n -> search_preorder f n
-          | None -> None)
-      | x -> x
-
-    let rec search_reverse_preorder (f : node -> 'a option) (n : node)
-        : 'a option =
-      match f n with
-      | None -> (
-          match node_next_ `Right n with
-          | Some n -> search_reverse_preorder f n
-          | None -> None)
-      | x -> x
-
-    let replace_parents_child parent n : node =
-      match parent with
-      | `Left ({ t = `Attr (a, _); _ } as p)
-      | `Right ({ t = `Attr (a, _); _ } as p) ->
-          p.t <- `Attr (a, n);
-          n
-      | `Left ({ t = `Join (d, _, r); _ } as p) ->
-          p.t <- `Join (d, n, r);
-          n
-      | `Right ({ t = `Join (d, l, _); _ } as p) ->
-          p.t <- `Join (d, l, n);
-          n
-      | _ -> n
-
-    let rec tree_iter f n i =
-      if i <> 0 then tree_iter f (f n) (i - 1) else f n
-
-    let search_forward f (n : node) = search_preorder f n
-    let search_backward f (n : node) = search_reverse_preorder f n
+         let rec fold_postorder : ('a -> node -> 'a option) -> 'a -> node -> 'a =
+          fun f acc n ->
+           match n with
+           | `Atom _ -> f (Some acc) n
+           | `Attr (_, n') -> f (fold_postorder f (Some acc) n') n
+           | `Join (_, a, b) ->
+               f (fold_postorder f (fold_postorder f (Some acc) a) b) n*)
 
       let is_atom_uchar = function
-      | { t = `Atom (`Uchar _); _ } as n -> Some n
+        | `Atom (`Uchar _) as n -> Some n
         | _ -> None
 
-    let tree_uchar_fwd n =
-      Option.value (search_forward is_atom_uchar n) ~default:n
-
-    let tree_uchar_back n =
-      Option.value (search_backward is_atom_uchar n) ~default:n
-
-    let is_boundary b n =
-      match (b, n.t) with
-      | `Char, `Atom (`Uchar _)
+      let is_boundary b t =
+        match (b, t) with
+        | ( `Char, `Atom (`Uchar _)
           | `Word, `Atom (`Boundary `Word)
           | `Phrase, `Atom (`Boundary `Phrase)
           | `Line, `Atom (`Boundary `Line)
-      | `Page, `Atom (`Boundary `Page) ->
-          Some n
+          | `Page, `Atom (`Boundary `Page) ) as x ->
+            Some x
         | _ -> None
 
-    let search_back_opt (f : node -> node option) (n : node option) =
-      Option.bind n (search_backward f)
-
-    let search_back_uchar_opt = search_back_opt is_atom_uchar
-
-    let rec traverse_nodes ~(f : node -> node option) (n : node) :
-        unit =
-      match f n with
-      | Some { t = `Atom _; _ } -> ()
-      | Some { t = `Attr (_, n'); _ } -> traverse_nodes ~f n'
-      | Some { t = `Join (_, a, b); _ } ->
-          traverse_nodes ~f a;
-          traverse_nodes ~f b
-      | None -> ()
-
-    let insert_join_l (d : dir) (n : node) (n' : node) : node =
-      let p = n.parent in
-      let n'' = join d n' n in
-      n''.parent <- p;
-      set_children_on_parent n''
-
-    let remove_join_l (n : node) : node =
-      match n.parent with
-      | `Left ({ t = `Attr (_, n'); _ } as s)
-      | `Right ({ t = `Attr (_, n'); _ } as s)
-      | `Left ({ t = `Join (_, _, n'); _ } as s) ->
-          s.t <- n'.t;
-          n'
-      | _ -> n
-
-    let kill_backward_char (n : node) : node option =
-      search_forward is_atom_uchar
-        (replace_parents_child (super (tree_uchar_back n)).parent n)
-
-    let insert_attr (a : attr) (n : node) : node =
-      let p = n.parent in
-      let n' = node (`Attr (a, n)) in
-      n'.parent <- p;
-      set_children_on_parent n'
-
-    let remove_attr (n : node) : node =
-      match n.t with
-      | `Attr (_, n') ->
-          (match n.parent with
-          | `Left ({ t = `Join (d, _, b); _ } as p) ->
-              p.t <- `Join (d, n', b);
-              ignore (set_parent_on_children p)
-          | `Right ({ t = `Join (d, a, _); _ } as p) ->
-              p.t <- `Join (d, a, n');
-              ignore (set_parent_on_children p)
-          | `Left ({ t = `Attr (a, _); _ } as p)
-          | `Right ({ t = `Attr (a, _); _ } as p) ->
-              p.t <- `Attr (a, n');
-              ignore (set_parent_on_children p)
-          | _ -> ());
-          n'
-      | _ -> assert false
-
       let join_x = join `X
       let join_y = join `Y
       let join_z = join `Z
-    let ( ^^ ) = join_x
-    let ( ^/^ ) = join_y
-    let ( ^*^ ) = join_z
 
-    let append_ d (l : node -> node) (a : node) : node -> node =
-     fun n -> l (join d a n)
+      module Text = struct
+        let append_ d (l : t -> t) (a : t) (b : t) : t =
+          l (join d a b)
 
         let empty_append = Fun.id
         let append_x = append_ `X
         let append_y = append_ `Y
         let append_z = append_ `Z
 
-    module Pp = struct
-      let pp_uchar ppf v =
-        if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
-        else Fmt.Dump.uchar ppf v
-
-      let pp_boundary ppf v =
-        F.any
-          (match v with
-          | `Char -> "`Char"
-          | `Word -> "`Word"
-          | `Phrase -> "`Phrase"
-          | `Line -> "`Line"
-          | `Page -> "`Page"
-          | `Text ->
-              "`Text"
-              (* text is like a file (unicode calls it End Of Text) *))
-          ppf ()
-
-      let pp_atom ppf v =
-        let open Fmt in
-        (match v with
-        | `Image _ -> any "`Image"
-        | `Uchar c -> any "`Uchar " ++ const pp_uchar c
-        | `Boundary b -> any "`Boundary " ++ const pp_boundary b
-        | `Hint h ->
-            any "`Hint "
-            ++ any
-                 (match h with
-                 | `Line -> "`Line"
-                 | `Other -> "`Other")
-        | `Empty -> any "`Empty")
-          ppf ()
-
-      let pp_attr ppf v =
-        let open Fmt in
-        (any
-           (match v with
-           | `Style _ -> "`Style ..."
-           | `Pad _ -> "`Pad ..."
-           | `Shift _ -> "`Shift ..."
-           | `Cursor -> "`Cursor"
-           | `Handler _ -> "`Handler ..."
-           | `Draw _ -> "`Draw ..."))
-          ppf ()
-
-      let pp_dir ppf v =
-        F.pf ppf "%s"
-          (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
-
-      let pp_node_n ppf v = F.(pf ppf "%a" int v.n)
-
-      let rec _pp_t child ppf v =
-        let open Fmt in
-        match v with
-        | `Atom x -> pf ppf "`Atom %a" pp_atom x
-        | `Attr (a, n) ->
-            pf ppf "`Attr %a"
-              (parens (const pp_attr a ++ comma ++ const child n))
-              ()
-        | `Join (d, a, b) ->
-            pf ppf "`Join %a"
-              (parens
-                 (const pp_dir d ++ comma ++ const child a ++ comma
-                ++ const child b))
-              ()
-
-      and _pp_parent ppf v =
-        let open Fmt in
-        match v with
-        | `None -> pf ppf "`None"
-        | `Left n -> pf ppf "`Left %a" pp_node_n n
-        | `Right n -> pf ppf "`Right %a" pp_node_n n
-
-      and _pp_node child ppf v =
-        let open Fmt in
-        pf ppf "@[<hov>%a@]"
-          (braces
-             (record
-                [
-                  field "n" (fun v -> v.n) int;
-                  field "t" (fun v -> v.t) (_pp_t child);
-                  field "parent" (fun v -> v.parent) _pp_parent;
-                ]))
-          v
-
-      and pp_node_n_record =
-        F.(
-          braces
-            (record ~sep:semi
-               [ field "n" Fun.id pp_node_n; any "..." ]))
-
-      and pp_node ppf = _pp_node pp_node_n ppf
-      and pp_dump_node ppf = _pp_node pp_dump_node ppf
-
-      let pp_t ppf = F.pf ppf "@[<hov>%a@]" (_pp_t pp_node_n_record)
-
-      let pp_n ppf n =
-        F.pf ppf "@[<h>%a: %a@]" pp_node_n n (_pp_t pp_node_n) n.t
-
-      let rec pp_node_structure ppf v =
-        F.(
-          const int v.n
-          ++ parens
-               (concat ~sep:comma
-                  (match v.t with
-                  | `Atom a -> [ const pp_atom a ]
-                  | `Attr (a, n) ->
-                      [ const pp_attr a; const pp_node_structure n ]
-                  | `Join (d, l, r) ->
-                      [
-                        const pp_dir d;
-                        const pp_node_structure l;
-                        const pp_node_structure r;
-                      ])))
-          ppf ()
-    end
-
-    open Pp
-
-    module Text = struct
         let rec decode dec (l : 'a) :
             'a * [< `Await | `End | `Uchar of Uchar.t ] =
           match Uutf.decode dec with
@@ -1352,7 +1114,8 @@ module Panel = struct
         and _of_string dec l =
           match decode dec l with
           | l, `End -> l (atom (`Boundary `Text))
-        | l, `Uchar c -> _of_string dec (append_x l (atom (`Uchar c)))
+          | l, `Uchar c ->
+              _of_string dec (append_x l (atom (`Uchar c)))
           | l, _ -> _of_string dec l
 
         and of_string str =
@@ -1388,15 +1151,15 @@ module Panel = struct
       end
 
       module Draw = struct
-      open NVG
-
+        type p = P2.t
         type d = [ `X | `Y | `Z ]
-      type t = draw_context
 
         let vcat d a b =
           match d with
           | `X ->
-            V2.v (V2.x a +. V2.x b) (Float.max_num (V2.y a) (V2.y b))
+              V2.v
+                (V2.x a +. V2.x b)
+                (Float.max_num (V2.y a) (V2.y b))
           | `Y ->
               V2.v (Float.max_num (V2.x a) (V2.x b)) (V2.y a +. V2.y b)
           | `Z ->
@@ -1417,17 +1180,14 @@ 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;
-        P2.v
-          (P2.x t +. bounds.advance)
+          let twidth = Text.text_w vg ~x ~y text in
+          P2.v twidth
             (P2.y t +. metrics.ascender +. metrics.descender
            +. metrics.line_height)
 
-      let rec atom vg b (a : atom) : P2.t =
-        let vg = vg.vg in
+        let rec atom { vg; _ } b (a : atom) : P2.t =
           match a with
           | `Image image ->
               let wi, hi = Image.size vg image in
@@ -1478,21 +1238,141 @@ module Panel = struct
                 (Float.max_num (V2.x av) (V2.x bv))
                 (Float.max_num (V2.y av) (V2.y bv))
 
-      and node t b (n : node) : P2.t =
+        and node vg b n : P2.t =
           let b' =
-          match n.t with
-          | `Atom a -> atom t b a
-          | `Attr a -> attr t b a
-          | `Join a -> join t b a
+            match n with
+            | `Atom a -> atom vg b a
+            | `Attr a -> attr vg b a
+            | `Join a -> join vg b a
           in
-        (*ignore
-           (Display.path_box t.vg
-             (Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
-             (Box2.of_pts b b') ) ; *)
+          (* ignore
+             (path_box vg.vg
+                (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
+                (Box2.of_pts b b')); *)
           b'
       end
 
+      module Pp = struct
+        let pp_uchar ppf v =
+          if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
+          else Fmt.Dump.uchar ppf v
+
+        let pp_boundary ppf v =
+          F.any
+            (match v with
+            | `Char -> "`Char"
+            | `Word -> "`Word"
+            | `Phrase -> "`Phrase"
+            | `Line -> "`Line"
+            | `Page -> "`Page"
+            | `Text ->
+                "`Text"
+                (* text is like a file (unicode calls it End Of Text) *))
+            ppf ()
+
+        let pp_atom ppf v =
+          let open Fmt in
+          (match v with
+          | `Image _ -> any "`Image"
+          | `Uchar c -> any "`Uchar " ++ const pp_uchar c
+          | `Boundary b -> any "`Boundary " ++ const pp_boundary b
+          | `Hint h ->
+              any "`Hint "
+              ++ any
+                   (match h with
+                   | `Line -> "`Line"
+                   | `Other -> "`Other")
+          | `Empty -> any "`Empty")
+            ppf ()
+
+        let pp_attr ppf v =
+          let open Fmt in
+          (any
+             (match v with
+             | `Style _ -> "`Style"
+             | `Pad _ -> "`Pad"
+             | `Shift _ -> "`Shift"
+             | `Handler _ -> "`Handler"
+             | `Draw _ -> "`Draw"))
+            ppf ()
+
+        let pp_dir ppf v =
+          F.pf ppf "%s"
+            (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
+
+        let rec _pp_t child ppf v =
+          let open Fmt in
+          match v with
+          | `Atom x -> pf ppf "`Atom %a" pp_atom x
+          | `Attr (a, n) ->
+              pf ppf "`Attr %a"
+                (F.pair (const pp_attr a) (const child n))
+                (a, n)
+          | `Join (d, a, b) ->
+              pf ppf "`Join %a"
+                (parens
+                   (const pp_dir d ++ comma ++ const child a ++ comma
+                  ++ const child b))
+                ()
+
+        and pp_node ppf = _pp_t pp_node ppf
+        and pp_dump_node ppf = _pp_t pp_dump_node ppf
+
+        let pp_t ppf = F.pf ppf "@[<hov>%a@]" pp_node
+
+        let rec pp_node_structure ppf t =
+          F.(
+            parens
+              (concat ~sep:comma
+                 (match t with
+                 | `Atom a -> [ const pp_atom a ]
+                 | `Attr (a, n) ->
+                     [ const pp_attr a; const pp_node_structure n ]
+                 | `Join (d, l, r) ->
+                     [
+                       const pp_dir d;
+                       const pp_node_structure l;
+                       const pp_node_structure r;
+                     ])))
+            ppf ()
+
+        let pp_step ppf s =
+          F.any
+            (match s with
+            | `Next -> "`Next"
+            | `Left -> "`Left"
+            | `Right -> "`Right")
+            ppf ()
+
+        let rec pp_path ppf (p : path) = F.list pp_step ppf p
+      end
+    end
+
+    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
+    let ( ^/^ ) = join_y
+    let ( ^*^ ) = join_z
+    let pack d = Lwd_utils.lift_monoid Page.(empty, join d)
+    let pack_x, pack_y, pack_z = (pack `X, pack `Y, pack `Z)
+    let cat d = Lwd_utils.reduce (pack d)
+    let hcat, vcat, zcat = (cat `X, cat `Y, cat `Z)
+
+    open Page.Pp
+
     module Action = struct
+      open Page
+
       type segment =
         [ `Beginning of boundary
         | `Forward of boundary
@@ -1560,10 +1440,11 @@ module Panel = struct
           ppf ()
     end
 
-    let perform_action (a : Action.t) (c : cursor) : node option =
+    let perform_action (a : Action.t) (path : path) (node : node) :
+        node option =
       match a with
-      | `Move (`Forward `Line) -> (
-          let i = ref 0 in
+      | `Move (`Forward `Line) ->
+          (* let i = ref 0 in
              ignore
                (search_backward
                   (function
@@ -1572,8 +1453,8 @@ module Panel = struct
                         incr i;
                         None
                     | _ -> None)
-               c.sel);
-          match search_forward (is_boundary `Line) c.sel with
+                  path);
+             match search_forward (is_boundary `Line) path with
              | Some n' ->
                  Some
                    (tree_iter
@@ -1582,9 +1463,10 @@ module Panel = struct
                           (search_forward (is_boundary `Char) nn)
                           ~default:nn)
                       n' !i)
-          | None -> None)
-      | `Move (`Backward `Line) -> (
-          let i = ref 0 in
+             | None -> *)
+          None
+      | `Move (`Backward `Line) ->
+          (* let i = ref 0 in
              match
                search_backward
                  (function
@@ -1599,8 +1481,9 @@ module Panel = struct
                  Option.map
                    (fun n -> tree_iter tree_uchar_back n !i)
                    (search_backward (is_boundary `Line) n')
-          | None -> None)
-      | `Move (`Forward b) ->
+               | None ->*)
+          None
+      (* | `Move (`Forward b) ->
            Option.map tree_uchar_fwd
                (search_forward (is_boundary b) c.sel)
          | `Move (`End b) ->
@@ -1614,19 +1497,20 @@ module Panel = struct
                (search_backward (is_boundary b) c.sel)
          | `Insert n ->
              ignore (insert_join_l `X (super c.sel) n);
-          Some c.sel
+             Some c.sel *)
       | `Overwrite _s -> None
       | `Yank _s -> None
       | `Kill (`Forward `Char) -> None (*kill_forward_char c.sel *)
-      | `Kill (`Backward `Char) -> kill_backward_char c.sel
+      (*      | `Kill (`Backward `Char) -> kill_backward_char c.sel *)
       | `Kill _s -> None
-      | `Descend -> Some (sub c.sel)
-      | `Ascend -> option_of_parent c.sel.parent
+      (*      | `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) ]
@@ -1663,35 +1547,24 @@ module Panel = struct
     let cursor_attr =
       `Style Style.(bg NVG.Color.(rgbaf ~r:1. ~g:1. ~b:0. ~a:1.))
 
-    let draw_cursor_root (c : cursor) : 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 c.root))))
-        (atom `Empty)
+    let node_structure root =
+      Lwd.map
+        ~f:(fun node ->
+          Page.Text.lines (Fmt.to_to_string pp_node_structure node))
+        root
 
-    let draw_cursor_sel (c : cursor) : 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 (sub c.sel)))))
-        (atom `Empty)
+    let draw_path path =
+      Lwd.map
+        ~f:(fun path ->
+          Page.Text.lines (Fmt.to_to_string pp_path path))
+        path
 
-    let textedit ?(bindings = textedit_bindings) (n : node) =
-      Format.pp_set_max_boxes F.stderr 64;
-      (*full screen fynn  *)
-      Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230;
+    let nav_handler ?(bindings = default_bindings)
+        ((page, path) : node Lwd.t * Page.path) =
+      let page, path = (Lwd.var page, Lwd.var path) in
       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 ->
+      handler
+        (fun (root : node) (e : Event.t) : node ->
           let a =
             match Key.Bind.resolve_events bind [ e ] with
             | x :: _ -> Some x
@@ -1700,65 +1573,52 @@ 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 ->
-                      c.sel <- remove_attr c.sel;
-                      (match perform_action x c with
+          | Some x -> (
+              match perform_action x (Lwd.get path) root with
               | Some n' ->
-                          F.epr "textedit action @[%a@] Success@."
-                            Action.pp_t x;
-                          c.sel <- n'
-                      | None ->
-                          F.epr "textedit action @[%a@] Failure@."
+                  Log.info (fun m ->
+                      m "nav_handler action @[%a@] Success@."
                         Action.pp_t x);
-                      c.sel <- insert_attr cursor_attr c.sel;
-                      None
-                  | None -> None
-                in
-                r),
-            n );
-      join_y (pad 5. c.root)
+                  n'
+              | None ->
+                  Log.warn (fun m ->
+                      m "nav_handler action @[%a@] Failure@."
+                        Action.pp_t x);
+                  root)
+          | None -> root)
         (join_y
-           (pad 5. (draw_cursor_sel c))
-           (pad 5. (draw_cursor_root c)))
+           (pad 5. (Lwd.join @@ Lwd.get page))
+           (join_y
+              (pad 5. (draw_path (Lwd.get path)))
+              (pad 5. (node_structure (Lwd.join @@ Lwd.get page)))))
 
-    let handler_of_node (n : node) : handler option =
-      let f n =
-        match n.t with `Attr (`Handler f, _) -> Some f | _ -> None
+    let is_handler (n : node) : Page.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:(fun t ->
+          let handlers =
+            Page.fold_preorder
+              (fun acc n' ->
+                match is_handler n' with
+                | Some f -> Some (f :: acc)
+                | None -> Some acc)
+              [] t
           in
-      match f n with Some a -> Some a | None -> search_forward f n
+          List.fold_left (fun acc f -> f acc ev) t handlers)
+        n
 
-    let handle_event (n : node) (ev : Event.t) : event_status =
-      match handler_of_node n with
-      | Some f -> (
-          match f n ev with Some ev -> `Event ev | None -> `Handled)
-      | None -> `Event ev
-
-    let panel (vg : NVG.t) (p : P2.t) (t : node) (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
+    end
 
     module View = struct
       type path = Nav.path
@@ -1772,26 +1632,11 @@ module Panel = struct
 
       open Lwt.Infix
 
-      let pack_x = Lwd_utils.lift_monoid (empty_node (), join_x)
-      let pack_y = Lwd_utils.lift_monoid (empty_node (), join_y)
-      let pack_z = Lwd_utils.lift_monoid (empty_node (), join_z)
-
-      module DText = struct
-        let lines = Lwd.map ~f:Text.lines
-        let of_string = Lwd.map ~f:Text.of_string
-      end
-
       let of_path path =
-        Lwd.map2 ~f:join_x
-          (DText.of_string (Lwd.pure "/"))
+        join_x
+          (Text.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);
-                 ])
+             (fun step -> Lwd.pure (Page.Text.of_string ("/" ^ step)))
              pack_x path)
 
       let of_tree ?(path = []) tree =
@@ -1803,42 +1648,49 @@ module Panel = struct
             cursor = Lwd.var path;
             doc =
               Lwd_utils.map_reduce
-                (fun (step, _t') -> DText.of_string (Lwd.pure step))
+                (fun (step, _t') -> Text.of_string (Lwd.pure step))
                 pack_y l;
           }
 
       let list_logs hook =
-        let var = Lwd.var (empty_node ()) in
+        let var = Lwd.var Page.empty in
         (hook :=
            fun level s ->
              Lwd.set var
-               (join_y
+               Page.(
+                 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))
+      let draw (vg, p) (root : node Lwd.root) : Page.Draw.p Lwt.t =
+        Lwt.return (Page.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
+    (* event handler just needs to result in a Lwd.set on some portion of the doc root
+       and then trigger a request animation frame *)
+    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.draw (t, p)
-        (Lwd_utils.reduce View.pack_y
+      View.of_tree tree >>= fun tv ->
+      Lwt.return
+        (vcat
            [
-             doc.doc;
-             View.of_path (Lwd.peek doc.cursor);
+             nav_handler (tv.doc, []);
+             View.of_path (Lwd.peek tv.cursor);
              View.list_logs Logs_reporter.hook;
            ])
   end