console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

text_area improvements

Browse Source
This commit is contained in:
cqc
2022-12-18 11:14:37 -06:00
parent 3509930195
commit 048ea0eab4
3 changed files with 7101 additions and 6537 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13132
_build/default/boot_js.bc.js
View File

File diff suppressed because one or more lines are too long

15
boot_js.ml
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;

233
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
@ -1374,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"
@ -1673,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
@ -2006,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;
@ -2158,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
@ -2175,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) -> (
@ -2234,9 +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, _) ->
Log.warn (fun m -> let r = dispatch_focus st.view dir in
m "Renderer.dispatch_focus %a" pp_key key); (if r then Log.debug else Log.warn) (fun m ->
if dispatch_focus st.view dir then `Handled else `Unhandled 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
@ -2354,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;
@ -2501,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
@ -2521,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
@ -2541,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 ();
@ -2642,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)
@ -2696,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 ->
@ -2739,14 +2738,19 @@ module Nottui_widgets = struct
open Lwd.Infix open Lwd.Infix
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
type line = { type line = {
focus : Focus.handle; focus : Focus.handle;
state : (string * int) Lwd.var; state : (string * int) Lwd.var;
ui : Ui.t Lwd.t; ui : Ui.t Lwd.t;
} }
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 line_make ?(focus = Focus.make ()) str =
let state = Lwd.var (str, 0) in let state = Lwd.var (str, 0) in
{ focus; state; ui = edit_field ~focus state } { focus; state; ui = edit_field ~focus state }
@ -2789,11 +2793,52 @@ module Nottui_widgets = struct
| None -> `Unhandled) | None -> `Unhandled)
| None -> `Unhandled | None -> `Unhandled
let line_table_of_string ?(table = Lwd_table.make ()) let multifield_of_string ?(table = Lwd_table.make ()) (s : string) :
?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t = line Lwd_table.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 ->
@ -2859,6 +2904,7 @@ module Nottui_widgets = struct
Lwd_table.remove row; Lwd_table.remove row;
`Handled) `Handled)
else `Unhandled)) else `Unhandled))
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
| _ -> `Unhandled)) | _ -> `Unhandled))
(Focus.status focus) (Focus.status focus)
@ -2912,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. *)
@ -2924,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 =
@ -2932,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;
] ]
@ -2956,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
@ -2971,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 = "- ")
@ -3000,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.
@ -3076,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)
@ -3118,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
@ -3140,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
@ -3161,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;