console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

character insertion

Browse Source
This commit is contained in:
cqc
2022-09-03 15:20:22 -05:00
parent 39193ff253
commit 65aa7ff901
1 changed files with 74 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

127
human.ml
View File

@ -361,16 +361,14 @@ module Display = struct
(Box2.oy b) (Box2.maxx b) (Box2.maxy b) (Box2.oy b) (Box2.maxx b) (Box2.maxy b)
let fill_box vg color b = let fill_box vg color b =
let module Path = NVG.Path in
let open NVG in let open NVG in
Path.begin_ vg ; Path.begin_ vg ;
Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) Path.rect vg ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b)
~h:(Box2.h b) ; ~h:(Box2.h b) ;
set_fill_color vg ~color ; set_fill_color vg ~color ;
fill vg fill vg ;
Box2.max b
let draw_filled_box c (s : state) =
fill_box s.renderer c s.box ;
(s, s.box)
let path_box vg color ?(width = 0.) b = let path_box vg color ?(width = 0.) b =
let module Path = NVG.Path in let module Path = NVG.Path in
@ -565,6 +563,12 @@ module Panel = struct
and style = Style.t and style = Style.t
and handler = node -> Event.t -> Event.t option 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 = let set_parent_on_children n : node =
( match n.t with ( match n.t with
| `Atom _ -> () | `Atom _ -> ()
@ -574,11 +578,27 @@ module Panel = struct
b.parent <- Some n ) ; b.parent <- Some n ) ;
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 () = let super (n : node) : node =
node_count := !node_count + 1 ; match n.parent with Some n' -> n' | None -> n
!node_count - 1
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) = let node (t : t) =
set_parent_on_children {parent= None; t; n= node_n ()} 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 traverse_nodes ~f a ; traverse_nodes ~f b
| None -> () | 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 insert_attr (a : attr) (n : node) : node =
let p = n.parent in let p = n.parent in
let n' = node (`Attr (a, n)) in let n' = node (`Attr (a, n)) in
n'.parent <- p ; n'.parent <- p ;
( match p with set_children_on_parent ~oldc:n ~newc:n'
| 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'
let remove_attr (n : node) : node = let remove_attr (n : node) : node =
match n.t with match n.t with
@ -736,12 +753,6 @@ module Panel = struct
n' n'
| _ -> assert false | _ -> 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_x = join `X
let join_y = join `Y let join_y = join `Y
let join_z = join `Z let join_z = join `Z
@ -757,14 +768,6 @@ module Panel = struct
let append_y = append_ `Y let append_y = append_ `Y
let append_z = append_ `Z 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 module Text = struct
let rec decode dec (l : 'a) : let rec decode dec (l : 'a) :
'a * [< `Await | `End | `Uchar of Uchar.t] = 'a * [< `Await | `End | `Uchar of Uchar.t] =
@ -874,7 +877,7 @@ module Panel = struct
and attr t b ((a : attr), n) : P2.t = and attr t b ((a : attr), n) : P2.t =
match a with match a with
| `Style s -> | `Style s ->
Display.path_box t.vg s.bg Display.fill_box t.vg s.bg
(Box2.of_pts b (Box2.of_pts b
(node {t with style= Style.merge t.style s} b n) ) (node {t with style= Style.merge t.style s} b n) )
| `Pad p -> pad t b p n | `Pad p -> pad t b p n
@ -907,10 +910,10 @@ module Panel = struct
| `Atom a -> atom t b a | `Atom a -> atom t b a
| `Attr a -> attr t b a | `Attr a -> attr t b a
| `Join a -> join t b a in | `Join a -> join t b a in
ignore (* ignore
(Display.path_box t.vg (Display.path_box t.vg
(Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) (Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
(Box2.of_pts b b') ) ; (Box2.of_pts b b') ) ;*)
b' b'
end end
@ -923,6 +926,8 @@ module Panel = struct
and t = and t =
[ `Move of segment [ `Move of segment
| `Insert of node
| `Overwrite of node
| `Yank of segment | `Yank of segment
| `Kill of segment | `Kill of segment
| `Ascend | `Ascend
@ -969,6 +974,8 @@ module Panel = struct
let pp_t ppf v = let pp_t ppf v =
( match v with ( match v with
| `Move s -> any "`Move " ++ const pp_segment s | `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 | `Yank s -> any "`Yank " ++ const pp_segment s
| `Kill s -> any "`Kill " ++ const pp_segment s | `Kill s -> any "`Kill " ++ const pp_segment s
| `Ascend -> any "`Ascend" | `Ascend -> any "`Ascend"
@ -1014,14 +1021,14 @@ module Panel = struct
if i <> 0 then tree_iter f (f n) (i - 1) else f n if i <> 0 then tree_iter f (f n) (i - 1) else f n
let rec search_ next f n = let rec search_ next f n =
F.epr "search_ " ; (* F.epr "search_ " ; *)
match next n with match next n with
| Some n' -> ( | Some n' -> (
F.epr "%a@." pp_n n' ; (* F.epr "%a@." pp_n n' ; *)
match f n' with match f n' with
| Some a -> (n', Some a) | Some a -> (n', Some a)
| None -> search_ next f n' ) | None -> search_ next f n' )
| None -> F.epr "None@." ; (n, None) | None -> (*F.epr "None@." ; *) (n, None)
let search_forward f (n : node) = snd (search_ tree_next f n) 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 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 *) (* uses last searched node regardless of match *)
Some Some
(tree_uchar_back (fst (search_ tree_next (mb b) c.sel))) (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 | `Yank _s -> None
| `Kill _s -> None | `Kill _s -> None
| `Descend -> Some (sub c.sel) | `Descend -> Some (sub c.sel)
@ -1157,9 +1168,18 @@ module Panel = struct
`Attr `Attr
( `Handler ( `Handler
(fun (_ : node) (e : Event.t) : Event.t option -> (fun (_ : node) (e : Event.t) : Event.t option ->
Fmt.epr "textedit_handler@." ; let a =
match Key.Bind.resolve_events bind [e] with match Key.Bind.resolve_events bind [e] with
| x :: _ -> | 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 ; c.sel <- remove_attr c.sel ;
( match perform_action x c with ( match perform_action x c with
| Some n' -> | Some n' ->
@ -1170,8 +1190,9 @@ module Panel = struct
F.epr "textedit action @[%a@] Failure@." F.epr "textedit action @[%a@] Failure@."
Action.pp_t x ) ; Action.pp_t x ) ;
c.sel <- insert_attr cursor_attr c.sel ; c.sel <- insert_attr cursor_attr c.sel ;
F.epr "tree: @[%a@]@." Pp.pp_node_structure c.root ;
None None
| [] -> Some e ) | None -> None )
, n ) ; , n ) ;
set_parent_on_children c.root 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 match f n with Some a -> Some a | None -> search_forward f n
let handle_event (n : node) (ev : Event.t) : event_status = let handle_event (n : node) (ev : Event.t) : event_status =
Fmt.epr "handle_event@." ;
match handler_of_node n with match handler_of_node n with
| Some f -> ( | Some f -> (
match f n ev with Some ev -> `Event ev | None -> `Handled ) match f n ev with Some ev -> `Event ev | None -> `Handled )
@ -1200,10 +1220,11 @@ module Panel = struct
textedit textedit
(style Style.dark (style Style.dark
Text.( Text.(
text "--- welcome to my land of idiocy ---" (* text "--- welcome to my land of idiocy ---"
^/^ (text "hello bitch" ^^ text "! sup daddy" ^^ nl) ^/^ *)
^/^ lines "hello bitch" ^/^ lines "! sup daddy" text "hello bitch"
^/^ lines "123") ) (*^^ text "! sup daddy" ^^ nl)
^/^ lines "123")*)) )
end end
end end