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

whoa

Browse Source
This commit is contained in:
cqc
2024-07-28 15:58:37 -05:00
parent f8525ac35f
commit c604345886
2 changed files with 132 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

150
ogui.ml
View File

@ -722,7 +722,7 @@ module Ui = struct
enabled : bool; enabled : bool;
gv : Gv.t; gv : Gv.t;
glfw_window : GLFW.window option; glfw_window : GLFW.window option;
bindings : (int * action list Event.resolver) Lwd.var; mutable bindings : action list Event.resolver Lwd.t;
} }
and action = Custom of string * (unit -> unit Lwt.t) and action = Custom of string * (unit -> unit Lwt.t)
@ -739,10 +739,7 @@ module Ui = struct
enabled = true; enabled = true;
gv; gv;
glfw_window = window; glfw_window = window;
bindings = bindings = Lwd.pure Event.[ pack Fun.id empty ];
Lwd.var
~eq:(fun (a, _) (b, _) -> a = b)
(0, Event.[ pack Fun.id empty ]);
} }
let pp_action : action F.t = let pp_action : action F.t =
@ -761,14 +758,35 @@ module Ui = struct
|> ignore) |> ignore)
p () p ()
let pp_pack : action list Event.pack F.t =
fun ppf p ->
let open Event in
let rec iter (prev : Event.event list)
(p : action list Event.pack) : unit =
let module Pack = (val p) in
match EventMap.bindings Pack.set with
| (event, node) :: rest ->
(match node with
| Set set -> iter (prev @ [ event ]) (pack Pack.map set)
| Val action ->
F.pf ppf "%a: %a@."
F.(list pp_action)
(Pack.map action)
F.(brackets @@ list ~sep:semi pp_event)
(prev @ [ event ]));
iter prev (pack Pack.map (EventMap.of_list rest))
| [] -> ()
in
iter [] p
let process_key t (resolver : action list Event.result) let process_key t (resolver : action list Event.result)
(state : Event.key_action) (key : Event.key) (state : Event.key_action) (key : Event.key)
(mods : Event.key_mod list) : action list Event.result Lwt.t = (mods : Event.key_mod list) : action list Event.result Lwt.t =
let res = let res =
match resolver with match resolver with
| Event.Rejected | Event.Accepted _ -> | Event.Rejected | Event.Accepted _ ->
t.bindings |> Lwd.get |> Lwd.observe |> Lwd.quick_sample t.bindings |> Lwd.observe |> Lwd.quick_sample
|> snd
| Event.Continue r -> r | Event.Continue r -> r
in in
let res = Event.resolve (Key (state, key, mods)) res in let res = Event.resolve (Key (state, key, mods)) res in
@ -783,13 +801,9 @@ module Ui = struct
| Event.Continue _ | Event.Rejected -> Lwt.return_unit) | Event.Continue _ | Event.Rejected -> Lwt.return_unit)
>>= fun () -> Lwt.return res >>= fun () -> Lwt.return res
let append_bindings ui (f : action list Event.resolver) = let append_bindings ui (b : action list Event.resolver Lwd.t) : unit
Lwd.set ui.bindings =
( Lwd.peek ui.bindings |> fst |> Int.add 1, ui.bindings <- Lwd.map2 ~f:List.append ui.bindings b
List.append f (Lwd.peek ui.bindings |> snd) )
let reset_bindings ui =
Lwd.set ui.bindings (Lwd.peek ui.bindings |> fst |> Int.add 1, [])
let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref = let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref =
ref (fun _c -> ref (fun _c ->
@ -1192,7 +1206,7 @@ module TextEdit = struct
(* return_key = keyboard_shortcut; *) (* return_key = keyboard_shortcut; *)
} }
in in
Ui.append_bindings ui [ default_bindings t ]; Ui.append_bindings ui (Lwd.pure [ default_bindings t ]);
t t
end end
@ -1405,7 +1419,7 @@ module WindowManager = struct
~size:(`Ratio 1.0, `Pixels 30.) ~size:(`Ratio 1.0, `Pixels 30.)
(F.str "window/%d" n, status_format (n == cursor)))) (F.str "window/%d" n, status_format (n == cursor))))
let frame_default_bindings ui f = Event.empty |> Event.pack Fun.id let frame_default_bindings _ui _f = Event.empty |> Event.pack Fun.id
let default_bindings ui = function let default_bindings ui = function
| `TextEdit t -> [ TextEdit.default_bindings t ] | `TextEdit t -> [ TextEdit.default_bindings t ]
@ -1413,57 +1427,69 @@ module WindowManager = struct
let make ui ?(style = textedit_style) let make ui ?(style = textedit_style)
?(_mode : [ `Tiling | `FullScreen | `Floating ] = `Tiling) ?(_mode : [ `Tiling | `FullScreen | `Floating ] = `Tiling)
(telist : t Lwd.var) = (t : t Lwd.var) =
let cursor = Lwd.var 0 in let cursor = Lwd.var 0 in
Ui.update_bindings ui (fun a -> (* add the bindings of the currently selected window *)
a Ui.append_bindings ui
|> Event.adds (Lwd.map2 (Lwd.get cursor) (Lwd.get t) ~f:nth
[ [ Key (Press, X, [ Control ]); Key (Press, O, []) ] ] |> Lwd.map ~f:(function
[ | Some v -> default_bindings ui v
Ui.Custom | None -> []));
( "window_next", Ui.append_bindings ui
fun () -> (Lwd.return
Lwd.set cursor Event.
(if [
Lwd.peek cursor empty
< (Lwd.peek telist |> length) - 1 |> adds
then Lwd.peek cursor + 1 [
else 0); [
default_bindings Key (Press, X, [ Control ]); Key (Press, O, []);
(nth (Lwd.peek cursor) (Lwd.peek telist)) ];
ui; ]
Lwt.return_unit ); Lwd.
] [
|> Event.adds Ui.Custom
[ [ Key (Press, X, [ Control ]); Key (Press, P, []) ] ] ( "window_next",
[ fun () ->
Ui.Custom set cursor
( "window_previous", (if peek cursor < (peek t |> length) - 1
fun () -> then peek cursor + 1
Lwd.set cursor else 0);
(if Lwd.peek cursor > 0 then Lwt.return_unit );
Lwd.peek cursor - 1 ]
else (Lwd.peek telist |> length) - 1); |> adds
(*TextEdit.default_bindings [
(List.nth (Lwd.peek telist) (Lwd.peek cursor)) [
ui;*) Key (Press, X, [ Control ]); Key (Press, P, []);
Lwt.return_unit ); ];
]); ]
Lwd.
[
Ui.Custom
( "window_previous",
fun () ->
set cursor
(if peek cursor > 0 then peek cursor - 1
else (peek t |> length) - 1);
Lwt.return_unit );
]
|> pack Fun.id;
]);
Lwd.map_s (Lwd.get telist) ~f:(fun (tl : t) -> Lwd.map_s (Lwd.get t) ~f:(fun (t : t) ->
let rec fold dir dim : t -> Layout.frame Lwd.t Lwt.t = let rec fold dir (t : tt) : Layout.frame Lwd.t Lwt.t =
let size = let size =
match dir with match dir with
| `X -> (dim, `Ratio 1.) | `X -> (t.dim, `Ratio 1.)
| `Y -> (`Ratio 1., dim) | `Y -> (`Ratio 1., t.dim)
| `Z -> (dim, dim) | `Z -> (t.dim, t.dim)
in in
function match t.t with
| `T ((dir', (t0, dim0) :: trest) as tl) -> | `T (dir', t0 :: trest) ->
fold dir' dim0 t0 >>= fun fst -> fold dir' t0 >>= fun fst ->
Lwt_list.fold_left_s Lwt_list.fold_left_s
(fun f (t, dim) -> (fun f t ->
fold dir' dim t >>= fun newf -> fold dir' t >>= fun newf ->
Lwd.map2 f newf ~f:(join ~size dir') |> Lwt.return) Lwd.map2 f newf ~f:(join ~size dir') |> Lwt.return)
fst trest fst trest
| `T (_, []) -> Layout.none |> Lwd.return |> Lwt.return | `T (_, []) -> Layout.none |> Lwd.return |> Lwt.return
@ -1477,7 +1503,7 @@ module WindowManager = struct
>>= fun tt -> >>= fun tt ->
frame_of_window 314 cursor style size tt |> Lwt.return frame_of_window 314 cursor style size tt |> Lwt.return
in in
fold `X (`Ratio 1.) tl) fold `X { t; dim = `Ratio 1.; bindings = [] })
>>= fun d -> Lwd.join d |> Lwt.return >>= fun d -> Lwd.join d |> Lwt.return
end end

