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

urgh... stuck with how to implement cursor/focus etc. Decided to try to integrate Nottui and Nottui_widgets directly istead of reinventing another wheel.

Browse Source
This commit is contained in:
cqc
2022-12-04 12:25:00 -06:00
parent b5d846b35d
commit 49bddb6365
2 changed files with 170 additions and 209 deletions
Download Patch File Download Diff File Expand all files Collapse all files

260
human.ml
View File

@ -1,10 +1,11 @@
(*
names?:
- universal tool, unitool [was thinking about how this is trying to unify a lot of my "tools for thought"]
* because it has always bothered me that it's easier to use google search as a calculator than the purpose built app!!!!!!!!
- universal console, unicon (UNICOrN) [unicon is nice ;3]
- non-magical systems (NMS) un-magical
- console is an interface to allow you to program your computer more easily.
describe exactly every case you can think of that you want this drawing and layout system to handle:
@ -984,7 +985,7 @@ module Panel = struct
open Gg
type draw_context = { vg : NVG.t; style : Style.t }
type draw_context = { vg : NVG.t; style : Style.t; time : float }
and draw = draw_context -> Gg.p2 -> Gg.p2
module Page = struct
@ -994,7 +995,6 @@ module Panel = struct
and step = [ `Next | `Left | `Right ]
and path = step list
and cursor = { path : path; root : t }
and atom =
[ (*`Lwd of t
@ -1019,13 +1019,15 @@ module Panel = struct
[ `Char | `Word | `Phrase | `Line | `Page | `Text ]
and style = Style.t
and handler = t -> Event.t -> Event.t option
and handler = t -> Event.t -> t
let sub_left = function
| `Atom _ as n -> n
| `Attr (_, n) -> n
| `Join (_, a, _) -> a
let sub = sub_left
let sub_right = function
| `Atom _ as n -> n
| `Attr (_, n) -> n
@ -1178,12 +1180,10 @@ module Panel = struct
encode `End;
let text = Bytes.to_string (Buffer.to_bytes b) in
let open NVG in
let bounds = Text.bounds vg ~x:(V2.x t) ~y:(V2.y t) text in
let metrics = Text.metrics vg in
let x, y = (V2.x t, V2.y t +. metrics.ascender) in
Text.text vg ~x ~y text;
P2.v
(P2.x t +. bounds.advance)
let twidth = Text.text_w vg ~x ~y text in
P2.v twidth
(P2.y t +. metrics.ascender +. metrics.descender
+. metrics.line_height)
@ -1245,10 +1245,10 @@ module Panel = struct
| `Attr a -> attr vg b a
| `Join a -> join vg b a
in
ignore
(path_box vg.vg
(NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
(Box2.of_pts b b'));
(* ignore
(path_box vg.vg
(NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
(Box2.of_pts b b')); *)
b'
end
@ -1292,7 +1292,6 @@ module Panel = struct
| `Style _ -> "`Style"
| `Pad _ -> "`Pad"
| `Shift _ -> "`Shift"
| `Cursor -> "`Cursor"
| `Handler _ -> "`Handler"
| `Draw _ -> "`Draw"))
ppf ()
@ -1351,9 +1350,14 @@ module Panel = struct
type node = Page.t
type t = node Lwd.t
type path = Page.path Lwd.t
type cursor = { path : Page.path Lwd.var; root : node Lwd.var }
let empty = Lwd.pure Page.empty
let pad v = Lwd.map ~f:(Page.pad v)
let attr a n = Lwd.map ~f:(Page.attr a) n
let handler f (n : t) : t = attr (`Handler f) n
let atom a = Lwd.map ~f:Page.atom a
let join d = Lwd.map2 ~f:(Page.join d)
let join_x, join_y, join_z = (join `X, join `Y, join `Z)
let ( ^^ ) = join_x
@ -1377,8 +1381,8 @@ module Panel = struct
and t =
[ `Move of segment
| `Insert of t
| `Overwrite of t
| `Insert of node
| `Overwrite of node
| `Yank of segment
| `Kill of segment
| `Ascend
@ -1436,31 +1440,30 @@ module Panel = struct
ppf ()
end
let perform_action (a : Action.t) ({ path; root } : Page.cursor) :
let perform_action (a : Action.t) (path : path) (node : node) :
node option =
match a with
| `Move (`Forward `Line) ->
(*
let i = ref 0 in
ignore
(search_backward
(function
| { t = `Atom (`Boundary `Line); _ } -> Some ()
| { t = `Atom (`Uchar _); _ } ->
incr i;
None
| _ -> None)
path);
match search_forward (is_boundary `Line) path with
| Some n' ->
Some
(tree_iter
(fun nn ->
Option.value
(search_forward (is_boundary `Char) nn)
~default:nn)
n' !i)
| None -> *)
(* let i = ref 0 in
ignore
(search_backward
(function
| { t = `Atom (`Boundary `Line); _ } -> Some ()
| { t = `Atom (`Uchar _); _ } ->
incr i;
None
| _ -> None)
path);
match search_forward (is_boundary `Line) path with
| Some n' ->
Some
(tree_iter
(fun nn ->
Option.value
(search_forward (is_boundary `Char) nn)
~default:nn)
n' !i)
| None -> *)
None
| `Move (`Backward `Line) ->
(* let i = ref 0 in
@ -1503,10 +1506,11 @@ module Panel = struct
(* | `Descend -> Some (sub c.sel) *)
(* | `Ascend -> option_of_parent c.sel.parent*)
| `Custom _s -> None
| _ -> None
type event_status = [ `Handled | `Event of Event.t ]
let textedit_bindings =
let default_bindings =
let open Key.Bind in
empty
|> add [ ([ Ctrl ], C 'f') ] [ `Move (`Forward `Char) ]
@ -1543,17 +1547,6 @@ module Panel = struct
let cursor_attr =
`Style Style.(bg NVG.Color.(rgbaf ~r:1. ~g:1. ~b:0. ~a:1.))
(* this was a hack?
let draw_node_structure (doc : node Lwd.var) : node =
let open Gg in
attr
(`Draw
(fun (t : draw_context) (b : P2.t) ->
Draw.node t b
(Text.lines
(Fmt.to_to_string pp_node_structure (Lwd.peek doc)))))
(atom `Empty) *)
let node_structure root =
Lwd.map
~f:(fun node ->
@ -1566,96 +1559,62 @@ module Panel = struct
Page.Text.lines (Fmt.to_to_string pp_path path))
path
let textedit ?(bindings = textedit_bindings)
(initial : node * Page.path) =
Format.pp_set_max_boxes F.stderr 64;
(*full screen fynn *)
Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230;
let doc = Lwd.var (fst initial) in
let path = Lwd.var (snd initial) in
join_y
(pad 5. (Lwd.get doc))
let nav_handler ?(bindings = default_bindings)
((page, path) : node Lwd.t * Page.path) =
let page, path = (Lwd.var page, Lwd.var path) in
let bind = Key.Bind.init bindings in
handler
(fun (root : node) (e : Event.t) : node ->
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 (Page.atom (`Uchar c)))
| _ -> None)
| _ -> None)
in
match a with
| Some x -> (
match perform_action x (Lwd.get path) root with
| Some n' ->
Log.info (fun m ->
m "nav_handler action @[%a@] Success@."
Action.pp_t x);
n'
| None ->
Log.warn (fun m ->
m "nav_handler action @[%a@] Failure@."
Action.pp_t x);
root)
| None -> root)
(join_y
(pad 5. (draw_path (Lwd.get path)))
(pad 5. (node_structure (Lwd.get doc))))
(pad 5. (Lwd.join @@ Lwd.get page))
(join_y
(pad 5. (draw_path (Lwd.get path)))
(pad 5. (node_structure (Lwd.join @@ Lwd.get page)))))
(* let bind = Key.Bind.init bindings in
let sel = insert_attr cursor_attr n in
let c = { root = attr (`Handler (fun _ _ -> None)) sel; sel } in
c.root.t <-
`Attr
( `Handler
(fun (_ : node) (e : Event.t) : Event.t option ->
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
let r =
match a with
| Some x ->
c.sel <- remove_attr c.sel;
(match perform_action x c with
| Some n' ->
F.epr "textedit action @[%a@] Success@."
Action.pp_t x;
c.sel <- n'
| None ->
F.epr "textedit action @[%a@] Failure@."
Action.pp_t x);
c.sel <- insert_attr cursor_attr c.sel;
None
| None -> None
in
r),
n );
join_y (pad 5. c.root)
(join_y
(pad 5. (draw_cursor_sel c))
(pad 5. (draw_cursor_root c))) *)
(*
let is_handler (n : node) : handler option =
let is_handler (n : node) : Page.handler option =
match n with `Attr (`Handler f, _) -> Some f | _ -> None
(** receives a node document and event and returns a node document where that event is handled *)
(* * receives a node document and event and returns a node document where that event is handled *)
let handle_event (n : t) (ev : Event.t) : t =
Lwd.map
~f:
(fold_preorder
(fun ev' n' ->
match is_handler n' with
| Some f -> f n' ev'
| None -> None)
ev)
~f:(fun t ->
let handlers =
Page.fold_preorder
(fun acc n' ->
match is_handler n' with
| Some f -> Some (f :: acc)
| None -> Some acc)
[] t
in
List.fold_left (fun acc f -> f acc ev) t handlers)
n
let panel (vg : NVG.t) (p : P2.t) (t : t) (ev : Event.t) : P2.t =
(match handle_event t ev with
| `Handled -> F.epr "Handled %s@." (Event.to_string ev)
| `Event _e ->
F.epr "Unhandled event: %s@." (Event.to_string _e));
Draw.node { vg; style = Style.dark } p t
*)
(* I feel like the Wall module from github.com/let-def/wall includes another layer on top
of the drawing functions, missing from graphv, that
specificall allows the composability and cache-ability i want, so instead of writing in from
scratch i will try to steal it.
*)
(* we need to determine how "document types" should be implemented:
* as a module that implements a common interface which allows
production of a Ui.t which is then rendered.
* this will require exposing the Ui and all drawing related functions.
*
*)
module Text = struct
let lines = Lwd.map ~f:Page.Text.lines
let of_string = Lwd.map ~f:Page.Text.of_string
@ -1705,28 +1664,33 @@ module Panel = struct
(Lwd.peek var)));
Lwd.get var
let draw (vg, p) (t : node Lwd.t) : Page.Draw.p Lwt.t =
let root =
Lwd.observe
~on_invalidate:(fun _ ->
Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
t
in
let draw (vg, p) (root : node Lwd.root) : Page.Draw.p Lwt.t =
Lwt.return (Page.Draw.node vg p (Lwd.quick_sample root))
end
open Lwt.Infix
let render_lwt (vg : NVG.t) (p : Gg.p2) (_ev : Event.t) :
Gg.p2 Lwt.t =
let t = { vg; style = Style.dark } in
(* event handler just needs to result in a Lwd.set on some portion of the doc root
and then trigger a request animation frame *)
let renderer (root : t Lwd.var) :
NVG.t -> ?time:float -> Gg.p2 -> Gg.p2 Lwt.t =
let root =
Lwd.observe
~on_invalidate:(fun _ ->
Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
(Lwd.join (Lwd.get root))
in
fun vg ?(time = 0.) p ->
View.draw ({ vg; style = Style.dark; time }, p) root
let boot_page : node Lwd.t Lwt.t =
Nav.test_pull () >>= fun tree ->
View.of_tree tree >>= fun doc ->
View.draw (t, p)
(Lwd_utils.reduce pack_y
View.of_tree tree >>= fun tv ->
Lwt.return
(vcat
[
doc.doc;
View.of_path (Lwd.peek doc.cursor);
nav_handler (tv.doc, []);
View.of_path (Lwd.peek tv.cursor);
View.list_logs Logs_reporter.hook;
])
end