irmin

dune

@@ -13,8 +13,8 @@
    graphv_webgl
    js_of_ocaml
    lwt
-;   irmin-git
+   irmin
-;   irmin-indexeddb
+   irmin-git
    zed
    gg
 

human.ml

@@ -1,5 +1,14 @@
 (*
 
+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
+* TODO
+
+*)
+
+(*
+
 ALWAYS BREAK UP THE PROBLEM INTO SMALLER CHUNKS BITCH!!
 
 Times I would have solved it faster if i broke it up instead of trying to understand it all at once: 2
@@ -20,18 +29,26 @@ some options:
 
 *)
 
-open Lwt.Infix
 module F = Fmt
 module NVG = Graphv_webgl
 
-(* module Istore = Irmin_unix.Git.FS.KV (Irmin.Contents.String)*)
+module Nav = struct
-(*module Istore =
+  open Lwt.Infix
-  Irmin_git.Generic
+         
-    (Irmin_indexeddb.Content_store)
+  module S = Irmin_mem.KV.Make(Irmin.Contents.String)
-    (Irmin_indexeddb.Branch_store)
+
-    (Irmin.Contents.String)
+  type t = S.tree
-    (Irmin.Path.String_list)
+
-    (Irmin.Branch.String)*)
+  let init () : t Lwt.t =
+    S.Repo.v (Irmin_mem.config ()) >>= S.main >>= S.tree 
+
+  let test_populate () : t Lwt.t =
+    let add p s t = S.Tree.add t p s in
+    add ["hello"] "world"  (S.Tree.empty ()) >>=
+    add ["hello";"daddy"] "ily" >>=
+    add ["beep";"beep"] "motherfucker"
+
+end
 
 module Key = struct
   type special =
@@ -325,11 +342,9 @@ module Event_js = struct
     | None -> `Unknown "keypress .key is None?"
 end
 
-module Display = struct
+module Panel = struct
   open Gg
-  module I = NVG.Image
+  open NVG
-  module P = NVG.Path
-  module Color = NVG.Color
 
   (* current window state to be passed to window renderer *)
   type state =
@@ -380,45 +395,6 @@ module Display = struct
     NVG.stroke vg ;
     Box2.max b
 
-  (* Display.state.box as supplied to a widget defines the allowed drawing area for the widget.
-     This way basic widgets will just expand to the full area of a box, while other widgets can have
-     the express purpose of limiting the size of an object in a larger system of limitations.
-
-     Panes return a tuple: (state, (box, image))
-     state is the updated state, where state.box is always
-       - the top left corner of the box the pane drew in, and
-       - the bottom right corner of the state.box that was passed in
-     box is the area the widget actually drew in (or wants to sort of "use")
-     image is the Wall.image to compose with other panes and draw to the display
-  *)
-end
-
-module Panel = struct
-  open Gg
-  open NVG
-
-  type t =
-    { mutable act: t -> Event.events -> Display.pane Lwt.t
-    ; mutable subpanels: t Lwt.t list
-    ; mutable tag: string }
-
-  type panel = t
-
-  let blank =
-    { act= (fun _panel _events -> Lwt.return Display.pane_empty)
-    ; subpanels= []
-    ; tag= "blank pane" }
-
-  let draw (pane : Display.pane) =
-    Lwt.return
-      { act= (fun _panel _events -> Lwt.return pane)
-      ; subpanels= []
-      ; tag= "draw-pane" }
-
-  let actor (panel : t) : Event.events -> Display.pane Lwt.t =
-   fun events ->
-    panel.act panel events >>= fun pane -> Lwt.return pane
-
   module Style = struct
     module Font = struct
       type t =
@@ -531,6 +507,8 @@ module Panel = struct
       ; b= Gg.Size1.zero
       ; l= Gg.Size1.zero
       ; r= Gg.Size1.zero }
+
+    let all v = {t= v; b= v; l= v; r= v}
   end
 
   module Ui = struct
@@ -546,7 +524,8 @@ module Panel = struct
       | `Attr of attr * node
       | `Join of dir * node * node ]
 
-    and node = {mutable parent: node option; mutable t: t; n: int}
+    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}
 
     and atom =
@@ -556,12 +535,19 @@ module Panel = struct
       | `Hint of [`Line | `Other]
       | `Empty ]
 
-    and attr = [`Style of style | `Pad of Pad.t | `Handler of handler]
+    and attr =
+      [ `Style of style
+      | `Pad of Pad.t
+      | `Handler of handler
+      | `Draw of draw ]
+
     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
 
     let node_count = ref 0
 
