Selkie.git | t/ | 59-mouse-dispatch.rakutest

---

use Test;
use lib 'lib';

use Notcurses::Native::Types;

use Selkie::App;
use Selkie::App::Internal::Dispatch;
use Selkie::Widget;
use Selkie::Container;
use Selkie::Widget::Button;
use Selkie::Widget::Modal;
use Selkie::Widget::TextInput;
use Selkie::Event;
use Selkie::Test::Keys;

# Mouse dispatch foundation. Most of the App-instance flow (capture,
# click-to-focus, modal isolation) needs notcurses_init and is covered
# by manual smoke in App-Cantina (see the v1 plan); this file pins
# down the pieces that ARE testable in-process: hit-testing, the
# event-classification helpers, the Selkie::Event annotation API, the
# default Widget.handle-event mouse fan-out, and Modal's new
# dismiss-on-click-outside default.

# Tiny test container — same pattern as t/focus-invariant.rakutest.
class TestContainer does Selkie::Container {
    method render() { self!render-children; self.clear-dirty }
}

# Helper: position a widget on screen by setting its viewport state
# directly. In production the layout pass does this — in tests we want
# fast deterministic placement without spinning notcurses.
sub place(Selkie::Widget $w, :$abs-y!, :$abs-x!, :$rows!, :$cols!) {
    $w.set-viewport(:$abs-y, :$abs-x, :$rows, :$cols);
}

plan 18;

subtest "mouse-event-button extracts the 1-indexed button" => {
    plan 6;
    is mouse-event-button(mouse-event(id => NCKEY_BUTTON1)), 1, 'BUTTON1 → 1';
    is mouse-event-button(mouse-event(id => NCKEY_BUTTON2)), 2, 'BUTTON2 → 2';
    is mouse-event-button(mouse-event(id => NCKEY_BUTTON3)), 3, 'BUTTON3 → 3';
    is mouse-event-button(mouse-event(id => NCKEY_SCROLL_UP)), 4,
        'SCROLL_UP is button 4 by encoding';
    is mouse-event-button(mouse-event(id => NCKEY_SCROLL_DOWN)), 5,
        'SCROLL_DOWN is button 5';
    is mouse-event-button(mouse-event(id => NCKEY_MOTION)), 0,
        'pure motion has no button';
};

subtest "mouse-event-kinds fans out by input type" => {
    plan 5;
    is-deeply mouse-event-kinds(
        mouse-event(id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS)
    ).List, <click mouse-down>.List,
        'press fans out to click + mouse-down';
    is-deeply mouse-event-kinds(
        mouse-event(id => NCKEY_BUTTON1, input-type => NCTYPE_RELEASE)
    ).List, ('mouse-up',).List,
        'release fires mouse-up only';
    is-deeply mouse-event-kinds(
        mouse-event(id => NCKEY_BUTTON1, input-type => NCTYPE_REPEAT)
    ).List, ('drag',).List,
        'repeat (button held + motion) fires drag';
    is-deeply mouse-event-kinds(
        mouse-event(id => NCKEY_SCROLL_UP)
    ).List, ('scroll',).List,
        'scroll wheel fires scroll regardless of input-type';
    is-deeply mouse-event-kinds(
        mouse-event(id => NCKEY_MOTION)
    ).List, ('drag',).List,
        'pure motion classifies as drag';
};

subtest "Widget.contains-point uses viewport rect" => {
    plan 6;
    my $w = Selkie::Widget::Button.new(label => 'x');
    nok $w.contains-point(0, 0),
        'unmounted widget (zero viewport) contains nothing';

    place($w, abs-y => 5, abs-x => 10, rows => 3, cols => 8);
    ok  $w.contains-point(5, 10),  'top-left corner is inside';
    ok  $w.contains-point(7, 17),  'bottom-right corner (5+3-1, 10+8-1) is inside';
    nok $w.contains-point(4, 10),  'one cell above is outside';
    nok $w.contains-point(8, 10),  'one row past bottom is outside';
    nok $w.contains-point(5, 18),  'one col past right is outside';
};

subtest "Widget.local-row / local-col" => {
    plan 4;
    my $w = Selkie::Widget::Button.new(label => 'x');
    place($w, abs-y => 5, abs-x => 10, rows => 3, cols => 8);
    is $w.local-row(mouse-event(id => NCKEY_BUTTON1, y => 5, x => 10)), 0,
        'top of widget → local row 0';
    is $w.local-col(mouse-event(id => NCKEY_BUTTON1, y => 5, x => 12)), 2,
        'col 12 against abs-x 10 → 2';
    is $w.local-row(mouse-event(id => NCKEY_BUTTON1, y => 9, x => 10)), -1,
        'event below widget → -1';
    is $w.local-col(mouse-event(id => NCKEY_BUTTON1, y => 5, x => 5)), -1,
        'event left of widget → -1';
};

