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.
=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;
has @!global-keybinds;
# Drag capture: when a button is pressed on widget X, subsequent motion/release
# for that button keep routing to X.
has %!mouse-capture;
# 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;
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);
last if $id2 == 0 || $id2 == -1;
$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;
while $widget.defined && $widget !=== $top {
return if $widget.handle-event($ev);
$widget = $widget.parent;
}
}
return if $top.handle-event($ev);
self!dispatch-global-keybind($ev);
return;
}
self!bubble-event($ev);
}
method !dispatch-mouse(Selkie::Event $ev --> Nil) {
my Int $y = $ev.y;
my Int $x = $ev.x;
return if $y < 0 || $x < 0;
# 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 {
$target = %!mouse-capture{$btn} // self!widget-at($y, $x);
} elsif $is-motion {
return unless %!mouse-capture;
$target = %!mouse-capture.values[0];
} 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;
while $w.defined {
# A disabled widget refuses click-to-focus the same way it
# refuses Tab. 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, and the
# disabled widget's own subtree is unreachable regardless.
if $w.focusable && !$w.disabled {
self.focus($w) unless $w === $focused;
last;
}
$w = $w.parent;
}
}
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;
while $w.defined && $w !=== $stop-at {
return if $w.handle-event($delivered);
$w = $w.parent;
}
}
#|( 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;
while $widget.defined {
return True if $widget.handle-event($ev);
$widget = $widget.parent;
}
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;
}