Browse Source

wip

pull/3/head
Frédéric Bour 2 years ago
parent
commit
84ba96d183
  1. 43
      examples/cbor/cbor_explorer.ml
  2. 21
      examples/misc.ml
  3. 5
      lib/lwd/lwd.ml
  4. 2
      lib/lwd/lwd.mli
  5. 149
      lib/nottui-widgets/nottui_widgets.ml
  6. 144
      lib/nottui/nottui.ml
  7. 11
      lib/nottui/nottui.mli

43
examples/cbor/cbor_explorer.ml

@ -6,9 +6,13 @@ module A = Notty.A
let unfoldable summary (f: unit -> Ui.Ui.t Lwd.t) : Ui.Ui.t Lwd.t =
let opened = ref false in
let v = Lwd.var W.empty_lwd in
let focus = Lwd.var Ui.Time.origin in
let focused = Lwd.var `None in
let refocus () = Lwd.set focus (Ui.Time.next ()) in
let cursor ~x:_ ~y:_ = function
| `Left when !opened ->
opened := false;
refocus ();
Lwd.set v W.empty_lwd;
`Handled
| `Left ->
@ -18,12 +22,47 @@ let unfoldable summary (f: unit -> Ui.Ui.t Lwd.t) : Ui.Ui.t Lwd.t =
f()
|> Lwd.map (fun x -> Ui.Ui.join_x (W.string "> ") x)
in
refocus ();
Lwd.set v @@ inner;
`Handled
| _ -> `Unhandled
in
let cutoff_update v x =
let x' = Lwd.peek v in if x <> x' then Lwd.set v x
in
let handler = { Ui.Ui.
action = (fun _ _ -> `Unhandled);
status = (fun direct status ->
let d = match direct with
| `Direct -> "`Direct"
| `Inherited -> "`Inherited"
in
let s = match status with
| `Enter -> "`Enter"
| `Change -> "`Change"
| `Leave -> "`Leave"
in
prerr_endline (s ^ d);
cutoff_update focused @@ match direct, status with
| _, `Leave -> `None
| `Direct , _ -> `Focused
| `Inherited , _ -> `Sub_focused
);
} in
let mouse =
Lwd.map (fun m -> Ui.Ui.mouse_area cursor m) summary
summary
|> Lwd.map2 (fun focused ui ->
match
match focused with
| `None -> None
| `Focused -> Some Notty.(I.char A.(bg lightblue) '*' 1 1)
| `Sub_focused -> Some Notty.(I.char A.(bg blue) '*' 1 1)
with
| None -> ui
| Some img -> Ui.Ui.join_x (Ui.Ui.atom img) ui
) (Lwd.get focused)
|> Lwd.map (fun m -> Ui.Ui.mouse_area cursor m)
|> Lwd.map2 (fun focus ui -> Ui.Ui.focus_area focus handler ui) (Lwd.get focus)
in
Lwd_utils.pack Ui.Ui.pack_x [mouse; Lwd.join @@ Lwd.get v]
@ -67,7 +106,7 @@ let ui_of_cbor (c:C.t) =
l;
Lwd.join @@ Lwd_table.reduce (Lwd_utils.lift_monoid Ui.Ui.pack_y) tbl)
in
let w =
let w =
Lwd.map2 Ui.Ui.join_y w_q
(Nottui_widgets.scroll_area @@ traverse ~fold:true c)
in

21
examples/misc.ml

@ -12,21 +12,16 @@ let strict_table () =
let columns = Lwd_table.make () in
for colidx = 0 to 99 do
let rows = Lwd_table.make () in
ignore
@@ Lwd_table.append rows
~set:(Lwd.return @@ string (Printf.sprintf "Column %d" colidx));
Lwd_table.append' rows (printf "Column %d" colidx |> Lwd.pure);
for rowidx = 0 to 99 do
ignore
@@ Lwd_table.append rows
~set:(simple_edit (Printf.sprintf "Test-%03d-%03d" colidx rowidx))
Lwd_table.append' rows
(simple_edit (Printf.sprintf "Test-%03d-%03d" colidx rowidx))
done;
ignore
@@ Lwd_table.append columns
~set:
( rows
|> Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_y)
|> Lwd.join );
ignore @@ Lwd_table.append columns ~set:(Lwd.return (string " "))
Lwd_table.append' columns
( rows
|> Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_y)
|> Lwd.join );
Lwd_table.append' columns (Lwd.return (string " "))
done;
scroll_area
@@ Lwd.join (Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_x) columns)

5
lib/lwd/lwd.ml

@ -442,6 +442,11 @@ let set_on_invalidate x f =
| Pure _ | Impure _ -> assert false
| Root t -> t.on_invalidate <- f
let unsafe_peek = function
| Pure x -> Some x
| Impure t -> t.value
| Root t -> t.value
module Infix = struct
let (let$) = bind
let (and$) = pair

2
lib/lwd/lwd.mli

@ -33,6 +33,8 @@ val is_damaged : 'a root -> bool
val is_released : 'a root -> bool
val release : 'a root -> unit
val unsafe_peek : 'a t -> 'a option
module Infix : sig
val (let$) : 'a t -> ('a -> 'b t) -> 'b t
val (and$) : 'a t -> 'b t -> ('a * 'b) t

149
lib/nottui-widgets/nottui_widgets.ml

@ -66,17 +66,13 @@ let vscroll_area ~state ~change t =
change `Action {state with position};
`Handled
in
let focus_handler state = {
Ui.
status = (fun _ _ -> ());
action = (fun _ -> function
(*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
(*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
| `Arrow `Up , _ -> scroll state (-scroll_step)
| `Arrow `Down , _ -> scroll state (+scroll_step)
| _ -> `Unhandled
);
} in
let focus_handler state = function
(*| `Arrow `Left , _ -> scroll (-scroll_step) 0*)
(*| `Arrow `Right, _ -> scroll (+scroll_step) 0*)
| `Arrow `Up , _ -> scroll state (-scroll_step)
| `Arrow `Down , _ -> scroll state (+scroll_step)
| _ -> `Unhandled
in
let scroll_handler state ~x:_ ~y:_ = function
| `Scroll `Up -> scroll state (-scroll_step)
| `Scroll `Down -> scroll state (+scroll_step)
@ -102,7 +98,7 @@ let vscroll_area ~state ~change t =
bound = max 0 (!total - !visible); }
)
|> Ui.mouse_area (scroll_handler state)
|> Ui.focus_area Time.origin (focus_handler state)
|> Ui.keyboard_area (focus_handler state)
let scroll_area ?(offset=0,0) t =
let offset = Lwd.var offset in
@ -113,17 +109,13 @@ let scroll_area ?(offset=0,0) t =
Lwd.set offset (s_x, s_y);
`Handled
in
let focus_handler = {
Ui.
status = (fun _ _ -> ());
action = (fun _ -> function
| `Arrow `Left , _ -> scroll (-scroll_step) 0
| `Arrow `Right, _ -> scroll (+scroll_step) 0
| `Arrow `Up , _ -> scroll 0 (-scroll_step)
| `Arrow `Down , _ -> scroll 0 (+scroll_step)
| _ -> `Unhandled
);
} in
let focus_handler = function
| `Arrow `Left , _ -> scroll (-scroll_step) 0
| `Arrow `Right, _ -> scroll (+scroll_step) 0
| `Arrow `Up , _ -> scroll 0 (-scroll_step)
| `Arrow `Down , _ -> scroll 0 (+scroll_step)
| _ -> `Unhandled
in
let scroll_handler ~x:_ ~y:_ = function
| `Scroll `Up -> scroll 0 (-scroll_step)
| `Scroll `Down -> scroll 0 (+scroll_step)
@ -133,7 +125,7 @@ let scroll_area ?(offset=0,0) t =
t
|> Ui.scroll_area s_x s_y
|> Ui.mouse_area scroll_handler
|> Ui.focus_area Time.origin focus_handler
|> Ui.keyboard_area focus_handler
let main_menu_item text f =
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
@ -291,8 +283,7 @@ let sub' str p l =
else String.sub str p l
let edit_field state ~on_change ~on_submit =
let vfocused = Lwd.var false in
let time = ref Time.origin in
let focus_handle = Nottui__Nottui_focus.make_handle () in
let update focused (text, pos) =
let pos = min (max 0 pos) (String.length text) in
let content =
@ -311,69 +302,59 @@ let edit_field state ~on_change ~on_submit =
) else
[I.string A.empty (if text = "" then " " else text)]
in
let handler = {
Ui.
action = (fun _ key -> match key with
| `ASCII k, _ ->
let text =
if pos < String.length text then (
String.sub text 0 pos ^ String.make 1 k ^
String.sub text pos (String.length text - pos)
) else (
text ^ String.make 1 k
)
in
on_change (text, (pos + 1));
`Handled
| `Backspace, _ ->
let text =
if pos > 0 then (
if pos < String.length text then (
String.sub text 0 (pos - 1) ^
String.sub text pos (String.length text - pos)
) else if String.length text > 0 then (
String.sub text 0 (String.length text - 1)
) else text
) else text
in
let pos = max 0 (pos - 1) in
on_change (text, pos);
`Handled
| `Enter, _ -> on_submit (text, pos); `Handled
| `Arrow `Left, _ ->
let pos = min (String.length text) pos in
if pos > 0 then (
on_change (text, pos - 1);
`Handled
)
else `Unhandled
| `Arrow `Right, _ ->
let pos = pos + 1 in
if pos <= String.length text
then (on_change (text, pos); `Handled)
else `Unhandled
| _ -> `Unhandled);
status = (fun _ event ->
let focused' = match event with
| `Enter -> true
| `Leave -> false
| _ -> focused
in
if focused' <> focused then
vfocused $= focused'
);
} in
Ui.focus_area !time handler content
let handler = function
| `ASCII k, _ ->
let text =
if pos < String.length text then (
String.sub text 0 pos ^ String.make 1 k ^
String.sub text pos (String.length text - pos)
) else (
text ^ String.make 1 k
)
in
on_change (text, (pos + 1));
`Handled
| `Backspace, _ ->
let text =
if pos > 0 then (
if pos < String.length text then (
String.sub text 0 (pos - 1) ^
String.sub text pos (String.length text - pos)
) else if String.length text > 0 then (
String.sub text 0 (String.length text - 1)
) else text
) else text
in
let pos = max 0 (pos - 1) in
on_change (text, pos);
`Handled
| `Enter, _ -> on_submit (text, pos); `Handled
| `Arrow `Left, _ ->
let pos = min (String.length text) pos in
if pos > 0 then (
on_change (text, pos - 1);
`Handled
)
else `Unhandled
| `Arrow `Right, _ ->
let pos = pos + 1 in
if pos <= String.length text
then (on_change (text, pos); `Handled)
else `Unhandled
| _ -> `Unhandled
in
Ui.keyboard_area ~handle:focus_handle handler content
in
let node =
Lwd.map2 update
(Nottui__Nottui_focus.has_focus focus_handle) state
in
let node = Lwd.var (Lwd.map2 update (Lwd.get vfocused) state) in
let mouse_grab (text, pos) ~x ~y:_ = function
| `Left ->
if x <> pos then on_change (text, x);
time := Time.next ();
node $= Lwd.map2 update (Lwd.get vfocused) state;
Nottui__Nottui_focus.request_focus focus_handle;
`Handled
| _ -> `Unhandled
in
Lwd.map2' state !$node @@ fun state content ->
Lwd.map2' state node @@ fun state content ->
Ui.mouse_area (mouse_grab state) content

144
lib/nottui/nottui.ml

@ -100,11 +100,6 @@ struct
| `Grab of (x:int -> y:int -> unit) * (x:int -> y:int -> unit)
]
type focus_handler = {
action : [`Direct | `Inherited] -> Unescape.key -> [`Unhandled | `Handled];
status : [`Direct | `Inherited] -> [`Change | `Enter | `Leave] -> unit;
}
type layout_spec = { w : int; h : int; sw : int; sh : int }
let pp_layout_spec ppf { w; h; sw; sh } =
@ -115,11 +110,11 @@ struct
| Size_sensor of 'a * (int -> int -> unit)
| Resize of 'a * Gravity.t2 * A.t
| Mouse_handler of 'a * mouse_handler
| Focus_area of 'a
| Focus_area of 'a * (Unescape.key -> may_handle)
| Scroll_area of 'a * int * int
| Event_filter of 'a *
([`Key of Unescape.key | `Mouse of Unescape.mouse] ->
[`Handled | `Unhandled ])
may_handle)
| Overlay of 'a overlay
| X of 'a * 'a
| Y of 'a * 'a
@ -139,7 +134,7 @@ struct
w : int; sw : int;
h : int; sh : int;
desc : t desc;
focus_chain : focus_handler list * Time.t;
focus : Nottui_focus.t;
mutable cache : cache;
}
and cache = {
@ -152,39 +147,28 @@ struct
let layout_spec t : layout_spec =
{ w = t.w; h = t.h; sw = t.sw; sh = t.sh }
let select_focus a b =
let _, (pa : Time.t) = a.focus_chain and _, pb = b.focus_chain in
if Time.(pb > pa)
then b.focus_chain
else a.focus_chain
let cache = { vx1 = 0; vy1 = 0; vx2 = 0; vy2 = 0;
image = I.empty; overlays = [] }
let empty =
{ w = 0; sw = 0; h = 0; sh = 0;
focus_chain = ([], Time.origin); desc = Atom I.empty; cache }
focus = Nottui_focus.empty; desc = Atom I.empty; cache }
let atom img =
{ w = I.width img; sw = 0;
h = I.height img; sh = 0;
focus_chain = ([], Time.origin);
focus = Nottui_focus.empty;
desc = Atom img; cache }
let mouse_area f t =
{ t with desc = Mouse_handler (t, f) }
let focus_area time handler t =
let focus_chain =
let handlers, time0 = t.focus_chain in
if Time.(time > time0) then
([handler], time)
else if Time.(time0 > origin) then
(handler :: handlers, time0)
else
t.focus_chain
let keyboard_area ?handle f t =
let focus = match handle with
| None -> t.focus
| Some focus -> Nottui_focus.merge focus t.focus
in
{ t with desc = Focus_area t; focus_chain }
{ t with desc = Focus_area (t, f); focus }
let scroll_area x y t =
{ t with desc = Scroll_area (t, x, y) }
@ -211,38 +195,31 @@ struct
let o_z = Time.next () in
fun o_n ->
let desc = Overlay { o_n; o_x; o_y; o_h; o_z; o_origin; o_direction } in
{ w = 0; sw = 0; h = 0; sh = 0; desc;
focus_chain = ([], Time.origin); cache }
let event_filter ?priority f t =
let handlers, time = t.focus_chain in
let time = match priority with
| None -> time
| Some time -> time
{ w = 0; sw = 0; h = 0; sh = 0; desc; focus = Nottui_focus.empty; cache }
let event_filter ?handle f t =
let focus = match handle with
| None -> t.focus
| Some focus -> focus
in
let focus_handler = {
action = (fun _ key -> f (`Key key));
status = (fun _ _ -> ());
} in
{ t with desc = Event_filter (t, f);
focus_chain = (focus_handler :: handlers, time) }
{ t with desc = Event_filter (t, f); focus }
let join_x a b = {
w = (a.w + b.w); sw = (a.sw + b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
focus_chain = select_focus a b; desc = X (a, b); cache
focus = Nottui_focus.merge a.focus b.focus; desc = X (a, b); cache
}
let join_y a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (a.h + b.h); sh = (a.sh + b.sh);
focus_chain = select_focus a b; desc = Y (a, b); cache;
focus = Nottui_focus.merge a.focus b.focus; desc = Y (a, b); cache;
}
let join_z a b = {
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
focus_chain = select_focus a b; desc = Z (a, b); cache;
focus = Nottui_focus.merge a.focus b.focus; desc = Z (a, b); cache;
}
let pack_x = (empty, join_x)
@ -253,6 +230,8 @@ struct
let vcat xs = Lwd_utils.pure_pack pack_y xs
let zcat xs = Lwd_utils.pure_pack pack_z xs
let has_focus t = Nottui_focus.has_focus t.focus
let rec pp ppf t =
Format.fprintf ppf
"@[<hov>{@ w = %d;@ h = %d;@ sw = %d;@ sh = %d;@ desc = @[%a@];@ }@]"
@ -268,7 +247,7 @@ struct
Gravity.pp (Gravity.p2 gravity)
| Mouse_handler (n, _) ->
Format.fprintf ppf "Mouse_handler (@[%a,@ _@])" pp n
| Focus_area n ->
| Focus_area (n, _) ->
Format.fprintf ppf "Focus_area (@[%a,@ _@])" pp n
| Scroll_area (n, _, _) ->
Format.fprintf ppf "Scroll_area (@[%a,@ _@])" pp n
@ -304,13 +283,12 @@ struct
mutable view : ui;
mutable mouse_grab :
(int * int * ((x:int -> y:int -> unit) * (x:int -> y:int -> unit))) option;
mutable last_focus_chain :
focus_handler list;
focus : Nottui_focus.root;
}
let make () = {
mouse_grab = None;
last_focus_chain = [];
focus = Nottui_focus.make_root ();
size = (0, 0);
view = Ui.empty;
}
@ -319,7 +297,8 @@ struct
let update t size ui =
t.size <- size;
t.view <- ui
t.view <- ui;
Nottui_focus.update t.focus ui.focus
let sort_overlays o = List.sort
(fun o1 o2 -> - Time.compare o1.o_z o2.o_z) o
@ -380,7 +359,7 @@ struct
(aux ox oy sw sh t || handle ox oy f)
| Size_sensor (desc, _) ->
aux ox oy sw sh desc
| Focus_area desc ->
| Focus_area (desc, _) ->
aux ox oy sw sh desc
| Scroll_area (desc, sx, sy) ->
aux (ox - sx) (oy - sy) sw sh desc
@ -469,7 +448,7 @@ struct
| Size_sensor (desc, handler) ->
handler sw sh;
render_node vx1 vy1 vx2 vy2 sw sh desc
| Focus_area desc | Mouse_handler (desc, _) ->
| Focus_area (desc, _) | Mouse_handler (desc, _) ->
render_node vx1 vy1 vx2 vy2 sw sh desc
| Scroll_area (t', sx, sy) ->
let cache = render_node
@ -539,37 +518,7 @@ struct
t.cache <- cache;
cache
let rec drop_focus_chain = function
| [] -> ()
| [x] -> x.status `Direct `Leave
| x :: xs -> x.status `Inherited `Leave; drop_focus_chain xs
let rec grab_focus_chain = function
| [] -> ()
| [x] -> x.status `Direct `Enter
| x :: xs -> x.status `Inherited `Enter; grab_focus_chain xs
let rec diff_focus_chain = function
| xs, ys when xs == ys -> `Unchanged
| (x :: xs), (y :: ys) when x == y ->
begin match diff_focus_chain (xs, ys) with
| `Unchanged -> ()
| `Grow -> x.status `Inherited `Change
| `Shrink -> x.status `Direct `Change
end;
`Unchanged
| [], [] -> `Unchanged
| [], ys -> grab_focus_chain ys; `Grow
| xs, [] -> drop_focus_chain xs; `Shrink
| xs, ys -> drop_focus_chain xs; grab_focus_chain ys; `Unchanged
let update_focus_chain st focus_chain =
ignore
(diff_focus_chain (st.last_focus_chain, focus_chain) : [> `Unchanged]);
st.last_focus_chain <- focus_chain
let image st =
update_focus_chain st (fst st.view.focus_chain);
let flatten (im,todo) o =
let todo = List.map (shift_o o.o_x o.o_y) o.o_n.cache.overlays @ todo in
let ovi = I.pad ~l:o.o_x ~t:o.o_y o.o_n.cache.image in
@ -583,17 +532,36 @@ struct
let cache = render_node 0 0 w h w h st.view in
process (cache.image, cache.overlays)
let rec dispatch_key key = function
| [] -> `Unhandled
| [h] -> h.action `Direct key
| h :: hs ->
begin match dispatch_key key hs with
| `Unhandled -> h.action `Inherited key
| `Handled -> `Handled
let rec dispatch_key_branch t =
match t.desc with
| Atom _ | Overlay _ -> []
| X (a, b) | Y (a, b) | Z (a, b) ->
begin match Nottui_focus.peek_focus a.focus with
| None -> assert false
| Some true -> dispatch_key_branch a
| Some false -> dispatch_key_branch b
end
| Focus_area (t, f) -> f :: dispatch_key_branch t
| Mouse_handler (t, _) | Size_sensor (t, _)
| Scroll_area (t, _, _) | Resize (t, _, _) ->
dispatch_key_branch t
| Event_filter (t, f) ->
(fun key -> f (`Key key)) :: dispatch_key_branch t
let dispatch_key st key =
dispatch_key key st.last_focus_chain
if Nottui_focus.focused st.focus then
let branch = dispatch_key_branch st.view in
let rec iter = function
| f :: fs ->
begin match f key with
| `Unhandled -> iter fs
| `Handled -> `Handled
end
| [] -> `Unhandled
in
iter branch
else
`Unhandled
let dispatch_event t = function
| `Key key -> dispatch_key t key

11
lib/nottui/nottui.mli

@ -36,11 +36,6 @@ sig
| `Grab of (x:int -> y:int -> unit) * (x:int -> y:int -> unit)
]
type focus_handler = {
action : [`Direct|`Inherited] -> Unescape.key -> may_handle;
status : [`Direct|`Inherited] -> [`Change|`Enter|`Leave] -> unit;
}
type layout_spec = { w : int; h : int; sw : int; sh : int; }
val pp_layout_spec : Format.formatter -> layout_spec -> unit
@ -50,7 +45,9 @@ sig
val empty : t
val atom : image -> t
val mouse_area : mouse_handler -> t -> t
val focus_area : Time.t -> focus_handler -> t -> t
val has_focus : t -> bool Lwd.t
val keyboard_area : ?handle:Nottui_focus.t ->
(Unescape.key -> may_handle) -> t -> t
val scroll_area : int -> int -> t -> t
val size_sensor : (int -> int -> unit) -> t -> t
val resize :
@ -61,7 +58,7 @@ sig
?handler:mouse_handler -> ?origin:gravity -> ?direction:gravity ->
t -> t
val event_filter :
?priority:Time.t ->
?handle:Nottui_focus.t ->
([`Key of Unescape.key | `Mouse of Unescape.mouse] -> may_handle) -> t -> t
val join_x : t -> t -> t

Loading…
Cancel
Save