subtest "App.widget-at-in: deepest hit wins" => {
    plan 4;
    my $root = TestContainer.new;
    my $a = Selkie::Widget::Button.new(label => 'A');
    my $b = Selkie::Widget::Button.new(label => 'B');
    $root.add($a);
    $root.add($b);

    place($root, abs-y => 0, abs-x => 0, rows => 10, cols => 20);
    place($a,    abs-y => 0, abs-x => 0, rows => 5,  cols => 10);
    place($b,    abs-y => 5, abs-x => 0, rows => 5,  cols => 10);

    is Selkie::App.widget-at-in($root, 1, 1).label, 'A',
        'click in upper region resolves to A';
    is Selkie::App.widget-at-in($root, 6, 1).label, 'B',
        'click in lower region resolves to B';
    is Selkie::App.widget-at-in($root, 0, 15), $root,
        'click in root-only area (no child rect) resolves to root';
    nok Selkie::App.widget-at-in($root, 100, 100).defined,
        'click outside root returns the type object';
};

subtest "App.widget-at-in: nested children resolve to leaf" => {
    plan 2;
    my $root = TestContainer.new;
    my $mid  = TestContainer.new;
    my $leaf = Selkie::Widget::Button.new(label => 'leaf');
    $root.add($mid);
    $mid.add($leaf);

    place($root, abs-y => 0, abs-x => 0, rows => 10, cols => 20);
    place($mid,  abs-y => 1, abs-x => 1, rows => 8,  cols => 18);
    place($leaf, abs-y => 2, abs-x => 2, rows => 4,  cols => 10);

    is Selkie::App.widget-at-in($root, 3, 5).label, 'leaf',
        'click inside leaf resolves through root → mid → leaf';
    is Selkie::App.widget-at-in($root, 1, 1), $mid,
        'click in mid-only band (above leaf) resolves to mid';
};

subtest "Selkie::Event.with-click-count clones into a new event" => {
    plan 4;
    my $base = mouse-event(id => NCKEY_BUTTON1, y => 7, x => 13);
    my $two  = $base.with-click-count(2);
    is $two.click-count, 2, 'cloned event reports the new count';
    is $two.y, 7, 'y preserved across clone';
    is $two.x, 13, 'x preserved across clone';
    is $base.click-count, 0, 'original event is untouched (immutability)';
};

subtest "Widget.on-click registers a click handler" => {
    plan 3;
    my class TestWidget does Selkie::Widget {
        method render() { self.clear-dirty }
    }
    my $w = TestWidget.new;
    my $fired = 0;
    $w.on-click(-> $ev { $fired++ });
    is $w.mouse-handlers.elems, 1, 'one handler registered';
    is $w.mouse-handlers[0].kind, 'click', 'kind is "click"';
    is $w.mouse-handlers[0].button, 1, 'default button is 1';
};

subtest "Widget.handle-event default routes a press through on-click" => {
    plan 3;
    # Plain Selkie::Widget composer so the default handle-event runs
    # (Button overrides handle-event with its own logic).
    my class TestWidget does Selkie::Widget {
        method render() { self.clear-dirty }
    }
    my $w = TestWidget.new;
    place($w, abs-y => 0, abs-x => 0, rows => 1, cols => 1);
    my @fired;
    $w.on-click(-> $ev { @fired.push: $ev.click-count });

    my $ev = mouse-event(id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, click-count => 1);
    ok $w.handle-event($ev), 'press is consumed by registered click handler';
    is @fired.elems, 1, 'handler fired exactly once';
    is @fired[0], 1, 'handler saw the click-count annotation';
};

subtest "Widget.handle-event ignores press when no matching button registered" => {
    plan 2;
    my class TestWidget does Selkie::Widget {
        method render() { self.clear-dirty }
    }
    my $w = TestWidget.new;
    place($w, abs-y => 0, abs-x => 0, rows => 1, cols => 1);
    $w.on-click(-> $ev { ; }, button => 2);
    my $primary-press = mouse-event(input-type => NCTYPE_PRESS, id => NCKEY_BUTTON1);
    nok $w.handle-event($primary-press),
        'button-1 press doesn\'t fire a button-2 handler';
    my $middle-press = mouse-event(input-type => NCTYPE_PRESS, id => NCKEY_BUTTON2);
    ok $w.handle-event($middle-press),
        'button-2 press fires the button-2 handler';
};

