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

key press display

Browse Source
This commit is contained in:
cqc
2023-02-06 09:36:14 -06:00
parent 0df5884a88
commit 2ec6426fe5
2 changed files with 55 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
human.ml
View File

@ -514,12 +514,13 @@ module Input = struct
let pp_code ppf v = F.pf ppf "%s" (string_of_code v)
type mods = [ `Super | `Meta | `Ctrl | `Shift ] list
type mods = [ `Super | `Meta | `Ctrl | `Shift | `Alt ] list
let pp_mods =
F.(
list ~sep:F.sp (fun ppf -> function
| `Super -> pf ppf "`Super"
| `Alt -> pf ppf "`Alt"
| `Meta -> pf ppf "`Meta"
| `Ctrl -> pf ppf "`Ctrl"
| `Shift -> pf ppf "`Shift"))
@ -557,10 +558,10 @@ module Event_js = struct
| Some s' -> `Uchar s'
| None -> `Unknown s))
| None -> `Unknown "keypress .key is None?"),
(if Js.to_bool evt##.altKey then [ `Meta ] else [])
(if Js.to_bool evt##.altKey then [ `Alt ] else [])
@ (if Js.to_bool evt##.shiftKey then [ `Shift ] else [])
@ (if Js.to_bool evt##.ctrlKey then [ `Ctrl ] else [])
@ if Js.to_bool evt##.metaKey then [ `Super ] else [] )
@ if Js.to_bool evt##.metaKey then [ `Meta ] else [] )
end
open Gg
@ -1417,10 +1418,7 @@ module Nottui = struct
type mouse = Input.mouse
type event =
[ `Key of key
| `Key_list of key list
| `Mouse of mouse
| `Paste of Input.paste ]
[ `Keys of keys | `Mouse of mouse | `Paste of Input.paste ]
type layout_spec = {
w : float;
@ -1457,7 +1455,7 @@ module Nottui = struct
| Pad of 'a * (float * float * float * float)
| Shift_area of 'a * float * float
| Event_filter of
'a * ([ `Key of keys | `Mouse of mouse ] -> may_handle)
'a * ([ `Keys of keys | `Mouse of mouse ] -> may_handle)
| X of 'a * 'a
| Y of 'a * 'a
| Z of 'a * 'a
@ -2195,7 +2193,7 @@ module Nottui = struct
| Resize (t, _, _, _) ->
iter (t :: tl)
| Event_filter (t, f) -> (
match f (`Key keys) with
match f (`Keys keys) with
| `Unhandled -> iter (t :: tl)
| `Handled -> `Handled))
in
@ -2309,8 +2307,7 @@ module Nottui = struct
| `Unhandled, _ -> `Unhandled
let dispatch_event t = function
| `Key key -> dispatch_key t [ key ]
| `Key_list keys -> dispatch_key t keys
| `Keys keys -> dispatch_key t keys
| `Mouse mouse -> dispatch_mouse t mouse
| `Paste _ -> `Unhandled
end
@ -2369,21 +2366,30 @@ module Nottui_lwt = struct
push (Some (Renderer.image vg renderer))
in
refresh ();
let key_list = ref [] in
let process_event e =
match e with
| `Key (`Uchar c, [ `Meta ]) as event
| `Keys [ (`Uchar c, [ `Meta ]) ] as event
when Uchar.(equal c (of_char 'q')) -> (
match do_quit with
| Some u -> Lwt.wakeup u ()
| None -> ignore (Renderer.dispatch_event renderer event))
| `Keys [ (`Unknown _, _) ] -> ()
| `Keys k -> (
key_list := !key_list @ k;
match
Renderer.dispatch_event renderer (`Keys !key_list)
with
| `Handled -> key_list := []
| `Unhandled -> ())
| #Ui.event as event -> (
match Renderer.dispatch_event renderer event with
| `Handled -> ()
| `Unhandled ->
(* Log.warn (fun m ->
Log.warn (fun m ->
m
"Nottui_lwt.render process_event #Ui.event -> \
`Unhandled") *)
`Unhandled");
())
| `Resize size' ->
size := size';
@ -2419,6 +2425,7 @@ module Widgets = struct
let float_ ?attr x = string ?attr (string_of_float x)
let printf ?attr fmt = Printf.ksprintf (string ?attr) fmt
let fmt ?attr fmt = Format.kasprintf (string ?attr) fmt
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
let kprintf k ?attr fmt =
Printf.ksprintf (fun str -> k (string ?attr str)) fmt
@ -2431,16 +2438,40 @@ module Widgets = struct
view : ui Lwd.t;
}
let display_keys (k : Ui.keys option Lwd.var) : Ui.t Lwd.t =
Lwd.map (Lwd.get k) ~f:(function
| Some k' -> string (F.str "%a" Ui.pp_keys k')
| None -> string "---")
let window_manager base =
let overlays = Lwd_table.make () in
let composition =
Lwd.join
(Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_z) overlays)
in
let keys = Lwd.var None in
let view =
Lwd.map2 base composition ~f:(fun base composite ->
Ui.join_z base
(Ui.resize_to (Ui.layout_spec base) composite))
Ui.event_filter
(function
| `Keys k' ->
Log.debug (fun m ->
m "event_filter: window_manager `Keys %a"
Ui.pp_keys k');
Lwd.set keys (Some k');
if
List.mem
(`Uchar (Uchar.of_char 'g'), [ `Ctrl ])
k'
then `Handled
else `Unhandled
| _ -> `Unhandled)
(Ui.join_z base
(Ui.resize_to (Ui.layout_spec base) composite)))
in
let view =
Lwd.map2 view (display_keys keys) ~f:(fun view extra ->
Ui.join_y view extra)
in
{ overlays; view }
@ -2708,8 +2739,6 @@ module Widgets = struct
in
Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
let eq_uc_c uc c = Uchar.(equal uc (of_char c))
let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id) state
=
let update focus_h focus (text, pos) =
@ -2740,6 +2769,12 @@ module Widgets = struct
| [ (`Uchar c, [ `Ctrl ]) ] when Uchar.(equal c (of_char 'U'))
->
on_change ("", 0) (* clear *)
| [ (`End, []) ] -> on_change (text, String.length text)
| [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'e' ->
on_change (text, String.length text)
| [ (`Home, []) ] -> on_change (text, 0)
| [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'a' ->
on_change (text, String.length text)
| [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' ->
(* TODO put killed text into kill-ring *)
if pos < String.length text then
@ -2767,7 +2802,7 @@ module Widgets = struct
else text ^ String.make 1 k
in
on_change (text, pos + 1)
| [ (`Escape, []) ] ->
| [ _; (`Escape, []) ] ->
Focus.release focus_h;
`Handled
| [ (`Arrow `Left, []) ] ->