new implementation of overlays, introducing window manager (alpha API)

This commit is contained in:
Frédéric Bour 2020-10-09 12:24:29 +02:00
parent 1fb659ad44
commit 74a353e0c1
6 changed files with 153 additions and 130 deletions

View File

@ -90,7 +90,8 @@ let top = Lwd.var (Lwd.return Ui.empty)
let bot = Lwd.var (Lwd.return Ui.empty)
let root =
let wm =
Nottui_widgets.window_manager @@
Lwd_utils.pack Ui.pack_y [ Lwd.join (Lwd.get top); Lwd.join (Lwd.get bot) ]
(*let () = Statmemprof_emacs.start 1E-4 30 5*)
@ -99,12 +100,12 @@ let () =
top
$= Lwd_utils.pack Ui.pack_x
[
main_menu_item "File" (fun () ->
main_menu_item wm "File" (fun () ->
Lwd_utils.pack Ui.pack_y
[
Lwd.return @@ sub_entry "New" ignore;
Lwd.return @@ sub_entry "Open" ignore;
sub_menu_item "Recent" (fun () ->
sub_menu_item wm "Recent" (fun () ->
Lwd_utils.pack Ui.pack_y
[
Lwd.return @@ sub_entry "A" ignore;
@ -113,10 +114,10 @@ let () =
]);
Lwd.return @@ sub_entry "Quit" (fun () -> raise Exit);
]);
main_menu_item "View" (fun _ ->
main_menu_item wm "View" (fun _ ->
bot $= Lwd.return (string "<View>");
Lwd.return Ui.empty);
main_menu_item "Edit" (fun _ ->
main_menu_item wm "Edit" (fun _ ->
bot $= Lwd.return (string "<Edit>");
Lwd.return Ui.empty);
];
@ -127,5 +128,5 @@ let () =
v_pane (strict_table ()) (Lwd.return @@ string "B");
h_pane (Lwd.return (string "A")) (Lwd.return (string "B"));
];
try Ui_loop.run ~tick_period:0.2 root
try Ui_loop.run ~tick_period:0.2 (window_manager_view wm)
with Exit -> ()

View File

@ -193,12 +193,7 @@ open Nottui
(* Some intermediate UI *)
let blank_ui =
let space = Ui.space 1 0 in
function
| 0 -> Ui.empty
| 1 -> space
| n -> Ui.space n 0
let blank_ui n = Ui.space n 0
let flat_hardline =
Flat_span { prefix = Ui.empty; body = Ui.empty; suffix = Ui.empty; }

View File

@ -246,7 +246,17 @@ struct
desc = Atom img;
sensor_cache = None; cache; }
let space x y = atom (I.void x y)
let space_1_0 = atom (I.void 1 0)
let space_0_1 = atom (I.void 0 1)
let space_1_1 = atom (I.void 1 1)
let space x y =
match x, y with
| 0, 0 -> empty
| 1, 0 -> space_1_0
| 0, 1 -> space_0_1
| 1, 1 -> space_1_1
| _ -> atom (I.void x y)
let mouse_area f t : t =
{ t with desc = Mouse_handler (t, f) }
@ -271,17 +281,23 @@ struct
let permanent_sensor frame_sensor t =
{ t with desc = Permanent_sensor (t, frame_sensor);
flags = t.flags lor flag_permanent_sensor }
let prepare_gravity = function
| None, None -> Gravity.(pair default default)
| Some g, None | None, Some g -> Gravity.(pair g g)
| Some pad, Some crop -> Gravity.(pair pad crop)
let resize ?w ?h ?sw ?sh ?pad ?crop ?(bg=A.empty) t : t =
let g = match pad, crop with
| None, None -> Gravity.(pair default default)
| Some g, None | None, Some g -> Gravity.(pair g g)
| Some pad, Some crop -> Gravity.(pair pad crop)
in
let g = prepare_gravity (pad, crop) in
match (w, t.w), (h, t.h), (sw, t.sw), (sh, t.sh) with
| (Some w, _ | None, w), (Some h, _ | None, h),
(Some sw, _ | None, sw), (Some sh, _ | None, sh) ->
{t with w; h; sw; sh; desc = Resize (t, g, bg)}
let resize_to ({w; h; sw; sh} : layout_spec) ?pad ?crop ?(bg=A.empty) t : t =
let g = prepare_gravity (pad, crop) in
{t with w; h; sw; sh; desc = Resize (t, g, bg)}
let event_filter ?focus f t : t =
let focus = match focus with
| None -> t.focus

View File

@ -256,6 +256,10 @@ sig
[bg] is used to fill the padded background.
*)
val resize_to :
layout_spec ->
?pad:Gravity.t -> ?crop:Gravity.t -> ?bg:attr -> t -> t
val shift_area : int -> int -> t -> t
(** Shift the contents of a UI by a certain amount.
Positive values crop the image while negative values pad.

View File

@ -48,16 +48,95 @@ let attr_menu_main = A.(bg green ++ fg black)
let attr_menu_sub = A.(bg lightgreen ++ fg black)
let attr_clickable = A.(bg lightblue)
let menu_overlay ?dx ?dy handler t =
ignore (dx, dy, handler, t);
assert false
(*let placeholder = Lwd.return (Ui.space 1 0) in
let body = Lwd_utils.pack Ui.pack_x [placeholder; t; placeholder] in
let bg = Lwd.map' body @@ fun t ->
let {Ui. w; h; _} = Ui.layout_spec t in
Ui.atom (I.char A.(bg lightgreen) ' ' w h)
type window_manager = {
overlays: ui Lwd.t Lwd_table.t;
view: ui Lwd.t;
}
let window_manager base =
let overlays =
Lwd_table.make ()
in
Lwd.map (Ui.overlay ?dx ?dy ~handler) (Lwd_utils.pack Ui.pack_z [bg; body])*)
let composition =
Lwd.join (Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_z) overlays)
in
let view =
Lwd.map2' base composition @@ fun base composite ->
Ui.join_z base (Ui.resize_to (Ui.layout_spec base) composite)
in
{ overlays; view }
let window_manager_view wm = wm.view
let window_manager_overlays wm = wm.overlays
let menu_overlay wm g ?(dx=0) ?(dy=0) body around =
let sensor ~x ~y ~w ~h () =
let row = Lwd_table.append (window_manager_overlays wm) in
let h_pad = match Gravity.h g with
| `Negative -> Ui.space (x + dx) 0
| `Neutral -> Ui.space (x + dx + w / 2) 0
| `Positive -> Ui.space (x + dx + w) 0
in
let v_pad = match Gravity.v g with
| `Negative -> Ui.space 0 (y + dy)
| `Neutral -> Ui.space 0 (y + dy + h / 2)
| `Positive -> Ui.space 0 (y + dy + h)
in
let view = Lwd.map' body @@ fun body ->
let body =
let pad = Ui.space 1 0 in Ui.join_x pad (Ui.join_x body pad)
in
let bg =
Ui.resize_to (Ui.layout_spec body) ~bg:A.(bg lightgreen) Ui.empty
in
let catchall = Ui.mouse_area
(fun ~x:_ ~y:_ -> function
| `Left -> Lwd_table.remove row; `Handled
| _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty)
in
Ui.join_z catchall @@
Ui.join_y v_pad @@
Ui.join_x h_pad @@
Ui.join_z bg body
in
Lwd_table.set row view
in
Ui.transient_sensor sensor around
(*let menu_overlay wm ?(dx=0) ?(dy=0) handler body =
let refresh = Lwd.var () in
let clicked = ref false in
Lwd.map' body @@ fun body ->
let body = let pad = Ui.space 1 0 in Ui.join_x pad (Ui.join_x body pad) in
let bg =
Ui.resize_to (Ui.layout_spec body) ~bg:A.(bg lightgreen) Ui.empty
in
let click_handler ~x:_ ~y:_ = function
| `Left -> clicked := true; Lwd.set refresh (); `Handled
| _ -> `Unhandled
in
let ui = Ui.mouse_area click_handler (Ui.join_z bg body) in
if !clicked then (
clicked := false;
let sensor ~x ~y ~w:_ ~h () =
let row = Lwd_table.append (window_manager_overlays wm) in
let h_pad = Ui.space (x + dx) 0 in
let v_pad = Ui.space 0 (y + h + dy) in
let view = Lwd.map' (handler ()) @@ fun view ->
let catchall =
Ui.mouse_area
(fun ~x:_ ~y:_ -> function
| `Left -> Lwd_table.remove row; `Handled
| _ -> `Handled)
(Ui.resize ~sw:1 ~sh:1 Ui.empty)
in
Ui.join_z catchall (Ui.join_y v_pad (Ui.join_x h_pad view))
in
Lwd_table.set row view
in
Ui.transient_sensor sensor ui
) else ui*)
let scroll_step = 1
@ -145,55 +224,41 @@ let scroll_area ?(offset=0,0) t =
|> Ui.mouse_area scroll_handler
|> Ui.keyboard_area focus_handler
let main_menu_item text f =
let main_menu_item wm text f =
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
let v = Lwd.var empty_lwd in
let visible = ref false in
let refresh = Lwd.var () in
let overlay = ref false in
let on_click ~x:_ ~y:_ = function
| `Left ->
visible := not !visible;
if not !visible then (
v $= Lwd.return Ui.empty
) else (
let h ~x:_ ~y:_ = function
| `Left ->
visible := false; v $= Lwd.return Ui.empty; `Unhandled
| _ -> `Unhandled
in
v $= menu_overlay h (f ())
);
overlay := true;
Lwd.set refresh ();
`Handled
| _ -> `Unhandled
in
Lwd_utils.pack Ui.pack_y [
Lwd.return (Ui.mouse_area on_click text);
Lwd.join (Lwd.get v)
]
Lwd.map' (Lwd.get refresh) @@ fun () ->
let ui = Ui.mouse_area on_click text in
if !overlay then (
overlay := false;
menu_overlay wm (Gravity.make ~h:`Negative ~v:`Positive) (f ()) ui
) else ui
let sub_menu_item text f =
let sub_menu_item wm text f =
let text = string ~attr:attr_menu_sub text in
let v = Lwd.var empty_lwd in
let visible = ref false in
let refresh = Lwd.var () in
let overlay = ref false in
let on_click ~x:_ ~y:_ = function
| `Left ->
visible := not !visible;
if not !visible then (
v $= Lwd.return Ui.empty
) else (
let h ~x:_ ~y:_ = function
| `Left ->
visible := false; v $= Lwd.return Ui.empty; `Unhandled
| _ -> `Unhandled
in
v $= menu_overlay h (f ())
);
overlay := true;
Lwd.set refresh ();
`Handled
| _ -> `Unhandled
in
Lwd_utils.pack Ui.pack_x [
Lwd.return (Ui.mouse_area on_click text);
Lwd.join (Lwd.get v)
]
Lwd.map' (Lwd.get refresh) @@ fun () ->
let ui = Ui.mouse_area on_click text in
if !overlay then (
overlay := false;
menu_overlay wm (Gravity.make ~h:`Positive ~v:`Negative) (f ()) ui
) else ui
let sub_entry text f =
let text = string ~attr:attr_menu_sub text in
@ -285,70 +350,6 @@ let h_pane l r =
in
Lwd.map2 render (Lwd.get state_var) (Lwd.pair l r)
(*type pane_state =
| Static of { w : int; h : int; split : float }
| Resizing of { w : int; h : int; split : float; x : int; y : int; }
let pane_h (Static {h; _} | Resizing {h; _}) = h
let pane_w (Static {w; _} | Resizing {w; _}) = w
let pane_split (Static {split; _} | Resizing {split; _}) = split
let h_pane l r =
let state_var = Lwd.var (Static {w = 0; h = 0 ; split = 0.5}) in
let render state (l, r) =
let h = pane_h state in
let split = int_of_float (pane_split state *. float (pane_w state)) in
let l = Ui.resize ~w:split ~h l in
let r = Ui.resize ~w:(pane_w state - split - 1) ~h r in
let splitter = Ui.atom (Notty.I.char Notty.A.(bg lightyellow) ' ' 1 h) in
let splitter =
Ui.mouse_area (fun ~x:_ ~y:_ -> function
| `Left ->
`Grab (
(fun ~x ~y:_ ->
match Lwd.peek state_var with
| Static {w; h; split} ->
Lwd.set state_var (Resizing {x = min_int; y = min_int; w; h; split})
| Resizing r ->
if r.x > min_int then
let split = float (x - r.x) /. float r.w in
Lwd.set state_var (Resizing {r with split})
),
(fun ~x:_ ~y:_ ->
match Lwd.peek state_var with
| Static _ -> ()
| Resizing {w; h; split; _} ->
Lwd.set state_var (Static {w; h; split})
)
)
| _ -> `Unhandled
) splitter
in
let ui = Ui.join_x l (Ui.join_x splitter r) in
let ui = Ui.resize ~w:10 ~h:10 ~sw:1 ~sh:1 ui in
let ui = match state with
| Static _ ->
Ui.size_sensor (fun ~w ~h ->
match Lwd.peek state_var with
| Static r ->
if r.w <> w || r.h <> h then
Lwd.set state_var (Static {r with w; h})
| Resizing _ -> ()
) ui
| Resizing _ ->
Ui.permanent_sensor (fun ~x ~y ~w ~h ->
match Lwd.peek state_var with
| Static _ -> ignore
| Resizing r ->
if r.x <> x || r.y <> y || r.w <> w || r.h <> h then
Lwd.set state_var (Resizing {x; y; w; h; split = r.split});
ignore
) ui
in
ui
in
Lwd.map2 render (Lwd.get state_var) (Lwd.pair l r)*)
let sub' str p l =
if p = 0 && l = String.length str
then str

View File

@ -17,10 +17,16 @@ val kprintf : (ui -> 'a) -> ?attr:attr -> ('b, unit, string, 'a) format4 -> 'b
val fmt : ?attr:attr -> ('a, Format.formatter, unit, ui) format4 -> 'a
val kfmt : (ui -> 'a) -> ?attr:attr -> ('b, Format.formatter, unit, 'a) format4 -> 'b
(* window manager *)
type window_manager
val window_manager : ui Lwd.t -> window_manager
val window_manager_view : window_manager -> ui Lwd.t
val window_manager_overlays : window_manager -> ui Lwd.t Lwd_table.t
(* FIXME Menu *)
(*val menu_overlay : ?dx:'a -> ?dy:'b -> 'c -> 'd -> 'e*)
val main_menu_item : string -> (unit -> 'a) -> ui Lwd.t
val sub_menu_item : string -> (unit -> 'a) -> ui Lwd.t
val menu_overlay : window_manager -> gravity -> ?dx:int -> ?dy:int -> ui Lwd.t -> ui -> ui
val main_menu_item : window_manager -> string -> (unit -> ui Lwd.t) -> ui Lwd.t
val sub_menu_item : window_manager -> string -> (unit -> ui Lwd.t) -> ui Lwd.t
val sub_entry : string -> (unit -> unit) -> ui
(* FIXME Explain how scrolling works *)