subtest "Modal default dismiss-on-click-outside is False" => {
    plan 2;
    my $m = Selkie::Widget::Modal.new;
    nok $m.dismiss-on-click-outside,
        'default is the focus-trap behavior — clicks outside are dropped';
    my $opt-in = Selkie::Widget::Modal.new(dismiss-on-click-outside => True);
    ok $opt-in.dismiss-on-click-outside,
        'opt-in flag flips on construction';
};

subtest "widget-at-in routes through overlay claims" => {
    # Regression for the dropdown-in-Select bug: widgets that paint
    # over the layout flow (open Selects, popovers) must capture clicks
    # on their overlay area even when the parent's contains-point
    # would otherwise hand the click to a sibling sitting underneath.
    plan 3;
    my class OverlayWidget does Selkie::Widget {
        has Bool $.open is rw = False;
        method render() { self.clear-dirty }
        method claims-overlay-at(Int $y, Int $x --> Bool) {
            return False unless $!open;
            $y >= self.abs-y && $y < self.abs-y + 4
                && $x >= self.abs-x && $x < self.abs-x + 8;
        }
    }
    my $root = TestContainer.new;
    place($root, abs-y => 0, abs-x => 0, rows => 5, cols => 20);

    my $top = OverlayWidget.new;
    my $bot = Selkie::Widget::Button.new(label => 'underneath');
    $root.add($top);
    $root.add($bot);
    place($top, abs-y => 0, abs-x => 0, rows => 1, cols => 8);
    place($bot, abs-y => 1, abs-x => 0, rows => 1, cols => 8);

    # Closed: click on row 1 lands on the bottom button (normal
    # containment walk).
    is Selkie::App.widget-at-in($root, 1, 2).label, 'underneath',
        'closed overlay defers to layout flow';

    # Opened: same click is captured by the overlay widget — its
    # painted region extends down to row 3.
    $top.open = True;
    is Selkie::App.widget-at-in($root, 1, 2), $top,
        'open overlay captures clicks past its own viewport';

    # Click outside the overlay's painted region (still inside the
    # root container) falls back to containment walk and lands on
    # the root — no descendant covers row 4.
    is Selkie::App.widget-at-in($root, 4, 2), $root,
        'click below the overlay extent falls back to containment walk';
};

subtest "internal mouse dispatch uses hit-test helper directly" => {
    plan 2;
    my class DispatchHarness does Selkie::App::Internal::Dispatch {
        has $.root is rw;
        has $.focused is rw;

        method !active-modal() { Nil }
        method focus($widget --> Nil) { $!focused = $widget }
        method widget-attached($widget, $root --> Bool) { True }
        method close-modal(--> Nil) { }
        method !check-terminal-resize(--> Nil) { }
        method dispatch-event-for-test(Selkie::Event $ev --> Nil) {
            self!dispatch-event($ev);
        }
    }

    my class HitWidget does Selkie::Widget {
        has Int $.hits is rw = 0;
        method render() { self.clear-dirty }
        method handle-event(Selkie::Event $ev --> Bool) {
            $!hits++ if $ev.event-type ~~ MouseEvent;
            True;
        }
    }

    my $root = TestContainer.new;
    my $hit = HitWidget.new;
    $root.add($hit);
    place($root, abs-y => 0, abs-x => 0, rows => 3, cols => 10);
    place($hit, abs-y => 0, abs-x => 0, rows => 1, cols => 6);

    my $h = DispatchHarness.new(root => $root);
    lives-ok {
        $h.dispatch-event-for-test(mouse-event(
            id => NCKEY_BUTTON1,
            input-type => NCTYPE_PRESS,
            y => 0,
            x => 1,
        ));
    }, 'mouse dispatch survives hit-test through internal helper';
    is $hit.hits, 1, 'click delivered to hit widget';
};