73
oplevel.ml
View File

@ -152,43 +152,58 @@ let main =
(String "#use \"topfind\";;\n#list;;#require \"lwt\";;")); *) (String "#use \"topfind\";;\n#list;;#require \"lwt\";;")); *)
(* toplevel execution binding *) (* toplevel execution binding *)
Ui.( Ui.(
update_bindings ui append_bindings ui
Event.( (Lwd.return
fun a -> Event.
a [
|> adds pack Fun.id
[ (empty
[ |> adds
Key (Press, X, [ Control ]); [
Key (Press, E, [ Control ]); [
]; Key (Press, X, [ Control ]);
] Key (Press, E, [ Control ]);
[ ];
Custom ]
( "toplevel_execute", [
fun () -> Custom
TextBuffer.peek tb_init >>= fun _str -> ( "toplevel_execute",
(*Toploop.use_input out_ppf (String str) fun () ->
|> F.epr "Toploop.use_input=%b@."; *) TextBuffer.peek tb_init >>= fun _str ->
Lwt.return_unit ); (*Toploop.use_input out_ppf (String str)
])); |> F.epr "Toploop.use_input=%b@."; *)
Lwt.return_unit );
]);
]));
WindowManager.make ui WindowManager.make ui
(Lwd.var (Lwd.var
(`T (`T
( `Y, ( `Y,
[ WindowManager.
(`TextEdit (TextEdit.multiline ui to_init), `Ratio 0.333); [
(`TextEdit (TextEdit.multiline ui tb_init), `Ratio 0.5); {
(`TextEdit (TextEdit.multiline ui to_init), `Ratio 1.0); t = `TextEdit (TextEdit.multiline ui to_init);
] ))) dim = `Ratio 0.333;
bindings = [];
};
{
t = `TextEdit (TextEdit.multiline ui tb_init);
dim = `Ratio 0.5;
bindings = [];
};
{
t = `TextEdit (TextEdit.multiline ui to_init);
dim = `Ratio 1.0;
bindings = [];
};
] )))
>>= fun page -> >>= fun page ->
let page_root = Lwd.observe page in let page_root = Lwd.observe page in
let bindings = let bindings = ui.bindings |> Lwd.observe |> Lwd.quick_sample in
ui.bindings |> Lwd.get |> Lwd.observe |> Lwd.quick_sample |> snd F.epr "Bindings:@.";
in List.iter (fun bs -> F.epr "%a" Ui.pp_pack bs) bindings;
F.epr "Bindings:@.%a" Ui.pp_bindings bindings;
F.pr "oplevel.ml: entering drawing loop@."; F.pr "oplevel.ml: entering drawing loop@.";
let period_min = 1.0 /. 30. in let period_min = 1.0 /. 30. in