From c6043458861a6d53d8f7f91cf7dfc2dd1a1be7c9 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 28 Jul 2024 15:58:37 -0500 Subject: [PATCH] whoa --- ogui.ml | 150 +++++++++++++++++++++++++++++++---------------------- oplevel.ml | 73 +++++++++++++++----------- 2 files changed, 132 insertions(+), 91 deletions(-) diff --git a/ogui.ml b/ogui.ml index 86b95d1..fda06c3 100644 --- a/ogui.ml +++ b/ogui.ml @@ -722,7 +722,7 @@ module Ui = struct enabled : bool; gv : Gv.t; 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) @@ -739,10 +739,7 @@ module Ui = struct enabled = true; gv; glfw_window = window; - bindings = - Lwd.var - ~eq:(fun (a, _) (b, _) -> a = b) - (0, Event.[ pack Fun.id empty ]); + bindings = Lwd.pure Event.[ pack Fun.id empty ]; } let pp_action : action F.t = @@ -761,14 +758,35 @@ module Ui = struct |> ignore) 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) (state : Event.key_action) (key : Event.key) (mods : Event.key_mod list) : action list Event.result Lwt.t = let res = match resolver with | Event.Rejected | Event.Accepted _ -> - t.bindings |> Lwd.get |> Lwd.observe |> Lwd.quick_sample - |> snd + t.bindings |> Lwd.observe |> Lwd.quick_sample | Event.Continue r -> r 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) >>= fun () -> Lwt.return res - let append_bindings ui (f : action list Event.resolver) = - Lwd.set ui.bindings - ( Lwd.peek ui.bindings |> fst |> Int.add 1, - 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 append_bindings ui (b : action list Event.resolver Lwd.t) : unit + = + ui.bindings <- Lwd.map2 ~f:List.append ui.bindings b let chrcallback_ref : (Uchar.t -> unit Lwt.t) ref = ref (fun _c -> @@ -1192,7 +1206,7 @@ module TextEdit = struct (* return_key = keyboard_shortcut; *) } in - Ui.append_bindings ui [ default_bindings t ]; + Ui.append_bindings ui (Lwd.pure [ default_bindings t ]); t end @@ -1405,7 +1419,7 @@ module WindowManager = struct ~size:(`Ratio 1.0, `Pixels 30.) (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 | `TextEdit t -> [ TextEdit.default_bindings t ] @@ -1413,57 +1427,69 @@ module WindowManager = struct let make ui ?(style = textedit_style) ?(_mode : [ `Tiling | `FullScreen | `Floating ] = `Tiling) - (telist : t Lwd.var) = + (t : t Lwd.var) = let cursor = Lwd.var 0 in - Ui.update_bindings ui (fun a -> - a - |> Event.adds - [ [ Key (Press, X, [ Control ]); Key (Press, O, []) ] ] - [ - Ui.Custom - ( "window_next", - fun () -> - Lwd.set cursor - (if - Lwd.peek cursor - < (Lwd.peek telist |> length) - 1 - then Lwd.peek cursor + 1 - else 0); - default_bindings - (nth (Lwd.peek cursor) (Lwd.peek telist)) - ui; - Lwt.return_unit ); - ] - |> Event.adds - [ [ Key (Press, X, [ Control ]); Key (Press, P, []) ] ] - [ - Ui.Custom - ( "window_previous", - fun () -> - Lwd.set cursor - (if Lwd.peek cursor > 0 then - Lwd.peek cursor - 1 - else (Lwd.peek telist |> length) - 1); - (*TextEdit.default_bindings - (List.nth (Lwd.peek telist) (Lwd.peek cursor)) - ui;*) - Lwt.return_unit ); - ]); + (* add the bindings of the currently selected window *) + Ui.append_bindings ui + (Lwd.map2 (Lwd.get cursor) (Lwd.get t) ~f:nth + |> Lwd.map ~f:(function + | Some v -> default_bindings ui v + | None -> [])); + Ui.append_bindings ui + (Lwd.return + Event. + [ + empty + |> adds + [ + [ + Key (Press, X, [ Control ]); Key (Press, O, []); + ]; + ] + Lwd. + [ + Ui.Custom + ( "window_next", + fun () -> + set cursor + (if peek cursor < (peek t |> length) - 1 + then peek cursor + 1 + else 0); + Lwt.return_unit ); + ] + |> adds + [ + [ + Key (Press, X, [ Control ]); Key (Press, P, []); + ]; + ] + 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) -> - let rec fold dir dim : t -> Layout.frame Lwd.t Lwt.t = + Lwd.map_s (Lwd.get t) ~f:(fun (t : t) -> + let rec fold dir (t : tt) : Layout.frame Lwd.t Lwt.t = let size = match dir with - | `X -> (dim, `Ratio 1.) - | `Y -> (`Ratio 1., dim) - | `Z -> (dim, dim) + | `X -> (t.dim, `Ratio 1.) + | `Y -> (`Ratio 1., t.dim) + | `Z -> (t.dim, t.dim) in - function - | `T ((dir', (t0, dim0) :: trest) as tl) -> - fold dir' dim0 t0 >>= fun fst -> + match t.t with + | `T (dir', t0 :: trest) -> + fold dir' t0 >>= fun fst -> Lwt_list.fold_left_s - (fun f (t, dim) -> - fold dir' dim t >>= fun newf -> + (fun f t -> + fold dir' t >>= fun newf -> Lwd.map2 f newf ~f:(join ~size dir') |> Lwt.return) fst trest | `T (_, []) -> Layout.none |> Lwd.return |> Lwt.return @@ -1477,7 +1503,7 @@ module WindowManager = struct >>= fun tt -> frame_of_window 314 cursor style size tt |> Lwt.return in - fold `X (`Ratio 1.) tl) + fold `X { t; dim = `Ratio 1.; bindings = [] }) >>= fun d -> Lwd.join d |> Lwt.return end diff --git a/oplevel.ml b/oplevel.ml index 3011dae..8b14eb2 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -152,43 +152,58 @@ let main = (String "#use \"topfind\";;\n#list;;#require \"lwt\";;")); *) (* toplevel execution binding *) Ui.( - update_bindings ui - Event.( - fun a -> - a - |> adds - [ - [ - Key (Press, X, [ Control ]); - Key (Press, E, [ Control ]); - ]; - ] - [ - Custom - ( "toplevel_execute", - fun () -> - TextBuffer.peek tb_init >>= fun _str -> - (*Toploop.use_input out_ppf (String str) - |> F.epr "Toploop.use_input=%b@."; *) - Lwt.return_unit ); - ])); + append_bindings ui + (Lwd.return + Event. + [ + pack Fun.id + (empty + |> adds + [ + [ + Key (Press, X, [ Control ]); + Key (Press, E, [ Control ]); + ]; + ] + [ + Custom + ( "toplevel_execute", + fun () -> + TextBuffer.peek tb_init >>= fun _str -> + (*Toploop.use_input out_ppf (String str) + |> F.epr "Toploop.use_input=%b@."; *) + Lwt.return_unit ); + ]); + ])); WindowManager.make ui (Lwd.var (`T ( `Y, - [ - (`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); - ] ))) + WindowManager. + [ + { + 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 -> let page_root = Lwd.observe page in - let bindings = - ui.bindings |> Lwd.get |> Lwd.observe |> Lwd.quick_sample |> snd - in - F.epr "Bindings:@.%a" Ui.pp_bindings bindings; + let bindings = ui.bindings |> Lwd.observe |> Lwd.quick_sample in + F.epr "Bindings:@."; + List.iter (fun bs -> F.epr "%a" Ui.pp_pack bs) bindings; F.pr "oplevel.ml: entering drawing loop@."; let period_min = 1.0 /. 30. in