@@ -572,10 +558,10 @@ module Panel = struct
     let set_parent_on_children n : node =
       ( match n.t with
       | `Atom _ -> ()
-      | `Attr (_, a) -> a.parent <- Some n
+      | `Attr (_, a) -> a.parent <- `Left n
       | `Join (_, a, b) ->
-          a.parent <- Some n ;
+          a.parent <- `Left n ;
-          b.parent <- Some n ) ;
+          b.parent <- `Right n ) ;
       n
 
     let sub (n : node) : node =
@@ -585,23 +571,28 @@ module Panel = struct
       | `Join (_, a, _) -> a
 
     let super (n : node) : node =
-      match n.parent with Some n' -> n' | None -> n
+      match n.parent with `Left n' | `Right n' -> n' | `None -> n
 
-    let set_children_on_parent ~oldc ~newc =
+    let set_children_on_parent n =
-      match newc.parent with
+      match n.parent with
-      | Some ({t= `Attr (a, _); _} as s) ->
+      | `Left ({t= `Attr (a, _); _} as s)
-          s.t <- `Attr (a, newc) ;
+       |`Right ({t= `Attr (a, _); _} as s) ->
-          newc
+          s.t <- `Attr (a, n) ;
-      | Some ({t= `Join (d, a, b); _} as s) when oldc == a ->
+          n
-          s.t <- `Join (d, newc, b) ;
+      | `Left ({t= `Join (d, _, b); _} as s) ->
-          newc
+          s.t <- `Join (d, n, b) ;
-      | Some ({t= `Join (d, a, b); _} as s) when oldc == b ->
+          n
-          s.t <- `Join (d, a, newc) ;
+      | `Right ({t= `Join (d, a, _); _} as s) ->
-          newc
+          s.t <- `Join (d, a, n) ;
-      | _ -> newc
+          n
+      | _ -> n
+
+    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 ()}
+      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))
@@ -609,6 +600,159 @@ module Panel = struct
     let empty_image = V2.zero
     let empty_node () = node (`Atom `Empty)
     let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
+    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
+
+    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 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 is_atom_uchar = function
+      | {t= `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 _)
+       |`Word, `Atom (`Boundary `Word)
+       |`Phrase, `Atom (`Boundary `Phrase)
+       |`Line, `Atom (`Boundary `Line)
+       |`Page, `Atom (`Boundary `Page) ->
+          Some n
+      | _ -> 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)
+
+    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 =
@@ -650,7 +794,8 @@ module Panel = struct
            | `Pad _ -> "`Pad ..."
            | `Shift _ -> "`Shift ..."
            | `Cursor -> "`Cursor"
-           | `Handler _ -> "`Handler ..." ) )
+           | `Handler _ -> "`Handler ..."
+           | `Draw _ -> "`Draw ..." ) )
           ppf ()
 
       let pp_dir ppf v =
@@ -674,6 +819,13 @@ module Panel = struct
                  ++ 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@]"
@@ -681,9 +833,7 @@ module Panel = struct
              (record
                 [ field "n" (fun v -> v.n) int
                 ; field "t" (fun v -> v.t) (_pp_t child)
-                ; field "parent"
+                ; field "parent" (fun v -> v.parent) _pp_parent ] ) )
-                    (fun v -> v.parent)
-                    (option pp_node_n) ] ) )
           v
 
       and pp_node_n_record =
@@ -716,58 +866,6 @@ module Panel = struct
 
     open Pp
 
