From 65aa7ff9014f1d8184ae138c4b6f2a6d519b21ee Mon Sep 17 00:00:00 2001 From: cqc Date: Sat, 3 Sep 2022 15:20:22 -0500 Subject: [PATCH] character insertion --- human.ml | 127 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 74 insertions(+), 53 deletions(-) diff --git a/human.ml b/human.ml index 9105b6b..8cc2724 100644 --- a/human.ml +++ b/human.ml @@ -361,16 +361,14 @@ module Display = struct (Box2.oy b) (Box2.maxx b) (Box2.maxy b) let fill_box vg color b = + let module Path = NVG.Path in let open NVG in Path.begin_ vg ; Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) ~h:(Box2.h b) ; set_fill_color vg ~color ; - fill vg - - let draw_filled_box c (s : state) = - fill_box s.renderer c s.box ; - (s, s.box) + fill vg ; + Box2.max b let path_box vg color ?(width = 0.) b = let module Path = NVG.Path in @@ -565,6 +563,12 @@ module Panel = struct and style = Style.t and handler = node -> Event.t -> Event.t option + 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 _ -> () @@ -574,11 +578,27 @@ module Panel = struct b.parent <- Some n ) ; n - let node_count = ref 0 + let sub (n : node) : node = + match n.t with + | `Atom _ -> n + | `Attr (_, n) -> n + | `Join (_, a, _) -> a - let node_n () = - node_count := !node_count + 1 ; - !node_count - 1 + let super (n : node) : node = + match n.parent with Some n' -> n' | None -> n + + let set_children_on_parent ~oldc ~newc = + match newc.parent with + | Some ({t= `Attr (a, _); _} as s) -> + s.t <- `Attr (a, newc) ; + newc + | Some ({t= `Join (d, a, b); _} as s) when oldc == a -> + s.t <- `Join (d, newc, b) ; + newc + | Some ({t= `Join (d, a, b); _} as s) when oldc == b -> + s.t <- `Join (d, a, newc) ; + newc + | _ -> newc let node (t : t) = set_parent_on_children {parent= None; t; n= node_n ()} @@ -705,20 +725,17 @@ module Panel = struct 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 ; - ( match p 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 ) - | None -> () ) ; - n' + set_children_on_parent ~oldc:n ~newc:n' let remove_attr (n : node) : node = match n.t with @@ -736,12 +753,6 @@ module Panel = struct n' | _ -> assert false - let sub (n : node) : node = - match n.t with - | `Atom _ -> n - | `Attr (_, n) -> n - | `Join (_, a, _) -> a - let join_x = join `X let join_y = join `Y let join_z = join `Z @@ -757,14 +768,6 @@ module Panel = struct let append_y = append_ `Y let append_z = append_ `Z - (* 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. - I'm STONED, so i'm not making sense, but i'm gonna carry on anyway and see what happens. - So i think what is really happening is that i'm defining the `list` for this node type that allows `append`. - The main problem with this thought is that you can't do anything but append with the datastructure. - *) - module Text = struct let rec decode dec (l : 'a) : 'a * [< `Await | `End | `Uchar of Uchar.t] = @@ -874,7 +877,7 @@ module Panel = struct and attr t b ((a : attr), n) : P2.t = match a with | `Style s -> - Display.path_box t.vg s.bg + Display.fill_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 @@ -907,10 +910,10 @@ module Panel = struct | `Atom a -> atom t b a | `Attr a -> attr t b a | `Join a -> join t 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 + (Display.path_box t.vg + (Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) + (Box2.of_pts b b') ) ;*) b' end @@ -923,6 +926,8 @@ module Panel = struct and t = [ `Move of segment + | `Insert of node + | `Overwrite of node | `Yank of segment | `Kill of segment | `Ascend @@ -969,6 +974,8 @@ module Panel = struct let pp_t ppf v = ( match v with | `Move s -> any "`Move " ++ const pp_segment s + | `Insert n -> any "`Insert " ++ const pp_node n + | `Overwrite n -> any "`Overwrite " ++ const pp_node n | `Yank s -> any "`Yank " ++ const pp_segment s | `Kill s -> any "`Kill " ++ const pp_segment s | `Ascend -> any "`Ascend" @@ -1014,14 +1021,14 @@ module Panel = struct if i <> 0 then tree_iter f (f n) (i - 1) else f n let rec search_ next f n = - F.epr "search_ " ; + (* 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) + (* 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) @@ -1103,6 +1110,10 @@ module Panel = struct (* uses last searched node regardless of match *) Some (tree_uchar_back (fst (search_ tree_next (mb b) c.sel))) + | `Insert n -> + ignore (insert_join_r `X (super c.sel) n) ; + Some c.sel + | `Overwrite _s -> None | `Yank _s -> None | `Kill _s -> None | `Descend -> Some (sub c.sel) @@ -1157,9 +1168,18 @@ module Panel = struct `Attr ( `Handler (fun (_ : node) (e : Event.t) : Event.t option -> - Fmt.epr "textedit_handler@." ; - match Key.Bind.resolve_events bind [e] with - | x :: _ -> + let a = + match Key.Bind.resolve_events bind [e] with + | x :: _ -> Some x + | [] -> ( + match e with + | `Key (`Press, (k : Key.keystate)) -> ( + match k.code with + | `Uchar c -> Some (`Insert (atom (`Uchar c))) + | _ -> None ) + | _ -> None ) in + match a with + | Some x -> c.sel <- remove_attr c.sel ; ( match perform_action x c with | Some n' -> @@ -1170,8 +1190,9 @@ 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 - | [] -> Some e ) + | None -> None ) , n ) ; set_parent_on_children c.root @@ -1182,7 +1203,6 @@ module Panel = struct match f n with Some a -> Some a | None -> search_forward f n let handle_event (n : node) (ev : Event.t) : event_status = - Fmt.epr "handle_event@." ; match handler_of_node n with | Some f -> ( match f n ev with Some ev -> `Event ev | None -> `Handled ) @@ -1200,10 +1220,11 @@ module Panel = struct textedit (style Style.dark Text.( - text "--- welcome to my land of idiocy ---" - ^/^ (text "hello bitch" ^^ text "! sup daddy" ^^ nl) - ^/^ lines "hello bitch" ^/^ lines "! sup daddy" - ^/^ lines "123") ) + (* text "--- welcome to my land of idiocy ---" + ^/^ *) + text "hello bitch" + (*^^ text "! sup daddy" ^^ nl) + ^/^ lines "123")*)) ) end end