Selkie.git | lib/Selkie/App/Internal/ | Dispatch.rakumod
=begin pod
=head1 NAME
Selkie::App::Internal::Dispatch - internal input dispatch role for Selkie::App
=head1 DESCRIPTION
Implementation detail composed by C<Selkie::App>. Use C<Selkie::App.on-key>,
C<Selkie::App.event-supply>, and widget C<handle-event> methods from
application code.
=head2 Input tracing
Setting C<SELKIE_TERMINAL_DEBUG=1> makes this role log every raw event it
pulls off notcurses, and every event a widget claims, to C<STDERR>:
Selkie input at=<timestamp> raw-id=<id> evtype=<n> modifiers=<n> alt=<n> focus=<Widget::Class>
Selkie input handled at=<timestamp> id=<id> by=<Widget::Class>
This exists to diagnose input that arrives but never reaches the intended
widget — the class of bug where a keypress is swallowed, misrouted, or lands a
keystroke late. It answers "did notcurses deliver it, and who took it?".
The trace deliberately records B<no> effective text, key character, or widget
value: only the numeric event identity and the receiving class name. That is
what makes it safe to leave enabled while a password field has focus. Do not
add decoded text here.
The same variable also enables an unrelated one-shot pixel diagnostic at
startup — see C<Selkie::App>.
=end pod
unit role Selkie::App::Internal::Dispatch;
use Notcurses::Native;
use Notcurses::Native::Input;
use Notcurses::Native::Types;
use Selkie::App::Internal::HitTest;
use Selkie::App::Internal::TerminalReport;
use Selkie::Event;
use Selkie::Widget;
use Selkie::Tree;
has @!global-keybinds;
# Drag capture: when a button is pressed on widget X, subsequent motion/release
# for that button keep routing to X.
#
# Entries are dropped on release — but a release is not guaranteed to
# arrive (a terminal can lose it to a focus change, a screen swap, an
# app that tears the pressed widget down from its own press handler),
# and a leaked entry is not merely untidy: every later NCKEY_MOTION
# routes to `%!mouse-capture.values[0]`, so the leak silently redirects
# motion at a widget that may no longer exist. Two guards keep that
# from happening — `!prune-mouse-capture`, driven by the
# widget-destroyed observer below, and the routability test every
# capture read goes through.
has %!mouse-capture;
# Set (from any thread, including the GC finalizer thread that runs
# Widget.DESTROY) when a widget is destroyed anywhere in the process.
# The render thread reads and clears it before it next touches
# %!mouse-capture. An atomic flag rather than a direct delete on
# purpose: %!mouse-capture belongs to the render thread, and a Raku
# Hash mutated concurrently from a finalizer is a corruption bug, not
# a tidy one.
has atomicint $!mouse-capture-stale = 0;
# button => { abs-y, abs-x, time, count }
has %!last-click;
my constant DOUBLE-CLICK-MS = 300;
# Terminal mouse drivers occasionally deliver two press events for one
# physical click, arriving within the same input drain (sub-frame, well
# under a hardware-repeat interval). Every press target gets at least
# this same-cell suppression window. It must stay far below any human
# double-click gap (~80ms at the fastest) so ListView / Table /
# TextInput multi-click gestures keep working — this window drops
# driver duplicates, not user intent.
my constant DUPLICATE-PRESS-MS = 40;
# Last accepted press, per button. Used by the duplicate-press guard:
# widgets that opt into a C<debounce-ms> method (Button, Checkbox,
# Select, …) get their configured window; everything else gets the
# DUPLICATE-PRESS-MS floor. This is separate from %!last-click because
# real double clicks must still be COUNTED for click-count consumers.
has %!last-accepted-press;
has Supplier $!event-supplier = Supplier.new;
#| Safe, opt-in native input trace. Deliberately records no effective text or
#| widget value: this is usable while a password field has focus.
method !trace-raw-input(Ncinput $ni --> Nil) {
return unless (%*ENV<SELKIE_TERMINAL_DEBUG> // '') eq '1';
my $focused = self.focused;
my Str $target = $focused.defined ?? $focused.^name !! '<none>';
note "Selkie input at={DateTime.now.Str} raw-id={$ni.id} evtype={$ni.evtype} "
~ "modifiers={$ni.modifiers} alt={$ni.alt} focus={$target}";
Nil;
}
method !app-event-supply(--> Supply) {
$!event-supplier.Supply;
}
method !register-global-keybind(Str:D $spec, &handler, Str :$screen --> Nil) {
@!global-keybinds.push: {
keybind => Keybind.parse($spec, &handler),
screen => $screen,
};
}
#|( How many events the fragmented-report guard will look ahead over.
Generously above the longest real reply (an XTGETTCAP answer runs
to a few dozen characters) and far below a paste, which must keep
reaching C<flush-paste-batch> in one piece. )
my constant REPORT-SCAN-MAX-EVENTS = 320;
#|( How long the guard will hold a bare Escape waiting to see whether
an introducer follows it. Deliberately under one hot frame: an
Escape keypress closes a modal, and that must stay instant. The
cost of this being short is that a terminal reply fragmented
B<exactly> after its Escape byte is missed; the cost of it being
long is felt by every Escape the user presses. )
my constant ESCAPE-GRACE-SECONDS = 0.012e0;
#|( How long the guard will hold an Escape that is already followed by
a control-sequence introducer, waiting for the rest of the report
to arrive. Matches the quiet-gap the app's start-up drain uses.
This window is only ever entered by input that is already a valid
partial control sequence and nothing else, so the latency is not
something ordinary typing can provoke: the very first character
that cannot belong to a report ends the wait immediately and
everything collected is dispatched in order. )
my constant REPORT-WAIT-SECONDS = 0.05e0;
#| Poll interval while waiting for a fragmented report to complete.
my constant REPORT-POLL-SECONDS = 0.002e0;
#|( Drain the input queue behind an Escape and return the events that
survive report-stripping, appending everything read to C<@burst>
so the caller can count it.
Waits — briefly, and only while what has arrived so far is still a
viable partial report — for the rest of a fragmented reply. Under
load a terminal's answer to a capability query reaches notcurses
in pieces, and notcurses replays each piece as its own burst of
keypresses; without the wait the guard sees C<\e[?64;1;2>, cannot
match it, and types it into whatever has focus a frame before the
C<;6;9;15;18;21;22c> that would have completed it. )
method !collect-escape-burst($nc, @burst --> List) {
my Instant $started = now;
my @out;
loop {
while @burst.elems < REPORT-SCAN-MAX-EVENTS {
my $ni = Ncinput.new;
my $id = notcurses_get_nblock($nc, $ni);
last if $id == 0 || $id == -1;
@burst.push(Selkie::Event.from-ncinput($ni));
}
@out = self!strip-terminal-reports(@burst);
# Everything matched: done, and nothing to wait for.
last unless @out;
# The head is no longer a partial report — either it never was
# one, or a character arrived that rules it out. Either way the
# survivors go through untouched, right now.
last unless self!escape-event(@out[0])
&& terminal-report-viable(self!burst-text(@out));
last if @burst.elems >= REPORT-SCAN-MAX-EVENTS;
my Num $budget = @out.elems > 1
?? REPORT-WAIT-SECONDS
!! ESCAPE-GRACE-SECONDS;
last if (now - $started).Num >= $budget;
sleep REPORT-POLL-SECONDS;
}
@out.List;
}
#|( The leading run of single-character events as text, which is what
the recogniser works on. Stops at the first event with no
character — a synthesized key, a mouse report, a resize — because
a control sequence cannot span one. )
method !burst-text(@events --> Str) {
my Str $text = '';
for @events -> $ev {
my $c = $ev.char;
last unless $c.defined && $c.chars == 1;
$text ~= $c;
last if $text.chars >= REPORT-SCAN-MAX-EVENTS;
}
$text;
}
method !dispatch-input-burst($nc, Selkie::Event $first, Instant $frame-start --> Int) {
my Int $input-events = 1;
# Events pulled off notcurses ahead of dispatch. Only the
# fragmented-report guard below fills this; everything else drains
# one event at a time, exactly as it always did.
my @pending;
if self!escape-event($first) {
# An Escape at the head of a burst is the one shape a
# fragmented terminal reply can take (notcurses replays an
# aborted escape from its first byte). Collect what is queued
# behind it and strip any complete control sequence off the
# front — see Selkie::App::Internal::TerminalReport for why
# this cannot match something the user typed.
my @burst = ($first,);
@pending = self!collect-escape-burst($nc, @burst);
$input-events = @burst.elems;
# The whole burst was one (or more) terminal replies: nothing
# reaches the widget tree, and no keystroke was consumed to do
# it. This is the fix for the login-field injection.
return $input-events unless @pending;
} else {
@pending.push($first);
}
my $head = @pending.shift;
$!event-supplier.emit($head);
self!dispatch-event($head);
# Drain any further pending input with the non-blocking variant. Paste
# batching keeps text input from doing one O(n) buffer rebuild per char.
my @paste-batch;
loop {
my $ev2;
if @pending {
# Already pulled off notcurses by the guard above; these
# must be dispatched rather than re-read, and the frame
# budget below must not drop them on the floor.
$ev2 = @pending.shift;
} else {
my $ni2 = Ncinput.new;
my $id2 = notcurses_get_nblock($nc, $ni2);
# uint32 return: an error is NOTCURSES-GET-ERROR, never -1.
last if $id2 == 0 || $id2 == NOTCURSES-GET-ERROR;
self!trace-raw-input($ni2);
$ev2 = Selkie::Event.from-ncinput($ni2);
$input-events++;
}
if self!is-paste-char($ev2) && self!focused-can-insert-text {
@paste-batch.push($ev2.char);
} else {
if @paste-batch {
self!flush-paste-batch(@paste-batch.join(''));
@paste-batch = ();
}
$!event-supplier.emit($ev2);
self!dispatch-event($ev2);
}
last if !@pending && (now - $frame-start).Num > 0.2e0;
}
self!flush-paste-batch(@paste-batch.join('')) if @paste-batch;
$input-events;
}
#|( True for a bare Escape keypress — no modifiers, no mouse, the
literal C<0x1b> that notcurses replays as the first byte of an
escape sequence it gave up on. )
method !escape-event(Selkie::Event $ev --> Bool) {
$ev.event-type ~~ KeyEvent
&& $ev.id == NCKEY_ESC
&& !$ev.has-any-modifier;
}
#|( Drop every complete terminal report from the front of an
Escape-led burst, returning the events that survive.
Reports are only ever stripped from the head: once a character
that cannot be part of one is reached the rest of the burst is
returned untouched, so a reply immediately followed by real typing
(which is exactly what the login-screen incident looked like —
C<\e[?64;1;2;6;9;15;18;21;22c> arriving between two of the user's
keystrokes) loses the reply and keeps the typing.
Events with no character — synthesized keys, mouse, resize — end
the scan: they cannot be part of a control sequence, and a report
cannot span one. )
method !strip-terminal-reports(@burst --> List) {
return @burst.List unless @burst && self!escape-event(@burst[0]);
# Each event contributes exactly one character, so a match length
# in characters is also a match length in events.
my Int $matched = terminal-report-strip-length(self!burst-text(@burst));
return @burst.List if $matched == 0;
# Half-open slice: an exactly-consumed burst yields the empty list
# rather than a one-element list of Nil.
@burst[$matched ..^ @burst.elems].List;
}
method !focused-can-insert-text(--> Bool) {
my $focused = self.focused;
return False unless $focused.defined;
$focused.^can('insert-text').elems > 0;
}
method !is-paste-char(Selkie::Event $ev --> Bool) {
return False unless $ev.event-type ~~ KeyEvent;
return False unless $ev.input-type == NCTYPE_PRESS
|| $ev.input-type == NCTYPE_REPEAT
|| $ev.input-type == NCTYPE_UNKNOWN;
return False if $ev.has-modifier(Mod-Ctrl)
|| $ev.has-modifier(Mod-Alt)
|| $ev.has-modifier(Mod-Super);
return False unless $ev.char.defined && $ev.char.chars == 1;
my $ord = $ev.char.ord;
$ord >= 32 || $ord == 10 || $ord == 13;
}
method !flush-paste-batch(Str:D $text --> Nil) {
return if $text.chars == 0;
my $focused = self.focused;
return unless $focused.defined && $focused.^can('insert-text').elems > 0;
$focused.insert-text($text);
}
method !dispatch-event(Selkie::Event $ev --> Nil) {
if $ev.event-type ~~ ResizeEvent {
self!check-terminal-resize;
return;
}
if $ev.event-type ~~ MouseEvent {
self!dispatch-mouse($ev);
return;
}
return if $ev.input-type == NCTYPE_RELEASE;
my $top = self!active-modal;
if $top.defined {
my $focused = self.focused;
if $focused.defined {
my $widget = $focused;
my int $hops = 0;
while $widget.defined && $widget !=== $top {
return if $widget.handle-event($ev);
$widget = next-ancestor($widget, $hops);
$hops = $hops + 1;
}
}
return if $top.handle-event($ev);
self!dispatch-global-keybind($ev);
return;
}
self!bubble-event($ev);
}
#|( Called (indirectly, through C<Selkie::Tree>'s widget-destroyed
observer) whenever any widget in the process is destroyed. Runs on
the destroying thread — possibly the GC finalizer thread — so it
does nothing but raise a flag; C<!prune-mouse-capture> does the
work on the render thread. )
method !note-widget-destroyed(Mu $ --> Nil) {
$!mouse-capture-stale ⚛= 1;
Nil;
}
#|( True when a captured widget can still be delivered to: it exists,
it has not been torn down, and it is still attached to the surface
that owns input. The attachment test is what catches a widget whose
screen was swapped out from under a held button; C<is-destroyed>
catches the case attachment cannot, since
C<Selkie::Container.remove> destroys a child without clearing its
C<parent>, leaving a dead widget that still walks up to the root. )
method !capture-routable(Mu $w --> Bool) {
return False without $w;
return False if $w.is-destroyed;
my $modal = self!active-modal;
my $root = $modal.defined ?? $modal !! self.root;
return False without $root;
self.widget-attached($w, $root);
}
#|( Drop every capture entry that is no longer routable. Cheap and
bounded — the table holds at most one entry per mouse button. The
key list is materialised into an Array first: deleting from a Hash
while iterating its live C<.keys> Seq is undefined behaviour. )
method !drop-unroutable-captures(--> Nil) {
return unless %!mouse-capture;
my @buttons = %!mouse-capture.keys;
for @buttons -> $btn {
%!mouse-capture{$btn}:delete
unless self!capture-routable(%!mouse-capture{$btn});
}
Nil;
}
#|( Prune the capture table if — and only if — a widget has been
destroyed since the last check, so the common case costs one
atomic read. )
method !prune-mouse-capture(--> Nil) {
return unless $!mouse-capture-stale ⚛== 1;
$!mouse-capture-stale ⚛= 0;
self!drop-unroutable-captures;
}
# Test/introspection seam: how many buttons currently hold a capture.
method !mouse-capture-count(--> Int) {
%!mouse-capture.elems;
}
method !dispatch-mouse(Selkie::Event $ev --> Nil) {
my Int $y = $ev.y;
my Int $x = $ev.x;
return if $y < 0 || $x < 0;
# Anything destroyed since the last mouse event leaves the capture
# table stale; clear it out before any routing decision reads it.
self!prune-mouse-capture;
# Wheel events are encoded as buttons 4/5 but must not take part
# in button semantics: suppressing them as "duplicate presses"
# throttles flick-scrolling over debounced controls, counting them
# produces phantom click-counts, and capturing them leaks a
# permanent %!mouse-capture entry (a wheel "press" never gets a
# release). They keep the click-to-focus walk below — focus
# following scroll is long-standing behavior widgets rely on.
my $is-wheel = self!is-wheel-id($ev.id);
my $is-button = self!is-button-id($ev.id) && !$is-wheel;
my $is-motion = $ev.id == NCKEY_MOTION;
my UInt $btn = self!button-from-id($ev.id);
my $target;
my $is-drag-event = $is-button && $ev.input-type == NCTYPE_REPEAT;
if $is-drag-event {
my $held = %!mouse-capture{$btn};
if $held.defined && !self!capture-routable($held) {
%!mouse-capture{$btn}:delete;
$held = Nil;
}
$target = $held // self!widget-at($y, $x);
} elsif $is-motion {
# Motion is never hit-tested — Selkie does not hover-route, so
# it goes to whoever holds a capture or nowhere at all.
# Validate that holder rather than trusting the table: an entry
# can outlive the widget it names (see the note on
# %!mouse-capture), and delivering to a destroyed widget hands
# an event to a widget whose plane has been freed.
return unless %!mouse-capture;
my $held = %!mouse-capture.values[0];
unless self!capture-routable($held) {
self!drop-unroutable-captures;
return;
}
$target = $held;
} else {
$target = self!widget-at($y, $x);
}
my $modal = self!active-modal;
if $modal.defined {
my $in-modal = $target.defined && self.widget-attached($target, $modal);
unless $in-modal {
if $modal.can('dismiss-on-click-outside')
&& $modal.dismiss-on-click-outside
&& self!modal-is-dismissable($modal)
&& $is-button
&& $ev.input-type == NCTYPE_PRESS {
self.close-modal;
}
return;
}
}
return without $target;
return if $is-button
&& $ev.input-type == NCTYPE_PRESS
&& self!suppress-duplicate-press($target, $btn, $y, $x);
if ($is-button || $is-wheel) && $ev.input-type == NCTYPE_PRESS {
my $w = $target;
my $focused = self.focused;
my int $hops = 0;
while $w.defined {
# A widget in a disabled subtree refuses click-to-focus the
# same way it refuses Tab — and "in a disabled subtree"
# means the same thing here as everywhere else, so a
# control whose own flag is clear but whose pane is
# switched off is skipped too. The walk continues up rather
# than stopping: clicking a greyed field inside a live form
# should still be able to land on an enclosing focusable
# (which, above the disabled container, is eligible again).
if $w.focusable && self.focus-eligible($w) {
self.focus($w) unless $w === $focused;
last;
}
$w = next-ancestor($w, $hops);
$hops = $hops + 1;
}
}
my $delivered = $ev;
if $is-button && $ev.input-type == NCTYPE_PRESS {
my $count = 1;
if %!last-click{$btn}:exists {
my %prev = %!last-click{$btn};
if %prev<abs-y> == $y && %prev<abs-x> == $x
&& (now - %prev<time>).Num * 1000 < DOUBLE-CLICK-MS {
$count = %prev<count> + 1;
}
}
%!last-click{$btn} = {
abs-y => $y, abs-x => $x, time => now, count => $count,
};
$delivered = $ev.with-click-count($count);
}
if $is-button {
if $ev.input-type == NCTYPE_PRESS {
%!mouse-capture{$btn} = $target;
} elsif $ev.input-type == NCTYPE_RELEASE {
%!mouse-capture{$btn}:delete;
}
}
my $w = $target;
my $stop-at = $modal.defined ?? $modal.parent !! Selkie::Widget;
my int $bubble-hops = 0;
while $w.defined && $w !=== $stop-at {
return if $w.handle-event($delivered);
$w = next-ancestor($w, $bubble-hops);
$bubble-hops = $bubble-hops + 1;
}
}
#|( True when this press should be dropped as a duplicate of the last
accepted press: same button, same cell, inside the window. Widgets
that expose C<debounce-ms> choose their own window (0 disables);
everything else gets the DUPLICATE-PRESS-MS floor, so a driver
double-fire can't reach ANY widget twice — including click-count
consumers, where the duplicate would otherwise register as a
phantom double-click. The window is keyed on the cell rather than
the widget: a duplicate that lands after the first press already
changed the layout (committed a dropdown, opened a modal) is still
the same physical click and still gets dropped. )
method !suppress-duplicate-press($target, UInt:D $btn, Int:D $y, Int:D $x --> Bool) {
my UInt $window-ms = ($target.defined && $target.can('debounce-ms'))
?? $target.debounce-ms.UInt
!! DUPLICATE-PRESS-MS;
return False unless $window-ms > 0;
my $now = now;
if %!last-accepted-press{$btn}:exists {
my %prev = %!last-accepted-press{$btn};
if %prev<abs-y> == $y
&& %prev<abs-x> == $x
&& ($now - %prev<time>).Num * 1000 < $window-ms {
return True;
}
}
%!last-accepted-press{$btn} = {
abs-y => $y,
abs-x => $x,
time => $now,
};
False;
}
method !is-button-id(UInt $id --> Bool) {
$id >= NCKEY_BUTTON1 && $id <= NCKEY_BUTTON11;
}
#| Wheel events ride the button encoding (4 = up, 5 = down) but are
#| not clicks — see the wheel note in C<!dispatch-mouse>.
method !is-wheel-id(UInt $id --> Bool) {
$id == NCKEY_BUTTON4 || $id == NCKEY_BUTTON5;
}
method !button-from-id(UInt $id --> UInt) {
given $id {
when NCKEY_BUTTON1 { 1 }
when NCKEY_BUTTON2 { 2 }
when NCKEY_BUTTON3 { 3 }
when NCKEY_BUTTON4 { 0 }
when NCKEY_BUTTON5 { 0 }
when NCKEY_BUTTON6 { 6 }
when NCKEY_BUTTON7 { 7 }
when NCKEY_BUTTON8 { 8 }
when NCKEY_BUTTON9 { 9 }
when NCKEY_BUTTON10 { 10 }
when NCKEY_BUTTON11 { 11 }
default { 0 }
}
}
method !widget-at(Int $y, Int $x --> Selkie::Widget) {
my $modal = self!active-modal;
my $root = $modal.defined ?? $modal !! self.root;
return Selkie::Widget without $root;
app-widget-at-in($root, $y, $x);
}
method !bubble-event(Selkie::Event $ev --> Bool) {
my $widget = self.focused;
my int $hops = 0;
while $widget.defined {
if $widget.handle-event($ev) {
note "Selkie input handled at={DateTime.now.Str} id={$ev.id} "
~ "by={$widget.^name}"
if (%*ENV<SELKIE_TERMINAL_DEBUG> // '') eq '1';
return True;
}
$widget = next-ancestor($widget, $hops);
$hops = $hops + 1;
}
self!dispatch-global-keybind($ev);
}
method !dispatch-global-keybind(Selkie::Event $ev --> Bool) {
my $active-screen = self.screen-manager.active-screen // '';
for @!global-keybinds -> %entry {
next if %entry<screen>.defined && %entry<screen> ne $active-screen;
if %entry<keybind>.matches($ev) {
%entry<keybind>.handler.($ev);
return True;
}
}
False;
}