subtest "duplicate press on exposed debounced control is suppressed" => {
    plan 3;
    my class DispatchHarness does Selkie::App::Internal::Dispatch {
        has $.root is rw;
        has $.focused is rw;

        method !active-modal() { Nil }
        method focus($widget --> Nil) { $!focused = $widget }
        method widget-attached($widget, $root --> Bool) { True }
        method close-modal(--> Nil) { }
        method !check-terminal-resize(--> Nil) { }
        method dispatch-event-for-test(Selkie::Event $ev --> Nil) {
            self!dispatch-event($ev);
        }
    }

    my class DebouncedHit does Selkie::Widget {
        has UInt $.debounce-ms = 120;
        has Int $.hits is rw = 0;
        has Bool $.park-on-hit = False;
        method render() { self.clear-dirty }
        method handle-event(Selkie::Event $ev --> Bool) {
            if $ev.event-type ~~ MouseEvent && $ev.input-type == NCTYPE_PRESS {
                $!hits++;
                self.set-viewport(abs-y => 99, abs-x => 0, rows => 1, cols => 6)
                    if $!park-on-hit;
                return True;
            }
            False;
        }
    }

    my $root = TestContainer.new;
    my $under = DebouncedHit.new;
    my $top = DebouncedHit.new(park-on-hit => True);
    $root.add($under);
    $root.add($top);
    place($root, abs-y => 0, abs-x => 0, rows => 3, cols => 10);
    place($under, abs-y => 0, abs-x => 0, rows => 1, cols => 6);
    place($top, abs-y => 0, abs-x => 0, rows => 1, cols => 6);

    my $h = DispatchHarness.new(root => $root);
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 1));
    is $top.hits, 1, 'first click delivered to top debounced control';

    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 1));
    is $under.hits, 0, 'duplicate press does not fall through to exposed control';

    sleep 0.15;
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 1));
    is $under.hits, 1, 'press after debounce window reaches exposed control';
};

subtest "driver duplicate press is suppressed for plain widgets, real double-click survives" => {
    plan 4;
    my class DispatchHarness does Selkie::App::Internal::Dispatch {
        has $.root is rw;
        has $.focused is rw;

        method !active-modal() { Nil }
        method focus($widget --> Nil) { $!focused = $widget }
        method widget-attached($widget, $root --> Bool) { True }
        method close-modal(--> Nil) { }
        method !check-terminal-resize(--> Nil) { }
        method dispatch-event-for-test(Selkie::Event $ev --> Nil) {
            self!dispatch-event($ev);
        }
    }

    # No debounce-ms method — a ListView/Table stand-in that records
    # each delivered press and its click-count annotation.
    my class PlainHit does Selkie::Widget {
        has Int $.hits is rw = 0;
        has @.counts;
        method render() { self.clear-dirty }
        method handle-event(Selkie::Event $ev --> Bool) {
            if $ev.event-type ~~ MouseEvent && $ev.input-type == NCTYPE_PRESS {
                $!hits++;
                @!counts.push($ev.click-count);
                return True;
            }
            False;
        }
    }

    my $root = TestContainer.new;
    my $list = PlainHit.new;
    $root.add($list);
    place($root, abs-y => 0, abs-x => 0, rows => 3, cols => 10);
    place($list, abs-y => 0, abs-x => 0, rows => 1, cols => 6);

    my $h = DispatchHarness.new(root => $root);
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 2));
    is $list.hits, 1, 'first press delivered to plain widget';

    # Same cell, same drain — a terminal-driver duplicate, not a user
    # double-click. Must not deliver, and must not become click-count 2.
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 2));
    is $list.hits, 1, 'driver duplicate press suppressed for plain widget';

    # A human double-click's second press arrives well past the
    # duplicate window but inside the double-click window.
    sleep 0.08;
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 2));
    is $list.hits, 2, 'second click after duplicate window delivered';
    is $list.counts.tail, 2, 'and still counts as a double-click';
};

