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

ok it works now

Browse Source
This commit is contained in:
cqc
2022-03-20 13:06:06 -05:00
parent fd7db32917
commit 98e78d81ec
1 changed files with 62 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

164
human.ml
View File

@ -1295,6 +1295,9 @@ module Panel = struct
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 ()}
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 = (Image.empty, V2.zero) let empty_image = (Image.empty, V2.zero)
let empty_node () = node (`Atom `Empty) let empty_node () = node (`Atom `Empty)
let style (s : Style.t) (n : node) = node (`Attr (`Style s, n)) let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
@ -1448,13 +1451,9 @@ module Panel = struct
| `Attr (_, n) -> n | `Attr (_, n) -> n
| `Join (_, a, _) -> a | `Join (_, a, _) -> a
let join_ d (a : node) (b : node) = let join_x = join `X
set_parent_on_children let join_y = join `Y
{parent= a.parent; t= `Join (d, a, b); n= node_n ()} let join_z = join `Z
let join_x = join_ `X
let join_y = join_ `Y
let join_z = join_ `Z
let pack_x : node Lwd_utils.monoid = (empty_node (), join_x) let pack_x : node Lwd_utils.monoid = (empty_node (), join_x)
let pack_y : node Lwd_utils.monoid = (empty_node (), join_y) let pack_y : node Lwd_utils.monoid = (empty_node (), join_y)
let pack_z : node Lwd_utils.monoid = (empty_node (), join_z) let pack_z : node Lwd_utils.monoid = (empty_node (), join_z)
@ -1463,8 +1462,7 @@ module Panel = struct
let ( ^*^ ) = join_z let ( ^*^ ) = join_z
let append_ d (l : node -> node) (a : node) : node -> node = let append_ d (l : node -> node) (a : node) : node -> node =
F.epr "append_%a@." pp_dir d ; fun n -> l (join d a n)
fun n -> l (join_ d a n)
let empty_append = Fun.id let empty_append = Fun.id
let append_x = append_ `X let append_x = append_ `X
@ -1480,82 +1478,49 @@ module Panel = struct
*) *)
module Text = struct module Text = struct
let rec _of_string let rec decode dec (l : 'a) :
(segmenter : 'a * [< `Await | `End | `Uchar of Uchar.t] =
'a match Uutf.decode dec with
-> [`Uchar of Uchar.t | `Await | `End] | `Malformed b ->
-> 'a * [`Uchar of Uchar.t | `Await | `End] ) dec (ly, lx) F.epr "Text.dec (Uutf.decode uudec)=`Malformed \"%s\"@."
= (String.escaped b) ;
F.epr "_of_string@." ; decode dec (append_x l (of_string (String.escaped b)))
let rec segment aa ll = | (`Await | `End | `Uchar _) as s -> (l, s)
F.epr "segment %s -> "
( match aa with and _of_string dec l =
| `Await -> "`Await" match decode dec l with
| `End -> "`End" | l, `End -> l (atom (`Boundary `Text))
| `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ; | l, `Uchar c -> _of_string dec (append_x l (atom (`Uchar c)))
match segmenter ll aa with | l, _ -> _of_string dec l
| (ly', lx'), `Await -> (
F.epr "`Await -> decode@." ;
match Uutf.decode dec with
| `Malformed b ->
F.epr
"Text.dec (Uutf.decode uudec)=`Malformed \"%s\"@."
(String.escaped b) ;
_of_string segmenter dec
(ly', append_x lx' (of_string (String.escaped b)))
| (`End | `Await | `Uchar _) as a -> segment a (lx', ly')
)
| (ly', lx'), `Uchar c ->
F.epr "`Uchar U+%04x -> `Await@." (Uchar.to_int c) ;
segment `Await
(ly', append_x lx' (node (`Atom (`Uchar c))))
| (ly', lx'), `End ->
F.epr "`End ;@." ;
append_y ly' (lx' (node (`Atom (`Boundary `Text))))
in
let r = segment `Await (ly, lx) in
F.epr "@." ; r
and of_string str = and of_string str =
(_of_string _of_string
(fun l s -> (Uutf.decoder
F.epr "segmenter[of_string] %s -> " ~nln:(`Readline (Uchar.of_int 0x000A))
( match s with (`String str) )
| `Await -> "`Await" empty_append
| `End -> "`End"
| `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ;
(l, s) )
(Uutf.decoder
~nln:(`Readline (Uchar.of_int 0x000A))
(`String str) )
(empty_append, empty_append) )
(node (`Atom (`Boundary `Text)))
and lines str = and _lines u d ly (lx, s) =
let rec line_seg u (ly, lx) s = match Uuseg.add u s with
F.epr "line_seg %s -> " | `Boundary when Uuseg.mandatory u ->
( match s with _lines u d
| `Await -> "`Await" (append_y ly (lx (atom (`Boundary `Line))))
| `End -> "`End" (empty_append, `Await)
| `Uchar c -> F.str "`Uchar U+%x" (Uchar.to_int c) ) ; | `Boundary ->
match Uuseg.add u s with _lines u d ly (append_x lx (atom (`Hint `Line)), `Await)
| (`End | `Await | `Uchar _) as s' -> ((lx, ly), s') | `End -> ly (lx (atom (`Boundary `Text)))
| `Boundary when Uuseg.mandatory u -> | `Await -> _lines u d ly (decode d lx)
line_seg u | `Uchar c ->
( append_y ly (lx (node (`Atom (`Boundary `Line)))) _lines u d ly (append_x lx (atom (`Uchar c)), `Await)
, empty_append )
`Await let lines str =
| `Boundary -> _lines
line_seg u (Uuseg.create `Line_break)
(ly, append_x lx (node (`Atom (`Hint `Line)))) (Uutf.decoder
`Await in ~nln:(`Readline (Uchar.of_int 0x000A))
(_of_string (`String str) )
(line_seg (Uuseg.create `Line_break)) empty_append
(Uutf.decoder (empty_append, `Await)
~nln:(`Readline (Uchar.of_int 0x000A))
(`String str) )
(empty_append, empty_append) )
(node (`Atom (`Boundary `Text)))
end end
let text = Text.lines let text = Text.lines
@ -1856,19 +1821,15 @@ module Panel = struct
match Key.Bind.resolve_events bind [e] with match Key.Bind.resolve_events bind [e] with
| x :: _ -> | x :: _ ->
c.sel <- remove_attr c.sel ; c.sel <- remove_attr c.sel ;
F.epr (*F.epr
"textedit_handler c.root=@.@[%a@]@.c.sel=%a@." "textedit_handler c.sel.n=%d@ c.root=@ @[%a@]@."
pp_node_structure c.root pp_node c.sel ; pp_node_n c.sel pp_node_structure c.root ; *)
( match perform_action x c with ( match perform_action x c with
| Some _ -> | Some _ ->
F.epr F.epr "textedit action @[%a@] Success@."
"textedit_handler perform_action @[%a@] \
success@."
Action.pp_t x Action.pp_t x
| None -> | None ->
F.epr F.epr "textedit action @[%a@] Failure@."
"textedit_handler perform_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 ;
Lwt.return_none Lwt.return_none
@ -1913,17 +1874,16 @@ module Panel = struct
(Lwd.pure (Lwd.pure
(textedit_handler (textedit_handler
(style Style.dark (style Style.dark
(* (join_y (join_y
(join_y (join_y
(Text.of_string (Text.of_string
"-- welcome to my land of idiocy ---" ) "-- welcome to my land of idiocy ---" )
( ( Text.of_string "hello bitch" ( ( Text.of_string "hello bitch"
^^ Text.of_string "!\n sup daddy" ) ^^ Text.of_string "!\n sup daddy" )
^/^ (text "hello bitch" ^^ text "!\n sup daddy") ^/^ (text "hello bitch" ^^ text "!\n sup daddy")
^/^ text "hello bitch" ^/^ text "!\n sup daddy" ^/^ text "hello bitch" ^/^ text "!\n sup daddy"
) ) *) ) )
(Text.of_string "123") (Text.of_string "123") ) ) ) )
(* )p *) ) ) )
end end
end end