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

Action.pp_t and cleanup

Browse Source
This commit is contained in:
cqc
2022-03-19 15:14:23 -05:00
parent 8067e29ea8
commit 205f650eac
1 changed files with 101 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

149
human.ml
View File

@ -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 "@[<hov>%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 "@[<hov>%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,6 +1810,7 @@ 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
"@[<hv>F.stderr margin: %d, max_indent: %d, max_boxes: %d \
@ -1763,34 +1818,30 @@ module Panel = struct
(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 "@[<v>textedit_handler root:@ %a@]@."
pp_node n ;
F.epr "@[<v>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