-    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_r (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 ~oldc:n ~newc: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 ~oldc:n ~newc:n'
-
-    let remove_attr (n : node) : node =
-      match n.t with
-      | `Attr (_, n') ->
-          ( match n.parent with
-          | Some p ->
-              p.t <-
-                ( match p.t with
-                | `Attr (a, _) -> `Attr (a, n')
-                | `Join (d, a, b) when n == a -> `Join (d, n', b)
-                | `Join (d, a, b) when n == b -> `Join (d, a, n')
-                | _ -> assert false ) ;
-              ignore (set_parent_on_children p)
-          | None -> () ) ;
-          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)
-
-    let empty_append = Fun.id
-    let append_x = append_ `X
-    let append_y = append_ `Y
-    let append_z = append_ `Z
-
     module Text = struct
       let rec decode dec (l : 'a) :
           'a * [< `Await | `End | `Uchar of Uchar.t] =
@@ -821,7 +919,7 @@ module Panel = struct
       open NVG
 
       type d = [`X | `Y | `Z]
-      type t = {vg: NVG.t; style: Style.t}
+      type t = draw_context
 
       let vcat d a b =
         match d with
@@ -855,7 +953,7 @@ module Panel = struct
           ( P2.y t +. metrics.ascender +. metrics.descender
           +. metrics.line_height )
 
-      let rec atom vg b a : P2.t =
+      let rec atom vg b (a : atom) : P2.t =
         let vg = vg.vg in
         match a with
         | `Image image ->
@@ -877,15 +975,16 @@ module Panel = struct
       and attr t b ((a : attr), n) : P2.t =
         match a with
         | `Style s ->
-            Display.fill_box t.vg s.bg
+            path_box t.vg s.bg
               (Box2.of_pts b
                  (node {t with style= Style.merge t.style s} b n) )
         | `Pad p -> pad t b p n
-        | _ -> node t b n
+        | `Draw d -> d t b
+        | `Handler _ -> node t b n
 
       and pad vg t (p : Pad.t) n =
         let nv = node vg P2.(v (p.l +. x t) (p.t +. y t)) n in
-        P2.(v (x nv +. p.r) (y t +. p.b))
+        P2.(v (x nv +. p.r) (y nv +. p.b))
 
       and join vg t (d, a, b) : P2.t =
         let av = node vg t a in
@@ -910,10 +1009,10 @@ module Panel = struct
           | `Atom a -> atom t b a
           | `Attr a -> attr t b a
           | `Join a -> join t b a in
-        (* ignore
+        (*ignore
            (Display.path_box t.vg
              (Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
-              (Box2.of_pts b b') ) ;*)
+             (Box2.of_pts b b') ) ; *)
         b'
     end
 
@@ -985,80 +1084,7 @@ module Panel = struct
           ppf ()
     end
 
-    let tree_next (n : node) =
-      let rec next_right n' =
-        match n'.parent with
-        | None -> None
-        | Some ({t= `Attr _; _} as p) -> next_right p
-        | Some {t= `Join (_, a, b); _} when n' == a -> Some b
-        | Some ({t= `Join (_, _, b); _} as p) when n' == b ->
-            next_right p
-        | Some {t= `Join _; _} -> assert false
-        | Some {t= `Atom _; _} -> assert false in
-      match n.t with
-      | `Atom _ -> next_right n
-      | `Attr (_, n') -> Some n'
-      | `Join (_, a, _) -> Some a
-
-    let tree_prev (n : node) =
-      let rec prev_right n' =
-        match n'.t with
-        | `Attr (_, nn) -> prev_right nn
-        | `Join (_, _, b) -> prev_right b
-        | `Atom _ -> Some n' in
-      match n.parent with
-      | None -> None
-      | Some {t= `Atom _; _} ->
-          assert false
-          (* shouldn't happen TODO is there no way to type constrain these? *)
-      | Some {t= `Attr _; _} -> n.parent
-      | Some {t= `Join (_, a, b); _} when b == n -> prev_right a
-      | Some {t= `Join (_, a, _); _} when a == n -> n.parent
-      | Some {t= `Join _; _} -> assert false
-    (* shouldn't happen *)
-
-    let rec tree_iter f n i =
-      if i <> 0 then tree_iter f (f n) (i - 1) else f n
-
-    let rec search_ next f n =
-      (*      F.epr "search_ " ; *)
-      match next n with
-      | Some n' -> (
-        (*          F.epr "%a@." pp_n n' ; *)
-        match f n' with
-        | Some a -> (n', Some a)
-        | None -> search_ next f n' )
-      | None -> (*F.epr "None@." ; *) (n, None)
-
-    let search_forward f (n : node) = snd (search_ tree_next f n)
-    let search_backward f (n : node) = snd (search_ tree_prev f n)
-
-    let is_atom_uchar = function
-      | {t= `Atom (`Uchar _); _} as n -> Some n
-      | _ -> None
-
-    let tree_uchar_fwd n =
-      match is_atom_uchar n with
-      | Some a -> a
-      | None ->
-          Option.value (search_forward is_atom_uchar n) ~default:n
-
-    let tree_uchar_back n =
-      match is_atom_uchar n with
-      | Some a -> a
-      | None ->
-          Option.value (search_backward is_atom_uchar n) ~default:n
-
     let perform_action (a : Action.t) (c : cursor) : node option =
-      let mb ?(f = fun a -> a) b n =
-        match (b, n.t) with
-        | `Char, `Atom (`Uchar _)
-         |`Word, `Atom (`Boundary `Word)
-         |`Phrase, `Atom (`Boundary `Phrase)
-         |`Line, `Atom (`Boundary `Line)
-         |`Page, `Atom (`Boundary `Page) ->
-            Some (f n)
-        | _ -> None in
       match a with
       | `Move (`Forward `Line) -> (
           let i = ref 0 in
@@ -1069,13 +1095,13 @@ module Panel = struct
                  | {t= `Atom (`Uchar _); _} -> incr i ; None
                  | _ -> None )
                c.sel ) ;
-          match search_forward (mb `Line) c.sel with
+          match search_forward (is_boundary `Line) c.sel with
           | Some n' ->
               Some
                 (tree_iter
                    (fun nn ->
                      Option.value
-                       (search_forward (mb `Char) nn)
+                       (search_forward (is_boundary `Char) nn)
                        ~default:nn )
                    n' !i )
           | None -> None )
@@ -1090,34 +1116,32 @@ module Panel = struct
               c.sel
           with
           | Some n' ->
-              Some
+              Option.map
-                (tree_iter
+                (fun n -> tree_iter tree_uchar_back n !i)
-                   (fun nn ->
+                (search_backward (is_boundary `Line) n')
-                     Option.value
-                       (search_forward (mb `Char) nn)
-                       ~default:nn )
-                   (fst (search_ tree_prev (mb `Line) n'))
-                   !i )
           | None -> None )
       | `Move (`Forward b) ->