subtest "wheel events are not clicks: no suppression, no capture" => {
    plan 3;
    my class DispatchHarness does Selkie::App::Internal::Dispatch {
        has $.root is rw;
        has $.focused is rw;

        method !active-modal() { Nil }
        method focus($widget --> Nil) { $!focused = $widget }
        method widget-attached($widget, $root --> Bool) { True }
        method close-modal(--> Nil) { }
        method !check-terminal-resize(--> Nil) { }
        method dispatch-event-for-test(Selkie::Event $ev --> Nil) {
            self!dispatch-event($ev);
        }
    }

    # A debounced control (Button stand-in) that also counts scroll
    # deliveries: flick-scrolling a form must not lose wheel events
    # to the control's press-debounce window.
    my class DebouncedScrollable does Selkie::Widget {
        has UInt $.debounce-ms = 120;
        has Int $.scrolls is rw = 0;
        has Int $.motions is rw = 0;
        method render() { self.clear-dirty }
        method handle-event(Selkie::Event $ev --> Bool) {
            if $ev.event-type ~~ MouseEvent {
                $!scrolls++ if $ev.id == NCKEY_SCROLL_UP
                            || $ev.id == NCKEY_SCROLL_DOWN;
                $!motions++ if $ev.id == NCKEY_MOTION;
                return True;
            }
            False;
        }
    }

    my $root = TestContainer.new;
    my $ctl = DebouncedScrollable.new;
    $root.add($ctl);
    place($root, abs-y => 0, abs-x => 0, rows => 3, cols => 10);
    place($ctl, abs-y => 0, abs-x => 0, rows => 1, cols => 6);

    my $h = DispatchHarness.new(root => $root);
    for ^3 {
        $h.dispatch-event-for-test(mouse-event(
            id => NCKEY_SCROLL_UP, input-type => NCTYPE_PRESS, y => 0, x => 3));
    }
    is $ctl.scrolls, 3,
        'rapid same-cell wheel events all delivered over a debounced control';

    # A wheel press must not seed drag capture: motion events with no
    # real button held should keep returning early, not route to the
    # last-scrolled widget.
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_MOTION, input-type => NCTYPE_PRESS, y => 0, x => 3));
    is $ctl.motions, 0, 'motion after wheel press not captured';

    # And a real press right after a wheel event still lands (wheel
    # must not have seeded the duplicate-press bookkeeping either).
    my $before = $ctl.scrolls;
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_BUTTON1, input-type => NCTYPE_PRESS, y => 0, x => 3));
    $h.dispatch-event-for-test(mouse-event(
        id => NCKEY_SCROLL_DOWN, input-type => NCTYPE_PRESS, y => 0, x => 3));
    is $ctl.scrolls, $before + 1, 'wheel event after a click still delivered';
};

subtest "paste focus helper returns Bool, not method list" => {
    plan 5;
    my class PasteHarness does Selkie::App::Internal::Dispatch {
        has $.focused is rw;
        method focused-can-insert-text-for-test(--> Bool) {
            self!focused-can-insert-text;
        }
        method flush-paste-for-test(Str:D $text --> Nil) {
            self!flush-paste-batch($text);
        }
    }

    my $input = Selkie::Widget::TextInput.new;
    my $h = PasteHarness.new(focused => $input);
    my Bool $can = False;
    lives-ok { $can = $h.focused-can-insert-text-for-test },
        'insert-text capability check returns without typecheck crash';
    ok $can, 'focused TextInput can receive paste batches';
    lives-ok { $h.flush-paste-for-test('secret') },
        'paste batch flush inserts into focused input';
    is $input.text, 'secret', 'pasted text reaches the input';

    my class PlainFocus { }
    nok PasteHarness.new(focused => PlainFocus.new).focused-can-insert-text-for-test,
        'focused object without insert-text returns False';
};

subtest "documented mouse-dispatch contract for handle-event overrides" => {
    plan 4;
    # Pin the contract documented under Widget.handle-event: subclasses
    # that override handle-event for KeyEvent should branch on
    # event-type and call self!dispatch-mouse-handlers explicitly for
    # mouse — `nextsame` does NOT work here because Selkie::Widget is
    # a role, and Raku flattens role methods into the consuming class.
    # An override shadows the role's handle-event rather than
    # inheriting it as a separate dispatch candidate, leaving nextsame
    # with no candidate to fall through to.
    my class DocPatternWidget does Selkie::Widget {
        method render() { self.clear-dirty }
        method handle-event(Selkie::Event $ev --> Bool) {
            if $ev.event-type ~~ MouseEvent {
                return True if self!dispatch-mouse-handlers($ev);
                return False;
            }
            False;
        }
    }

    my Int $click-count = 0;
    my $w = DocPatternWidget.new;
    $w.on-click(-> $ { $click-count++ });

    my $click = mouse-event(
        id => NCKEY_BUTTON1, y => 0, x => 0,
        input-type => NCTYPE_PRESS, click-count => 1
    );
    my $consumed = $w.handle-event($click);

    is $click-count, 1,
        "explicit dispatch-mouse-handlers fires registered on-click";
    ok $consumed, "handle-event returns True for consumed click";

    # And a non-mouse event takes the keyboard branch (returns False
    # for this minimal stub) — confirming the branch decision works
    # both ways.
    my $kev = key-event(id => 'a'.ord);
    my $consumed-key = $w.handle-event($kev);
    nok $consumed-key, "non-mouse path returns False (no keybinds bound)";
    is $click-count, 1, "no-op key-event does not fire on-click again";
};