From 205f650eac63341796459975b6f9e92ff2922e8a Mon Sep 17 00:00:00 2001 From: cqc Date: Sat, 19 Mar 2022 15:14:23 -0500 Subject: [PATCH] Action.pp_t and cleanup --- human.ml | 151 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 101 insertions(+), 50 deletions(-) diff --git a/human.ml b/human.ml index 6d8f1e5..a5d8caa 100644 --- a/human.ml +++ b/human.ml @@ -2,6 +2,8 @@ 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 + a computation console - irmin store provides a tree of data objects @@ -1242,6 +1244,8 @@ module Panel = 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?? *) + (* TODO make sure this is LCRS: https://en.wikipedia.org/wiki/Left-child_right-sibling_binary_tree *) + open Gg open Wall @@ -1250,7 +1254,7 @@ module Panel = struct | `Attr of attr * node | `Join of dir * node * node ] - and node = {mutable parent: node option; mutable t: t} + and node = {mutable parent: node option; mutable t: t; n: int} and cursor = {root: node; mutable sel: node} and atom = @@ -1281,7 +1285,15 @@ module Panel = struct b.parent <- Some n ) ; n - let node (t : t) = set_parent_on_children {parent= None; t} + let node_count = ref 0 + + let node_n () = + node_count := !node_count + 1 ; + !node_count - 1 + + let node (t : t) = + set_parent_on_children {parent= None; t; n= node_n ()} + let empty_image = (Image.empty, V2.zero) let empty_node = node (`Atom `Empty) let style (s : Style.t) (n : node) = node (`Attr (`Style s, n)) @@ -1333,7 +1345,8 @@ module Panel = struct | `Join (_, a, _) -> a let join_ d (a : node) (b : node) = - set_parent_on_children {parent= a.parent; t= `Join (d, a, b)} + set_parent_on_children + {parent= a.parent; t= `Join (d, a, b); n= node_n ()} let join_x = join_ `X let join_y = join_ `Y @@ -1374,8 +1387,6 @@ module Panel = struct | `Empty -> any "`Empty" ) ppf () - let tess v = F.epr "%a" pp_atom v - let pp_attr ppf v = let open Fmt in (any @@ -1391,36 +1402,44 @@ module Panel = struct F.pf ppf "%s" (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z") - let rec pp_node ppf v = - let open Fmt in - pf ppf "@[%a@]" pp_t v.t + let pp_node_n ppf v = + F.( + pf ppf "%a" + (record [field "n" (fun v -> v.n) int; any "..."]) + v) - and pp_t ppf v = + 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 pp_node a ++ comma - ++ const pp_node b ) ) + ( const pp_dir d ++ comma ++ const child a ++ comma + ++ const child b ) ) () - | `Attr (a, n) -> - pf ppf "`Attr %a" - (parens (const pp_attr a ++ comma ++ const pp_node n)) - () - | `Atom x -> pf ppf "`Atom %a" pp_atom x - let rec pp_dump_node ppf v = + and _pp_node child ppf v = let open Fmt in pf ppf "@[%a@]" (braces (record - [ field "t" (fun v -> v.t) pp_t + [ field "n" (fun v -> v.n) int + ; field "t" (fun v -> v.t) (_pp_t child) ; field "parent" (fun v -> v.parent) - (option pp_dump_node) ] ) ) + (option (fun ppf v -> pf ppf "%a" int v.n)) ] ) ) v + and pp_node ppf v = _pp_node pp_node_n ppf v + and pp_dump_node ppf v = _pp_node pp_dump_node ppf v + + let pp_t = _pp_t pp_node_n + (* there's no difference between a node element and a node list what, tho an element is kinda like a node.t, so i guess we'll use that to kinda emulate append (vs. concat which is what join is) ugh maybe using types to build this double-linked binary-tree data structure is not a good idea. @@ -1593,13 +1612,13 @@ module Panel = struct type segment_type = [`Char | `Word | `Phrase | `Line | `Page | `Region] - type segment = + and segment = [ `Beginning of segment_type | `Forward of segment_type | `Backward of segment_type | `End of segment_type ] - type t = + and t = [ `Move of segment | `Yank of segment | `Kill of segment @@ -1607,7 +1626,7 @@ module Panel = struct | `Descend | `Custom of string * (node -> t Key.Bind.t -> unit Lwt.t) ] - type dir = + and dir = [ `Next | `Prev | `Up @@ -1618,31 +1637,68 @@ module Panel = struct | `Enter | `In | `Out ] + + open Fmt + + let pp_dir ppf v = + any + ( match v with + | `Next -> "`Next" + | `Prev -> "`Prev" + | `Up -> "`Up" + | `Down -> "`Down" + | `Left -> "`Left" + | `Right -> "`Right" + | `Fwd -> "`Fwd" + | `Enter -> "`Enter" + | `In -> "`In" + | `Out -> "`Out" ) + ppf () + + let pp_segment_type ppf v = + any + ( match v with + | `Char -> "`Char" + | `Word -> "`Word" + | `Phrase -> "`Phrase" + | `Line -> "`Line" + | `Page -> "`Page" + | `Region -> "`Region" ) + ppf () + + let pp_segment ppf v = + ( match v with + | `Beginning s -> any "`Beginning " ++ const pp_segment_type s + | `Forward s -> any "`Forward " ++ const pp_segment_type s + | `Backward s -> any "`Backward " ++ const pp_segment_type s + | `End s -> any "`End " ++ const pp_segment_type s ) + ppf () + + let pp_t ppf v = + ( match v with + | `Move s -> any "`Move " ++ const pp_segment s + | `Yank s -> any "`Yank " ++ const pp_segment s + | `Kill s -> any "`Kill " ++ const pp_segment s + | `Ascend -> any "`Ascend" + | `Descend -> any "`Descend" + | `Custom (s, _) -> + fun ppf () -> pf ppf "`Custom \"%a\"" string s ) + ppf () end let tree_next (n : node) = - F.epr "tree_next @." ; let rec next_right n' = - F.epr "next_right n=%a@." pp_dump_node n' ; - match n.parent with - | None -> - F.epr "tree_next None@." ; - None + match n'.parent with + | None -> None | Some ({t= `Attr _; _} as p) -> next_right p - | Some {t= `Join (_, a, b); _} when n' == a -> - F.epr "next_right `Join _,n,_@." ; - Some b + | Some {t= `Join (_, a, b); _} when n' == a -> Some b | Some ({t= `Join (_, _, b); _} as p) when n' == b -> - F.epr "next_right `Join _,_,n@." ; next_right p - | Some {t= `Join (_, a, b); _} -> - F.epr "next_right `Join (_,%a,%a)@." pp_node a pp_node b ; - assert false + | Some {t= `Join _; _} -> assert false | Some {t= `Atom _; _} -> assert false in match n.t with | `Atom _ -> next_right n | `Attr (_, n') -> Some n' - | `Join (_, {t= `Atom `Empty; _}, b) -> Some b | `Join (_, a, _) -> Some a let tree_prev (n : node) = @@ -1658,7 +1714,6 @@ module Panel = struct let rec search_forward (n : node) (f : node -> 'a option) : 'a option = - F.epr "search_forward @." ; match f n with | None -> ( match tree_next n with @@ -1685,7 +1740,6 @@ module Panel = struct | `Atom (`Boundary `Word) -> Some n | _ -> None ) | `Move (`Forward `Char) -> - F.epr "`Move (`Forward `Char)%a@." pp_node c.sel ; search_forward c.sel (fun n -> match n.t with | _ when n == c.sel -> None @@ -1756,41 +1810,38 @@ module Panel = struct ( match join_search_forward n with | Some n -> n | None -> n ) } in + Format.pp_set_max_boxes F.stderr 99999 ; Format.( F.epr - "@[ F.stderr margin: %d, max_indent: %d, max_boxes: %d \ + "@[F.stderr margin: %d, max_indent: %d, max_boxes: %d \ @]@." (pp_get_margin F.stderr ()) (pp_get_max_indent F.stderr ()) (pp_get_max_boxes F.stderr ())) ; - Format.pp_set_max_boxes F.stderr 32 ; node (`Attr ( `Handler (fun (_ : node) (e : Event.t) : Event.t option Lwt.t -> match Key.Bind.resolve_events bind [e] with | x :: _ -> - F.epr "textedit_handler handling event@." ; c.sel <- remove_attr c.sel ; ( match perform_action x c with | Some _ -> F.epr - "textedit_handler perform_action success@." + "textedit_handler perform_action @[%a@] \ + success@." + Action.pp_t x | None -> F.epr - "textedit_handler perform_action FAILURE@." - ) ; + "textedit_handler perform_action @[%a@] \ + FAILURE@." + Action.pp_t x ) ; c.sel <- insert_attr cursor_attr c.sel ; - F.epr "@[textedit_handler root:@ %a@]@." - pp_node n ; - F.epr "@[textedit_handler cursor:@ %a@]@." - pp_node c.sel ; Lwt.return_none | [] -> Lwt.return_some e ) , n ) ) let handler_of_node (n : node) : handler option = - F.epr "handler_of_node " ; search_forward n (fun n -> match n.t with `Attr (`Handler f, _) -> Some f | _ -> None ) @@ -1835,7 +1886,7 @@ module Panel = struct (join_x (Text.of_string "hello bitch") (Text.of_string "!\n sup daddy") ) )*) - (Text.of_string "test 1 2 3") ) ) ) + (Text.of_string "123") ) ) ) (* ) *) end end