whoa
This commit is contained in:
cqc
124
ogui.ml
124
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, []) ] ]
|
||||
(* 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 () ->
|
||||
Lwd.set cursor
|
||||
(if
|
||||
Lwd.peek cursor
|
||||
< (Lwd.peek telist |> length) - 1
|
||||
then Lwd.peek cursor + 1
|
||||
set cursor
|
||||
(if peek cursor < (peek t |> length) - 1
|
||||
then 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, []) ] ]
|
||||
|> adds
|
||||
[
|
||||
[
|
||||
Key (Press, X, [ Control ]); Key (Press, P, []);
|
||||
];
|
||||
]
|
||||
Lwd.
|
||||
[
|
||||
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;*)
|
||||
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
|
||||
|
||||
|
||||
37
oplevel.ml
37
oplevel.ml
@ -152,10 +152,12 @@ let main =
|
||||
(String "#use \"topfind\";;\n#list;;#require \"lwt\";;")); *)
|
||||
(* toplevel execution binding *)
|
||||
Ui.(
|
||||
update_bindings ui
|
||||
Event.(
|
||||
fun a ->
|
||||
a
|
||||
append_bindings ui
|
||||
(Lwd.return
|
||||
Event.
|
||||
[
|
||||
pack Fun.id
|
||||
(empty
|
||||
|> adds
|
||||
[
|
||||
[
|
||||
@ -171,24 +173,37 @@ let main =
|
||||
(*Toploop.use_input out_ppf (String str)
|
||||
|> F.epr "Toploop.use_input=%b@."; *)
|
||||
Lwt.return_unit );
|
||||
]);
|
||||
]));
|
||||
|
||||
WindowManager.make ui
|
||||
(Lwd.var
|
||||
(`T
|
||||
( `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 ->
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user