-          search_forward (mb ~f:tree_uchar_back b) c.sel
+          Option.map tree_uchar_fwd
-      | `Move (`Backward b) ->
+            (search_forward (is_boundary b) c.sel)
-          search_backward (mb ~f:tree_uchar_fwd b) c.sel
-      | `Move (`Beginning b) ->
-          (* uses last searched node regardless of match *)
-          Some (tree_uchar_fwd (fst (search_ tree_prev (mb b) c.sel)))
       | `Move (`End b) ->
-          (* uses last searched node regardless of match *)
+          Option.map tree_uchar_back
-          Some
+            (search_forward (is_boundary b) c.sel)
-            (tree_uchar_back (fst (search_ tree_next (mb b) c.sel)))
+      | `Move (`Backward b) ->
+          Option.map tree_uchar_back
+            (search_backward (is_boundary b) c.sel)
+      | `Move (`Beginning b) ->
+          Option.map tree_uchar_fwd
+            (search_backward (is_boundary b) c.sel)
       | `Insert n ->
-          ignore (insert_join_r `X (super c.sel) n) ;
+          ignore (insert_join_l `X (super c.sel) n) ;
           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 _s -> None
       | `Descend -> Some (sub c.sel)
-      | `Ascend -> c.sel.parent
+      | `Ascend -> option_of_parent c.sel.parent
       | `Custom _s -> None
 
     type event_status = [`Handled | `Event of Event.t]
@@ -1146,6 +1170,8 @@ module Panel = struct
       |> add [([Ctrl], C 'a')] [`Move (`Beginning `Line)]
       |> add [([Ctrl], C 'e')] [`Move (`End `Line)]
       |> add [([Ctrl], C 'k')] [`Kill (`End `Line)]
+      |> add [([], U `Backspace)] [`Kill (`Backward `Char)]
+      |> add [([], U `Delete)] [`Kill (`Forward `Char)]
       |> add [([Ctrl], U `Backspace)] [`Kill (`Backward `Word)]
       |> add [([Meta], U `Backspace)] [`Kill (`Backward `Word)]
       |> add
@@ -1157,6 +1183,25 @@ 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 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 textedit ?(bindings = textedit_bindings) (n : node) =
       Format.pp_set_max_boxes F.stderr 64 ;
       (*full screen fynn  *)
@@ -1178,6 +1223,7 @@ module Panel = struct
                       | `Uchar c -> Some (`Insert (atom (`Uchar c)))
                       | _ -> None )
                     | _ -> None ) in
+                let r =
                   match a with
                   | Some x ->
                       c.sel <- remove_attr c.sel ;
@@ -1190,11 +1236,14 @@ module Panel = struct
                           F.epr "textedit action @[%a@] Failure@."
                             Action.pp_t x ) ;
                       c.sel <- insert_attr cursor_attr c.sel ;
-                    F.epr "tree: @[%a@]@." Pp.pp_node_structure c.root ;
                       None
-                | None -> None )
+                  | None -> None in
+                r )
           , n ) ;
-      set_parent_on_children c.root
+      join_y (pad 5. c.root)
+        (join_y
+           (pad 5. (draw_cursor_sel c))
+           (pad 5. (draw_cursor_root c)) )
 
     let handler_of_node (n : node) : handler option =
       let f n =
@@ -1217,14 +1266,15 @@ module Panel = struct
       Draw.node {vg; style= Style.dark} p t
 
     let test =
-      textedit
+      style Style.dark
-        (style Style.dark
+        (pad 20.
+           (textedit
               Text.(
                 (* text "--- welcome to my land of idiocy ---"
                    ^/^ *)
                 text "hello bitch"
                 (*^^ text "! sup daddy" ^^ nl)
-               ^/^ lines "123")*)) )
+                  ^/^ lines "123")*)) ) )
   end
 end
 
@@ -1256,3 +1306,5 @@ end
 
    If the Irmin Tree is better implemented than the garbage i am trying to make ad hoc, (i.e. we can implement all our cursor movement and editing mechanisms with the Irmin.Tree interface easily, then yea lol)
 *)
+
+(* would be nice to be able to switch arbitrary nodes between their drawn representation and the sort of node structure representation. This might be a more general philsophy to apply to the entire system, where you want to be able to switch between representations (i.e. "view-source" but with further higher level analysis views built on top as well *)