3 Commits

Author SHA1 Message Date
cqc
048ea0eab4 text_area improvements 2022-12-18 11:14:37 -06:00
cqc
3509930195 added Focus.releases for line_table 2022-12-15 12:05:15 -06:00
cqc
b1ac36ce3e text editor issue is a problem with focus resolution
might require Focus.release, but may be incorrect use of Focus.request.
2022-12-14 19:39:28 -06:00
3 changed files with 7310 additions and 6630 deletions

File diff suppressed because one or more lines are too long

View File

@ -85,7 +85,6 @@ let _ =
let webgl_ctx = webgl_initialize canvas in let webgl_ctx = webgl_initialize canvas in
let vg = graphv_initialize webgl_ctx in let vg = graphv_initialize webgl_ctx in
let open Js_of_ocaml_lwt.Lwt_js_events in let open Js_of_ocaml_lwt.Lwt_js_events in
let edit_me = Lwd.var ("edit me?", 0) in
let open Nottui in let open Nottui in
let gravity_pad = Gravity.make ~h:`Negative ~v:`Negative in let gravity_pad = Gravity.make ~h:`Negative ~v:`Negative in
let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in
@ -93,12 +92,20 @@ let _ =
let wm = Nottui_widgets.window_manager (Lwd.join (Lwd.get body)) in let wm = Nottui_widgets.window_manager (Lwd.join (Lwd.get body)) in
let ui = let ui =
Nottui_widgets.( Nottui_widgets.(
let string s = Lwd.pure @@ Nottui_widgets.string s in edit_area
line_table_of_string ~table:
(multifield_of_string
"edit me?\n\ "edit me?\n\
derp derp derp\n\ derp derp derp\n\
herp herp derp\n\ herp herp derp\n\
ding dong beep beep" ding dong beep beep")
()
(* vlist_of_text
@@ Lwd.pure
"navigate me?\n\
derp derp derp\n\
herp herp derp\n\
ding dong beep beep" *)
(* @@ Lwd_utils.pack Ui.pack_y (* @@ Lwd_utils.pack Ui.pack_y
[ [
edit_field edit_me; edit_field edit_me;

321
human.ml
View File

@ -1,3 +1,5 @@
(* why *)
(* (*
names?: names?:
@ -517,7 +519,7 @@ module Input = struct
let pp_mods = let pp_mods =
F.( F.(
list (fun ppf -> function list ~sep:F.sp (fun ppf -> function
| `Super -> pf ppf "`Super" | `Super -> pf ppf "`Super"
| `Meta -> pf ppf "`Meta" | `Meta -> pf ppf "`Meta"
| `Ctrl -> pf ppf "`Ctrl" | `Ctrl -> pf ppf "`Ctrl"
@ -810,6 +812,14 @@ module Style = struct
NVG.set_fill_color vg ~color:s.bg; NVG.set_fill_color vg ~color:s.bg;
NVG.set_stroke_color vg ~color:s.fg; NVG.set_stroke_color vg ~color:s.fg;
Font.set vg s.font Font.set vg s.font
let menu_main = bg Color.green ++ fg Color.black
let menu_sub = bg Color.lightgreen ++ fg Color.black
let clickable =
(bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light)
let cursor = (fg @@ Color.dark) ++ (bg @@ Color.yellow)
end end
module Pad = struct module Pad = struct
@ -1220,6 +1230,8 @@ module Nottui = struct
val status : handle -> status Lwd.t val status : handle -> status Lwd.t
val has_focus : status -> bool val has_focus : status -> bool
val merge : status -> status -> status val merge : status -> status -> status
val pp_var : Format.formatter -> var -> unit
val pp_status : Format.formatter -> status -> unit
end = struct end = struct
type var = int Lwd.var type var = int Lwd.var
type status = Empty | Handle of int * var | Conflict of int type status = Empty | Handle of int * var | Conflict of int
@ -1240,6 +1252,8 @@ module Nottui = struct
let request_var (v : var) = let request_var (v : var) =
incr clock; incr clock;
Log.debug (fun m ->
m "Focus.request_var v=%d clock=%d" (Lwd.peek v) !clock);
Lwd.set v !clock Lwd.set v !clock
let request ((v, _) : handle) = request_var v let request ((v, _) : handle) = request_var v
@ -1250,15 +1264,20 @@ module Nottui = struct
let merge s1 s2 : status = let merge s1 s2 : status =
match (s1, s2) with match (s1, s2) with
| Empty, x | x, Empty -> x | (Empty | Handle (0, _)), x | x, (Empty | Handle (0, _)) -> x
| _, Handle (0, _) -> s1
| Handle (0, _), _ -> s2
| Handle (i1, _), Handle (i2, _) when i1 = i2 -> s1 | Handle (i1, _), Handle (i2, _) when i1 = i2 -> s1
| (Handle (i1, _) | Conflict i1), Conflict i2 when i1 < i2 -> s2 | (Handle (i1, _) | Conflict i1), Conflict i2 when i1 < i2 -> s2
| (Handle (i1, _) | Conflict i1), Handle (i2, _) when i1 < i2 -> | (Handle (i1, _) | Conflict i1), Handle (i2, _) when i1 < i2 ->
Conflict i2 Conflict i2
| Conflict _, (Handle (_, _) | Conflict _) -> s1 | Conflict _, (Handle (_, _) | Conflict _) -> s1
| Handle (i1, _), (Handle (_, _) | Conflict _) -> Conflict i1 | Handle (i1, _), (Handle (_, _) | Conflict _) -> Conflict i1
let pp_var ppf v = F.pf ppf "%d" (Lwd.peek v)
let pp_status ppf = function
| Empty -> F.pf ppf "Empty"
| Handle (i, v) -> F.pf ppf "Handle (%d, %a)" i pp_var v
| Conflict i -> F.pf ppf "Conflict %d" i
end end
module Gravity : sig module Gravity : sig
@ -1333,6 +1352,10 @@ module Nottui = struct
module Ui = struct module Ui = struct
type may_handle = [ `Unhandled | `Handled ] type may_handle = [ `Unhandled | `Handled ]
let may_handle (type a) (v : a option) (f : a -> may_handle) :
may_handle =
match v with Some v' -> f v' | None -> `Unhandled
let pp_may_handle ppf = function let pp_may_handle ppf = function
| `Unhandled -> F.pf ppf "`Unhandled" | `Unhandled -> F.pf ppf "`Unhandled"
| `Handled -> F.pf ppf "`Handled" | `Handled -> F.pf ppf "`Handled"
@ -1361,7 +1384,7 @@ module Nottui = struct
let pp_key = let pp_key =
F.( F.(
pair pair ~sep:F.sp
(fun ppf v -> (fun ppf v ->
match v with match v with
| `Copy -> pf ppf "`Copy" | `Copy -> pf ppf "`Copy"
@ -1590,7 +1613,9 @@ module Nottui = struct
let zcat xs = Lwd_utils.reduce pack_z xs let zcat xs = Lwd_utils.reduce pack_z xs
let has_focus t = Focus.has_focus t.focus let has_focus t = Focus.has_focus t.focus
let rec pp ppf t = Format.fprintf ppf "@[<hov>%a@]" pp_desc t.desc let rec pp ppf t =
F.pf ppf "@[<hov>focus=%a %a@]" Focus.pp_status t.focus pp_desc
t.desc
and pp_desc ppf = function and pp_desc ppf = function
| Atom a -> | Atom a ->
@ -1658,22 +1683,6 @@ module Nottui = struct
let size t = t.size let size t = t.size
let iter f (ui : ui) =
match ui.desc with
| Atom _ -> ()
| Size_sensor (u, _)
| Transient_sensor (u, _)
| Permanent_sensor (u, _)
| Resize (u, _, _, _)
| Mouse_handler (u, _)
| Focus_area (u, _)
| Shift_area (u, _, _)
| Event_filter (u, _) ->
f u
| X (u1, u2) | Y (u1, u2) | Z (u1, u2) ->
f u1;
f u2
let solve_focus (ui : ui) i = let solve_focus (ui : ui) i =
let rec aux ui = let rec aux ui =
match ui.focus with match ui.focus with
@ -1991,6 +2000,12 @@ module Nottui = struct
let cache = let cache =
match t.desc with match t.desc with
| Atom image -> | Atom image ->
let image =
if Focus.has_focus t.focus then (
Log.debug (fun m -> m "render_node Atom has_focus");
I.attr A.clickable image)
else image
in
{ {
vx = Interval.make 0. sw; vx = Interval.make 0. sw;
vy = Interval.make 0. sh; vy = Interval.make 0. sh;
@ -2094,7 +2109,7 @@ module Nottui = struct
let image vg { size; view; _ } = let image vg { size; view; _ } =
let w, h = V2.to_tuple size in let w, h = V2.to_tuple size in
(*Log.debug (fun m -> m "Renderer.image view=%a" Ui.pp view);*) Log.debug (fun m -> m "Renderer.image view=%a " Ui.pp view);
(render_node vg 0. 0. w h w h view).image (render_node vg 0. 0. w h w h view).image
let dispatch_raw_key st key = let dispatch_raw_key st key =
@ -2143,10 +2158,13 @@ module Nottui = struct
raise Acquired_focus raise Acquired_focus
| Focus.Conflict _ -> iter aux ui | Focus.Conflict _ -> iter aux ui
in in
Log.debug (fun m -> m "grab_focus");
try try
aux ui; aux ui;
false false
with Acquired_focus -> true with Acquired_focus ->
Log.warn (fun m -> m "grab_focus Acquired_focus -> true");
true
let rec dispatch_focus t dir = let rec dispatch_focus t dir =
match t.desc with match t.desc with
@ -2160,8 +2178,13 @@ module Nottui = struct
| Event_filter (t, _) -> | Event_filter (t, _) ->
dispatch_focus t dir dispatch_focus t dir
| Focus_area (t', _) -> | Focus_area (t', _) ->
if Focus.has_focus t'.focus then if Focus.has_focus t'.focus then (
dispatch_focus t' dir || grab_focus t Log.debug (fun m ->
m
"dispatch_focus Focus_area has_focus t'.focus = \
true");
dispatch_focus t' dir || grab_focus t)
else if Focus.has_focus t.focus then false else if Focus.has_focus t.focus then false
else grab_focus t else grab_focus t
| X (a, b) -> ( | X (a, b) -> (
@ -2219,7 +2242,10 @@ module Nottui = struct
let dir = if List.mem `Shift mods then `Prev else `Next in let dir = if List.mem `Shift mods then `Prev else `Next in
dispatch_key st (`Focus dir, mods) dispatch_key st (`Focus dir, mods)
| `Unhandled, (`Focus dir, _) -> | `Unhandled, (`Focus dir, _) ->
if dispatch_focus st.view dir then `Handled else `Unhandled let r = dispatch_focus st.view dir in
(if r then Log.debug else Log.warn) (fun m ->
m "Renderer.dispatch_focus key:%a -> %b" pp_key key r);
if r then `Handled else `Unhandled
| `Unhandled, _ -> `Unhandled | `Unhandled, _ -> `Unhandled
let dispatch_event t = function let dispatch_event t = function
@ -2337,14 +2363,6 @@ module Nottui_widgets = struct
let kfmt k ?attr fmt = let kfmt k ?attr fmt =
Format.kasprintf (fun str -> k (string ?attr str)) fmt Format.kasprintf (fun str -> k (string ?attr str)) fmt
let attr_menu_main = A.(bg Color.green ++ fg Color.black)
let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
let attr_clickable =
A.((bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light))
let attr_cursor = A.((fg @@ Color.dark) ++ (bg @@ Color.yellow))
type window_manager = { type window_manager = {
overlays : ui Lwd.t Lwd_table.t; overlays : ui Lwd.t Lwd_table.t;
view : ui Lwd.t; view : ui Lwd.t;
@ -2484,7 +2502,7 @@ module Nottui_widgets = struct
|> Ui.keyboard_area focus_handler) |> Ui.keyboard_area focus_handler)
let main_menu_item wm text f = let main_menu_item wm text f =
let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in let text = string ~attr:A.menu_main (" " ^ text ^ " ") in
let refresh = Lwd.var () in let refresh = Lwd.var () in
let overlay = ref false in let overlay = ref false in
let on_click ~x:_ ~y:_ = function let on_click ~x:_ ~y:_ = function
@ -2504,7 +2522,7 @@ module Nottui_widgets = struct
else ui) else ui)
let sub_menu_item wm text f = let sub_menu_item wm text f =
let text = string ~attr:attr_menu_sub text in let text = string ~attr:A.menu_sub text in
let refresh = Lwd.var () in let refresh = Lwd.var () in
let overlay = ref false in let overlay = ref false in
let on_click ~x:_ ~y:_ = function let on_click ~x:_ ~y:_ = function
@ -2524,7 +2542,7 @@ module Nottui_widgets = struct
else ui) else ui)
let sub_entry text f = let sub_entry text f =
let text = string ~attr:attr_menu_sub text in let text = string ~attr:A.menu_sub text in
let on_click ~x:_ ~y:_ = function let on_click ~x:_ ~y:_ = function
| `Left -> | `Left ->
f (); f ();
@ -2625,51 +2643,44 @@ module Nottui_widgets = struct
in in
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot) Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
let sub' str p l = let eq_uc_c uc c = Uchar.(equal uc (of_char c))
if p = 0 && l = String.length str then str else String.sub str p l
let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id) state let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id) state
= =
let on_change a = Lwd.set state (on_change a) in
let update focus_h focus (text, pos) = let update focus_h focus (text, pos) =
let pos = min (max 0 pos) (String.length text) in let pos = min (max 0 pos) (String.length text) in
let content = let content =
Ui.atom @@ I.hcat Ui.atom @@ I.hcat
@@ @@
if Focus.has_focus focus then if Focus.has_focus focus then
let attr = attr_clickable in let attr = A.clickable in
let len = String.length text in let len = String.length text in
if pos >= len then if pos >= len then
[ I.string ~attr text; I.string ~attr:attr_cursor " " ] [ I.string ~attr text; I.string ~attr:A.cursor " " ]
else else
[ [
I.string ~attr (String.sub text 0 pos); I.string ~attr (String.sub text 0 pos);
I.string ~attr:attr_cursor (String.sub text pos 1); I.string ~attr:A.cursor (String.sub text pos 1);
I.string ~attr I.string ~attr
(String.sub text (pos + 1) (len - pos - 1)); (String.sub text (pos + 1) (len - pos - 1));
] ]
else [ I.string (if text = "" then " " else text) ] else [ I.string (if text = "" then " " else text) ]
in in
let handler k = let handler k =
let on_change a =
Lwd.set state (on_change a);
`Handled
in
(match k with (match k with
| `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) -> | `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
on_change ("", 0); on_change ("", 0) (* clear *)
`Handled (* clear *) | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' ->
| `Escape, [] -> (* TODO put killed text into kill-ring *)
Focus.release focus_h;
`Handled
| `Uchar k, _ ->
let k = Uchar.unsafe_to_char k in
let text =
if pos < String.length text then if pos < String.length text then
String.sub text 0 pos ^ String.make 1 k on_change (String.sub text 0 pos, pos)
^ String.sub text pos (String.length text - pos) else `Unhandled (* kill *)
else text ^ String.make 1 k
in
on_change (text, pos + 1);
`Handled
| `Backspace, [] -> | `Backspace, [] ->
if pos > 0 then ( if pos > 0 then
let text = let text =
if pos < String.length text then if pos < String.length text then
String.sub text 0 (pos - 1) String.sub text 0 (pos - 1)
@ -2679,23 +2690,28 @@ module Nottui_widgets = struct
else text else text
in in
let pos = max 0 (pos - 1) in let pos = max 0 (pos - 1) in
on_change (text, pos); on_change (text, pos)
`Handled)
else `Unhandled else `Unhandled
| `Uchar k, [] ->
let k = Uchar.unsafe_to_char k in
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)
| `Escape, [] ->
Focus.release focus_h;
`Handled
(* | `Enter, _ -> (* | `Enter, _ ->
on_submit (text, pos); on_submit (text, pos);
`Handled *) `Handled *)
| `Arrow `Left, [] -> | `Arrow `Left, [] ->
let pos = min (String.length text) pos in if pos > 0 then on_change (text, pos - 1) else `Unhandled
if pos > 0 then (
on_change (text, pos - 1);
`Handled)
else `Unhandled
| `Arrow `Right, [] -> | `Arrow `Right, [] ->
let pos = pos + 1 in let pos = pos + 1 in
if pos <= String.length text then ( if pos <= String.length text then on_change (text, pos)
on_change (text, pos);
`Handled)
else `Unhandled else `Unhandled
| _ -> `Unhandled) | _ -> `Unhandled)
|> fun r -> |> fun r ->
@ -2728,7 +2744,20 @@ module Nottui_widgets = struct
ui : Ui.t Lwd.t; ui : Ui.t Lwd.t;
} }
let eq_uc_c uc c = Uchar.(equal uc (of_char c)) type lines = line Lwd_table.t
let line_empty () =
let focus = Focus.make () in
let state = Lwd.var ("", 0) in
{ focus; state; ui = edit_field ~focus state }
let line_make ?(focus = Focus.make ()) str =
let state = Lwd.var (str, 0) in
{ focus; state; ui = edit_field ~focus state }
let line_append ?(table = Lwd_table.make ()) ?focus str =
let row = Lwd_table.append table in
Lwd_table.set row (line_make ?focus str)
let copy_line_cursor (x : line) (y : line) = let copy_line_cursor (x : line) (y : line) =
let _, xi = Lwd.peek x.state in let _, xi = Lwd.peek x.state in
@ -2736,48 +2765,80 @@ module Nottui_widgets = struct
let yi = Int.max 0 (Int.min xi (String.length ys)) in let yi = Int.max 0 (Int.min xi (String.length ys)) in
Lwd.set y.state (ys, yi) Lwd.set y.state (ys, yi)
let row_of_cursor cursor f =
Ui.may_handle (Lwd.peek cursor) (fun row -> f row)
let line_of_cursor cursor let line_of_cursor cursor
(f : line Lwd_table.row -> line -> Ui.may_handle) : (f : line Lwd_table.row -> line -> Ui.may_handle) :
Ui.may_handle = Ui.may_handle =
match Lwd.peek cursor with Ui.may_handle (Lwd.peek cursor) (fun row ->
| Some row -> ( Ui.may_handle (Lwd_table.get row) (fun line -> f row line))
match Lwd_table.get row with
| Some line -> f row line
| None -> `Unhandled)
| None -> `Unhandled
let cursor_move cursor let cursor_move cursor
(f : line Lwd_table.row -> line Lwd_table.row option) = (f : line Lwd_table.row -> line Lwd_table.row option) =
match Lwd.peek cursor with match Lwd.peek cursor with
| Some cursor_line -> ( | Some cursor_row -> (
match f cursor_line with match f cursor_row with
| Some new_row ->
(match Lwd_table.get new_row with
| Some new_line -> | Some new_line ->
(match Lwd_table.get new_line with cursor_row |> Lwd_table.get
| Some line' -> |> Option.iter (fun cursor_line ->
cursor_line |> Lwd_table.get copy_line_cursor cursor_line new_line;
|> Option.iter (fun line -> Focus.release cursor_line.focus);
copy_line_cursor line line'); Focus.request new_line.focus
Focus.request line'.focus
| None -> ()); | None -> ());
Lwd.set cursor (Some new_line); Lwd.set cursor (Some new_row);
`Handled `Handled
| None -> `Unhandled) | None -> `Unhandled)
| None -> `Unhandled | None -> `Unhandled
let line_make ?(focus = Focus.make ()) str = let multifield_of_string ?(table = Lwd_table.make ()) (s : string) :
let state = Lwd.var (str, 0) in line Lwd_table.t =
{ focus; state; ui = edit_field ~focus state }
let line_append ?(table = Lwd_table.make ())
?(focus = Focus.make ()) str =
let row = Lwd_table.append table in
Lwd_table.set row (line_make ~focus str)
let line_table_of_string ?(table = Lwd_table.make ())
?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t =
(* Append lines from s to table *) (* Append lines from s to table *)
List.iter (line_append ~table) (String.split_on_char '\n' s); List.iter (line_append ~table) (String.split_on_char '\n' s);
(* create the cursor var *) table
let rec focus_compare focus : int =
Focus.(
match focus with
| Empty -> 0
| Handle (i, _) -> i
| Conflict i -> i)
let rec find_focus (ui : ui) : ui =
Focus.(
match (ui.focus, ui.desc) with
| Empty, _ -> Ui.empty
| Handle (_, _), _ -> ui
| Conflict _, (X (a, b) | Y (a, b) | Z (a, b)) ->
if focus_compare a.focus < focus_compare b.focus then
find_focus b
else find_focus a
| Conflict _, Atom _ -> Ui.empty
| ( Conflict _,
( Size_sensor (t, _)
| Mouse_handler (t, _)
| Focus_area (t, _)
| Event_filter (t, _)
| Transient_sensor (t, _)
| Permanent_sensor (t, _)
| Resize (t, _, _, _)
| Shift_area (t, _, _) ) ) ->
find_focus t)
(* let focused_row_of_table (table : line Lwd_table.t) =
Lwd_table.map_reduce
(fun row (line : line) -> (Some row, line))
( (None, line_empty ()),
(fun a b -> if focus_compare (Focus.status (snd a).focus) < focus_compare ).focus then b else a) )
table *)
let focus_move table f = `Unhandled
let edit_area ?(table = Lwd_table.make ()) ?(focus = Focus.make ())
() : Ui.t Lwd.t =
(* create the cursor var and focus on first table row *)
let cursor = Lwd.var @@ Lwd_table.first table in let cursor = Lwd.var @@ Lwd_table.first table in
Option.iter Option.iter
(fun cursor -> (fun cursor ->
@ -2818,6 +2879,7 @@ module Nottui_widgets = struct
in in
Lwd.set old_line.state (o_str, pos); Lwd.set old_line.state (o_str, pos);
let new_line = line_make n_str in let new_line = line_make n_str in
Focus.release old_line.focus;
Focus.request new_line.focus; Focus.request new_line.focus;
Lwd.set cursor Lwd.set cursor
(Some (Lwd_table.after old_row ~set:new_line)); (Some (Lwd_table.after old_row ~set:new_line));
@ -2825,22 +2887,24 @@ module Nottui_widgets = struct
| `Backspace, [] -> | `Backspace, [] ->
line_of_cursor cursor (fun row line -> line_of_cursor cursor (fun row line ->
let str, pos = Lwd.peek line.state in let str, pos = Lwd.peek line.state in
match Lwd_table.prev row with Ui.may_handle (Lwd_table.prev row)
| Some row_prev when pos = 0 -> ( (fun row_prev ->
match Lwd_table.get row_prev with if pos = 0 then
| Some line_prev -> Ui.may_handle (Lwd_table.get row_prev)
(fun line_prev ->
let str_prev, _ = let str_prev, _ =
Lwd.peek line_prev.state Lwd.peek line_prev.state
in in
Focus.release line.focus;
Focus.request line_prev.focus;
Lwd.set line_prev.state Lwd.set line_prev.state
( str_prev ^ str, ( str_prev ^ str,
String.length str_prev ); String.length str_prev );
Focus.request line_prev.focus;
Lwd_table.remove row;
Lwd.set cursor (Some row_prev); Lwd.set cursor (Some row_prev);
`Handled Lwd_table.remove row;
| None -> `Unhandled) `Handled)
| _ -> `Unhandled) else `Unhandled))
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
| _ -> `Unhandled)) | _ -> `Unhandled))
(Focus.status focus) (Focus.status focus)
@ -2894,6 +2958,7 @@ module Nottui_widgets = struct
box_render (Ui.join_x acc ui0) (i + w0) tl box_render (Ui.join_x acc ui0) (i + w0) tl
in in
box_render Ui.empty 0 l box_render Ui.empty 0 l
*)
(** Prints the summary, but calls [f()] to compute a sub-widget (** Prints the summary, but calls [f()] to compute a sub-widget
when clicked on. Useful for displaying deep trees. *) when clicked on. Useful for displaying deep trees. *)
@ -2906,7 +2971,7 @@ module Nottui_widgets = struct
| true -> | true ->
(* call [f] and pad a bit *) (* call [f] and pad a bit *)
f () |> Lwd.map ~f:(Ui.join_x (string " ")) f () |> Lwd.map ~f:(Ui.join_x (string " "))
| false -> empty_lwd | false -> Lwd.return Ui.empty
in in
(* pad summary with a "> " when it's opened *) (* pad summary with a "> " when it's opened *)
let summary = let summary =
@ -2914,7 +2979,7 @@ module Nottui_widgets = struct
summary >|= fun s -> summary >|= fun s ->
Ui.hcat Ui.hcat
[ [
string ~attr:attr_clickable (if op then "v" else ">"); string ~attr:A.clickable (if op then "v" else ">");
string " "; string " ";
s; s;
] ]
@ -2938,14 +3003,14 @@ module Nottui_widgets = struct
let spec_fold = Ui.layout_spec fold in let spec_fold = Ui.layout_spec fold in
(* TODO: somehow, probe for available width here? *) (* TODO: somehow, probe for available width here? *)
let too_big = let too_big =
spec_fold.Ui.h > 1 spec_fold.Ui.h > 20.
|| spec_fold.Ui.h > 0 || spec_fold.Ui.h > 20.
&& spec_sum.Ui.w + spec_fold.Ui.w > 60 && spec_sum.Ui.w +. spec_fold.Ui.w > 240.
in in
if too_big then if too_big then
Ui.join_y summary (Ui.join_x (string " ") fold) Ui.join_y summary (Ui.join_x (string " ") fold)
else Ui.join_x summary fold) else Ui.join_x summary fold)
*)
let hbox l = Lwd_utils.pack Ui.pack_x l let hbox l = Lwd_utils.pack Ui.pack_x l
let vbox l = Lwd_utils.pack Ui.pack_y l let vbox l = Lwd_utils.pack Ui.pack_y l
let zbox l = Lwd_utils.pack Ui.pack_z l let zbox l = Lwd_utils.pack Ui.pack_z l
@ -2953,7 +3018,7 @@ module Nottui_widgets = struct
let vlist ?(bullet = "- ") (l : Ui.t Lwd.t list) : Ui.t Lwd.t = let vlist ?(bullet = "- ") (l : Ui.t Lwd.t list) : Ui.t Lwd.t =
l l
|> List.map (fun ui -> Lwd.map ~f:(Ui.join_x (string bullet)) ui) |> List.map (fun ui -> Lwd.map ~f:(Ui.join_x (string bullet)) ui)
|> Lwd_utils.pack Ui.pack_y |> vbox
(** A list of items with a dynamic filter on the items *) (** A list of items with a dynamic filter on the items *)
let vlist_with ?(bullet = "- ") let vlist_with ?(bullet = "- ")
@ -2982,6 +3047,12 @@ module Nottui_widgets = struct
in in
l_filter >>= Lwd_utils.pack Ui.pack_y l_filter >>= Lwd_utils.pack Ui.pack_y
let vlist_of_text ?(focus = Focus.make ())
?(key_handler = fun _ -> `Unhandled) =
Lwd.map2 (Focus.status focus) ~f:(fun focus s ->
Ui.vcat @@ List.map string @@ String.split_on_char '\n' s
|> Ui.keyboard_area ~focus key_handler)
(* let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x) (* let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x)
(** A grid layout, with alignment in all rows/columns. (** A grid layout, with alignment in all rows/columns.
@ -3058,18 +3129,24 @@ module Nottui_widgets = struct
(* TODO: mouse and keyboard handling *) (* TODO: mouse and keyboard handling *)
let ui = Lwd_utils.reduce pack_pad_y rows in let ui = Lwd_utils.reduce pack_pad_y rows in
Lwd.return ui Lwd.return ui
*)
(** Turn the given [ui] into a clickable button, calls [f] when clicked. *) (** Turn the given [ui] into a clickable button, calls [f] when clicked. *)
let button_of ui f = let button_of ui f =
Ui.mouse_area Ui.keyboard_area
(function
| `Enter, _ ->
f ();
`Handled
| _ -> `Unhandled)
(* @@ Ui.mouse_area
(fun ~x:_ ~y:_ _ -> (fun ~x:_ ~y:_ _ ->
f (); f ();
`Handled) `Handled) *)
ui ui
(** A clickable button that calls [f] when clicked, labelled with a string. *) (** A clickable button that calls [f] when clicked, labelled with a string. *)
let button ?(attr = attr_clickable) s f = let button ?(attr = A.clickable) s f = button_of (string ~attr s) f
button_of (string ~attr s) f
(* file explorer for selecting a file *) (* file explorer for selecting a file *)
let file_select ?(abs = false) ?filter ~(on_select : string -> unit) let file_select ?(abs = false) ?filter ~(on_select : string -> unit)
@ -3100,14 +3177,16 @@ module Nottui_widgets = struct
else else
Lwd.return Lwd.return
@@ button @@ button
~attr:A.(st underline) ~attr:A.(font Font.underline)
path path
(fun () -> on_select path) (fun () -> on_select path)
with e -> with e ->
Lwd.return Lwd.return
@@ Ui.vcat @@ Ui.vcat
[ [
printf ~attr:A.(bg red) "cannot list directory %s" path; printf
~attr:A.(bg Color.red)
"cannot list directory %s" path;
string @@ Printexc.to_string e; string @@ Printexc.to_string e;
] ]
in in
@ -3122,7 +3201,7 @@ module Nottui_widgets = struct
Ui.hcat Ui.hcat
[ [
printf "[%s|" lbl_v; printf "[%s|" lbl_v;
string ~attr:attr_clickable (if st_v then "✔" else "×"); string ~attr:A.clickable (if st_v then "" else "×");
string "]"; string "]";
] ]
in in
@ -3143,7 +3222,7 @@ module Nottui_widgets = struct
toggle_ st lbl f toggle_ st lbl f
in in
(toggle, toggle') (toggle, toggle')
*)
type scrollbox_state = { type scrollbox_state = {
w : float; w : float;
h : float; h : float;