new implementation of overlays, introducing window manager (alpha API)
This commit is contained in:
parent
1fb659ad44
commit
74a353e0c1
|
@ -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 -> ()
|
||||
|
|
|
@ -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; }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 *)
|
||||
|
|
Loading…
Reference in New Issue