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

126
human.ml
View File

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