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 vg = graphv_initialize webgl_ctx 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 gravity_pad = Gravity.make ~h:`Negative ~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 ui =
Nottui_widgets.(
let string s = Lwd.pure @@ Nottui_widgets.string s in
line_table_of_string
edit_area
~table:
(multifield_of_string
"edit me?\n\
derp derp 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
[
edit_field edit_me;

233
human.ml
View File

@ -1,3 +1,5 @@
(* why *)
(*
names?:
@ -517,7 +519,7 @@ module Input = struct
let pp_mods =
F.(
list (fun ppf -> function
list ~sep:F.sp (fun ppf -> function
| `Super -> pf ppf "`Super"
| `Meta -> pf ppf "`Meta"
| `Ctrl -> pf ppf "`Ctrl"
@ -810,6 +812,14 @@ module Style = struct
NVG.set_fill_color vg ~color:s.bg;
NVG.set_stroke_color vg ~color:s.fg;
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
module Pad = struct
@ -1374,7 +1384,7 @@ module Nottui = struct
let pp_key =
F.(
pair
pair ~sep:F.sp
(fun ppf v ->
match v with
| `Copy -> pf ppf "`Copy"
@ -1673,22 +1683,6 @@ module Nottui = struct
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 rec aux ui =
match ui.focus with
@ -2006,6 +2000,12 @@ module Nottui = struct
let cache =
match t.desc with
| 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;
vy = Interval.make 0. sh;
@ -2158,10 +2158,13 @@ module Nottui = struct
raise Acquired_focus
| Focus.Conflict _ -> iter aux ui
in
Log.debug (fun m -> m "grab_focus");
try
aux ui;
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 =
match t.desc with
@ -2175,8 +2178,13 @@ module Nottui = struct
| Event_filter (t, _) ->
dispatch_focus t dir
| Focus_area (t', _) ->
if Focus.has_focus t'.focus then
dispatch_focus t' dir || grab_focus t
if Focus.has_focus t'.focus then (
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 grab_focus t
| X (a, b) -> (
@ -2234,9 +2242,10 @@ module Nottui = struct
let dir = if List.mem `Shift mods then `Prev else `Next in
dispatch_key st (`Focus dir, mods)
| `Unhandled, (`Focus dir, _) ->
Log.warn (fun m ->
m "Renderer.dispatch_focus %a" pp_key key);
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
let dispatch_event t = function
@ -2354,14 +2363,6 @@ module Nottui_widgets = struct
let kfmt k ?attr 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 = {
overlays : ui Lwd.t Lwd_table.t;
view : ui Lwd.t;
@ -2501,7 +2502,7 @@ module Nottui_widgets = struct
|> Ui.keyboard_area focus_handler)
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 overlay = ref false in
let on_click ~x:_ ~y:_ = function
@ -2521,7 +2522,7 @@ module Nottui_widgets = struct
else ui)
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 overlay = ref false in
let on_click ~x:_ ~y:_ = function
@ -2541,7 +2542,7 @@ module Nottui_widgets = struct
else ui)
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
| `Left ->
f ();
@ -2642,51 +2643,44 @@ module Nottui_widgets = struct
in
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
let sub' str p l =
if p = 0 && l = String.length str then str else String.sub str p l
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
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 pos = min (max 0 pos) (String.length text) in
let content =
Ui.atom @@ I.hcat
@@
if Focus.has_focus focus then
let attr = attr_clickable in
let attr = A.clickable in
let len = String.length text in
if pos >= len then
[ I.string ~attr text; I.string ~attr:attr_cursor " " ]
[ I.string ~attr text; I.string ~attr:A.cursor " " ]
else
[
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
(String.sub text (pos + 1) (len - pos - 1));
]
else [ I.string (if text = "" then " " else text) ]
in
let handler k =
let on_change a =
Lwd.set state (on_change a);
`Handled
in
(match k with
| `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
on_change ("", 0);
`Handled (* clear *)
| `Escape, [] ->
Focus.release focus_h;
`Handled
| `Uchar k, _ ->
let k = Uchar.unsafe_to_char k in
let text =
on_change ("", 0) (* clear *)
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' ->
(* TODO put killed text into kill-ring *)
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
on_change (String.sub text 0 pos, pos)
else `Unhandled (* kill *)
| `Backspace, [] ->
if pos > 0 then (
if pos > 0 then
let text =
if pos < String.length text then
String.sub text 0 (pos - 1)
@ -2696,23 +2690,28 @@ module Nottui_widgets = struct
else text
in
let pos = max 0 (pos - 1) in
on_change (text, pos);
`Handled)
on_change (text, pos)
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, _ ->
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
if pos > 0 then on_change (text, pos - 1) else `Unhandled
| `Arrow `Right, [] ->
let pos = pos + 1 in
if pos <= String.length text then (
on_change (text, pos);
`Handled)
if pos <= String.length text then on_change (text, pos)
else `Unhandled
| _ -> `Unhandled)
|> fun r ->
@ -2739,14 +2738,19 @@ module Nottui_widgets = struct
open Lwd.Infix
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
type line = {
focus : Focus.handle;
state : (string * int) Lwd.var;
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 state = Lwd.var (str, 0) in
{ focus; state; ui = edit_field ~focus state }
@ -2789,11 +2793,52 @@ module Nottui_widgets = struct
| None -> `Unhandled)
| None -> `Unhandled
let line_table_of_string ?(table = Lwd_table.make ())
?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t =
let multifield_of_string ?(table = Lwd_table.make ()) (s : string) :
line Lwd_table.t =
(* Append lines from s to table *)
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
Option.iter
(fun cursor ->
@ -2859,6 +2904,7 @@ module Nottui_widgets = struct
Lwd_table.remove row;
`Handled)
else `Unhandled))
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
| _ -> `Unhandled))
(Focus.status focus)
@ -2912,6 +2958,7 @@ module Nottui_widgets = struct
box_render (Ui.join_x acc ui0) (i + w0) tl
in
box_render Ui.empty 0 l
*)
(** Prints the summary, but calls [f()] to compute a sub-widget
when clicked on. Useful for displaying deep trees. *)
@ -2924,7 +2971,7 @@ module Nottui_widgets = struct
| true ->
(* call [f] and pad a bit *)
f () |> Lwd.map ~f:(Ui.join_x (string " "))
| false -> empty_lwd
| false -> Lwd.return Ui.empty
in
(* pad summary with a "> " when it's opened *)
let summary =
@ -2932,7 +2979,7 @@ module Nottui_widgets = struct
summary >|= fun s ->
Ui.hcat
[
string ~attr:attr_clickable (if op then "v" else ">");
string ~attr:A.clickable (if op then "v" else ">");
string " ";
s;
]
@ -2956,14 +3003,14 @@ module Nottui_widgets = struct
let spec_fold = Ui.layout_spec fold in
(* TODO: somehow, probe for available width here? *)
let too_big =
spec_fold.Ui.h > 1
|| spec_fold.Ui.h > 0
&& spec_sum.Ui.w + spec_fold.Ui.w > 60
spec_fold.Ui.h > 20.
|| spec_fold.Ui.h > 20.
&& spec_sum.Ui.w +. spec_fold.Ui.w > 240.
in
if too_big then
Ui.join_y summary (Ui.join_x (string " ") fold)
else Ui.join_x summary fold)
*)
let hbox l = Lwd_utils.pack Ui.pack_x l
let vbox l = Lwd_utils.pack Ui.pack_y 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 =
l
|> 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 *)
let vlist_with ?(bullet = "- ")
@ -3000,6 +3047,12 @@ module Nottui_widgets = struct
in
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)
(** A grid layout, with alignment in all rows/columns.
@ -3076,18 +3129,24 @@ module Nottui_widgets = struct
(* TODO: mouse and keyboard handling *)
let ui = Lwd_utils.reduce pack_pad_y rows in
Lwd.return ui
*)
(** Turn the given [ui] into a clickable button, calls [f] when clicked. *)
let button_of ui f =
Ui.mouse_area
Ui.keyboard_area
(function
| `Enter, _ ->
f ();
`Handled
| _ -> `Unhandled)
(* @@ Ui.mouse_area
(fun ~x:_ ~y:_ _ ->
f ();
`Handled)
`Handled) *)
ui
(** A clickable button that calls [f] when clicked, labelled with a string. *)
let button ?(attr = attr_clickable) s f =
button_of (string ~attr s) f
let button ?(attr = A.clickable) s f = button_of (string ~attr s) f
(* file explorer for selecting a file *)
let file_select ?(abs = false) ?filter ~(on_select : string -> unit)
@ -3118,14 +3177,16 @@ module Nottui_widgets = struct
else
Lwd.return
@@ button
~attr:A.(st underline)
~attr:A.(font Font.underline)
path
(fun () -> on_select path)
with e ->
Lwd.return
@@ 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;
]
in
@ -3140,7 +3201,7 @@ module Nottui_widgets = struct
Ui.hcat
[
printf "[%s|" lbl_v;
string ~attr:attr_clickable (if st_v then "✔" else "×");
string ~attr:A.clickable (if st_v then "✔" else "×");
string "]";
]
in
@ -3161,7 +3222,7 @@ module Nottui_widgets = struct
toggle_ st lbl f
in
(toggle, toggle')
*)
type scrollbox_state = {
w : float;
h : float;