Selkie.git | t/ | 23-card-list.rakutest
use Test;
use lib 'lib';
use Selkie::Widget::CardList;
use Selkie::Widget;
use Selkie::Layout::VBox;
use Selkie::Event;
use Selkie::Sizing;
use Notcurses::Native::Types;
class StubWidget does Selkie::Widget {
has Bool $.clipped-top = False;
has Bool $.clipped-bottom = False;
method render() { self.clear-dirty }
method set-clipped(Bool :$top = False, Bool :$bottom = False) {
$!clipped-top = $top;
$!clipped-bottom = $bottom;
}
}
# Variant that records every scroll delegation. CardList's PgUp/PgDown
# duck-types via .^can('scroll-content-by'); this stub exposes that
# method so we can assert the right delta lands here.
class ScrollableStub does Selkie::Widget {
has @.scroll-deltas;
method render() { self.clear-dirty }
method scroll-content-by(Int $delta) { @!scroll-deltas.push($delta) }
}
use Selkie::Test::Keys;
sub add-stub($cl, Int :$height = 5) {
my $widget = StubWidget.new;
my $root = Selkie::Layout::VBox.new(sizing => Sizing.fixed($height));
$cl.add-item($widget, :$root, :$height);
$widget;
}
plan 27;
subtest "construction defaults" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
is $cl.count, 0, "no items initially";
is $cl.selected, 0, "selected at 0";
ok $cl.focusable, "focusable by default";
};
subtest "add-item disables focus-from-store on the provided border" => {
plan 2;
# CardList owns "selected" as its own concept, which does not map to
# "some descendant is focused". If the card Border stayed in the
# default store-driven focus mode, any focus change elsewhere in
# the app (or a re-render cascade from a sibling container) would
# wipe CardList's per-card set-has-focus. Opt out on add-item.
use Selkie::Widget::Border;
my $cl = Selkie::Widget::CardList.new;
my $border = Selkie::Widget::Border.new;
ok $border.focus-from-store, "border defaults to store-driven";
my $widget = StubWidget.new;
my $root = Selkie::Layout::VBox.new(sizing => Sizing.fixed(3));
$cl.add-item($widget, :$root, :height(3), :$border);
nok $border.focus-from-store,
"CardList.add-item flips focus-from-store off for card borders";
};
subtest "add-item increases count" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl);
is $cl.count, 1, "one item";
add-stub($cl);
is $cl.count, 2, "two items";
};
subtest "clear-items resets everything" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl);
add-stub($cl);
$cl.select-index(1);
$cl.clear-items;
is $cl.count, 0, "no items";
is $cl.selected, 0, "selection reset";
ok $cl.is-dirty, "marked dirty";
};
subtest "select-index clamps to bounds" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^5;
$cl.select-index(3);
is $cl.selected, 3, "selected 3";
$cl.select-index(100);
is $cl.selected, 4, "clamped to last";
$cl.select-index(-5);
is $cl.selected, 0, "clamped to first";
};
subtest "select-first and select-last" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^5;
$cl.select-last;
is $cl.selected, 4, "select-last goes to end";
$cl.select-first;
is $cl.selected, 0, "select-first goes to start";
};
subtest "on-select fires on select-index" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^3;
my $got;
$cl.on-select.tap: -> $idx { $got = $idx };
$cl.select-index(2);
is $got, 2, "on-select emitted correct index";
};
subtest "set-item-height updates height" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl, height => 5);
$cl.set-item-height(0, 10);
ok $cl.is-dirty, "marked dirty after height change";
};
subtest "set-item-height out of bounds is safe" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
lives-ok { $cl.set-item-height(99, 10) }, "no error for invalid index";
};
subtest "selected-item returns correct widget" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
my $w1 = add-stub($cl);
my $w2 = add-stub($cl);
$cl.select-index(0);
ok $cl.selected-item === $w1, "first widget selected";
$cl.select-index(1);
ok $cl.selected-item === $w2, "second widget selected";
};
subtest "handle-event up/down navigation" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^3;
$cl.select-index(0);
$cl.handle-event(key-event(id => NCKEY_DOWN));
is $cl.selected, 1, "down moved to 1";
$cl.handle-event(key-event(id => NCKEY_UP));
is $cl.selected, 0, "up moved back to 0";
};
subtest "handle-event home/end" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^5;
$cl.select-index(2);
$cl.handle-event(key-event(id => NCKEY_END));
is $cl.selected, 4, "end goes to last";
$cl.handle-event(key-event(id => NCKEY_HOME));
is $cl.selected, 0, "home goes to first";
};
subtest "up at top stays at top" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^3;
$cl.select-index(0);
$cl.handle-event(key-event(id => NCKEY_UP));
is $cl.selected, 0, "stayed at 0";
};
subtest "down at bottom stays at bottom" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^3;
$cl.select-last;
$cl.handle-event(key-event(id => NCKEY_DOWN));
is $cl.selected, 2, "stayed at end";
};
subtest "navigation on empty list is safe" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
lives-ok {
$cl.handle-event(key-event(id => NCKEY_DOWN));
$cl.handle-event(key-event(id => NCKEY_UP));
$cl.select-index(0);
$cl.select-first;
$cl.select-last;
}, "no errors on empty list";
};
subtest "keybinds checked before items" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
# No items — keybind should still fire
my $fired = False;
$cl.on-key: 'a', -> $ { $fired = True };
$cl.handle-event(key-event(id => 'a'.ord));
ok $fired, "keybind fires on empty list";
};
subtest "selected-item on empty list" => {
plan 1;
my $cl = Selkie::Widget::CardList.new;
nok $cl.selected-item.defined, "selected-item is Nil on empty list";
};
subtest "multiple on-select taps accumulate" => {
plan 2;
my $cl = Selkie::Widget::CardList.new;
add-stub($cl) for ^3;
my $a;
my $b;
$cl.on-select.tap: -> $idx { $a = $idx };
$cl.on-select.tap: -> $idx { $b = $idx };
$cl.select-index(1);
is $a, 1, "first tap got index";
is $b, 1, "second tap got index";
};
subtest "PgDown delegates to selected card's scroll-content-by" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
# Need to fake a viewport-rows count for the delta calculation.
# CardList!scroll-selected-by uses self.rows for the page step;
# without a plane that's 0. resize() bypasses init-plane and gives
# us a deterministic non-zero number to assert against.
$cl.resize(7, 40);
my $w = ScrollableStub.new;
my $root = Selkie::Layout::VBox.new(sizing => Sizing.fixed(20));
$cl.add-item($w, :$root, :height(20));
my $handled = $cl.handle-event(key-event(id => NCKEY_PGDOWN));
ok $handled, "PgDown is reported handled";
is $w.scroll-deltas.elems, 1, "scroll-content-by called once";
is $w.scroll-deltas[0], 7, "delta = +viewport rows";
};
subtest "PgUp delegates with a negative delta" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
$cl.resize(5, 40);
my $w = ScrollableStub.new;
my $root = Selkie::Layout::VBox.new(sizing => Sizing.fixed(20));
$cl.add-item($w, :$root, :height(20));
my $handled = $cl.handle-event(key-event(id => NCKEY_PGUP));
ok $handled, "PgUp is reported handled";
is $w.scroll-deltas.elems, 1, "scroll-content-by called once";
is $w.scroll-deltas[0], -5, "delta = -viewport rows";
};
subtest "PgUp/PgDown on a non-scrollable widget is consumed but no-op" => {
plan 3;
# Cards that don't expose scroll-content-by (plain stubs, legacy
# widgets) should still see the event reported handled — falling
# through to cross-card navigation would surprise the user mid-
# message — but should NOT trigger any state change.
my $cl = Selkie::Widget::CardList.new;
$cl.resize(7, 40);
add-stub($cl, height => 5);
my $before = $cl.selected;
ok $cl.handle-event(key-event(id => NCKEY_PGDOWN)),
"PgDown reported handled even without scroll-content-by";
ok $cl.handle-event(key-event(id => NCKEY_PGUP)),
"PgUp reported handled even without scroll-content-by";
is $cl.selected, $before,
"selection unchanged — PgUp/PgDown never traverses cards";
};
subtest "PgUp/PgDown on an empty list is not handled" => {
plan 2;
# No items → return False so the parent container can route the
# key elsewhere (e.g. a global PgUp/PgDown for a different pane).
my $cl = Selkie::Widget::CardList.new;
$cl.resize(5, 40);
nok $cl.handle-event(key-event(id => NCKEY_PGDOWN)),
"PgDown on empty CardList falls through";
nok $cl.handle-event(key-event(id => NCKEY_PGUP)),
"PgUp on empty CardList falls through";
};
subtest "bottom-anchor flag" => {
plan 3;
my $default = Selkie::Widget::CardList.new;
nok $default.bottom-anchor, "off by default";
my $anchored = Selkie::Widget::CardList.new(bottom-anchor => True);
ok $anchored.bottom-anchor, "settable via constructor";
# Behavioural smoke test: with bottom-anchor on, select-last on a
# short list (total height < viewport) should still leave the
# last card index selected — render alignment differs but the
# selection contract is unchanged. Regression guard.
add-stub($anchored, height => 5) for ^3;
$anchored.resize(50, 40);
$anchored.select-last;
is $anchored.selected, 2, "selection still tracks last item under bottom-anchor";
};
subtest "add-item accepts :min-display-height" => {
plan 2;
# Belt-and-suspenders signature check — the new parameter on
# add-item shouldn't disturb callers that omit it (default = 1,
# preserving the pre-existing "render any positive sliver"
# behaviour) and shouldn't reject callers that pass it.
my $cl = Selkie::Widget::CardList.new;
my $w = StubWidget.new;
my $r = Selkie::Layout::VBox.new(sizing => Sizing.fixed(8));
lives-ok { $cl.add-item($w, root => $r, height => 8) },
"default min-display-height accepted";
my $cl2 = Selkie::Widget::CardList.new;
my $w2 = StubWidget.new;
my $r2 = Selkie::Layout::VBox.new(sizing => Sizing.fixed(8));
lives-ok {
$cl2.add-item($w2, root => $r2, height => 8, min-display-height => 7)
}, "explicit min-display-height accepted";
};
subtest "selected card stays clamped within bounds after parking would otherwise empty the list" => {
plan 2;
# Pure-bookkeeping regression guard for the parking pre-pass.
# Render exercises the parking branch via xt/snapshots/; here we
# just confirm that having every non-selected card declare a
# min-display-height that exceeds its own height (degenerate
# config) doesn't break selection invariants. The pre-pass uses
# `min-h min h` for its threshold so the cards still satisfy it
# and the list stays navigable.
my $cl = Selkie::Widget::CardList.new;
my $w1 = StubWidget.new;
my $r1 = Selkie::Layout::VBox.new(sizing => Sizing.fixed(3));
$cl.add-item($w1, root => $r1, height => 3, min-display-height => 99);
my $w2 = StubWidget.new;
my $r2 = Selkie::Layout::VBox.new(sizing => Sizing.fixed(3));
$cl.add-item($w2, root => $r2, height => 3, min-display-height => 99);
$cl.select-last;
is $cl.selected, 1, "selection still tracks the last item";
$cl.select-first;
is $cl.selected, 0, "selection still tracks the first item";
};
subtest "click on a deep card descendant bubbles up to CardList" => {
plan 3;
my $cl = Selkie::Widget::CardList.new;
$cl.resize(20, 30);
$cl.set-viewport(abs-y => 0, abs-x => 0, rows => 20, cols => 30);
# Two cards, height 5 each.
my $stub-a = StubWidget.new;
my $root-a = Selkie::Layout::VBox.new(sizing => Sizing.fixed(5));
$cl.add-item($stub-a, root => $root-a, height => 5);
my $stub-b = StubWidget.new;
my $root-b = Selkie::Layout::VBox.new(sizing => Sizing.fixed(5));
$cl.add-item($stub-b, root => $root-b, height => 5);
# Wire stub-b's parent chain manually so the bubble walks
# stub-b → root-b → CardList. add-item set root-b.parent = $cl;
# we just need stub-b.parent set to root-b for the test stub
# (production VBox.add does this automatically).
$stub-b.parent = $root-b;
# Click at row 6, col 4 — that's inside the second card (rows 5-9).
my $ev = mouse-event(id => NCKEY_BUTTON1, y => 6, x => 4,
input-type => NCTYPE_PRESS, click-count => 1);
my $consumed = $stub-b.handle-event($ev);
# The click consumes inside CardList via the bubble; default
# handle-event on the stub returns False (no handlers), the
# parent walks up. We assert the side-effect of CardList's
# click handler firing.
is $cl.selected, 0, 'precondition: starts on the first card';
# Walk the bubble manually as App.dispatch-mouse does — the
# framework's bubble stops at the first handler returning True.
my $w = $stub-b;
my Bool $handled = False;
while $w.defined && !$handled {
$handled = $w.handle-event($ev);
$w = $w.parent;
}
ok $handled, 'click eventually consumed somewhere up the chain';
is $cl.selected, 1, 'CardList reacted to the bubbled click and selected the second card';
};
subtest "park reaches every card root via !park-children helper" => {
plan 4;
# CardList stores its cards in @!items as { :widget, :root, ... }
# hashes rather than via Container.children, so the standard
# Container.park doesn't know how to walk them. Verify that
# CardList.park calls .park on every card's root, regardless of
# whether the card has a plane (a parked widget should be
# idempotent — repeated park is a no-op).
# Spy class: records that .park was called. The base Widget.park
# short-circuits when no plane exists, so we override to force
# the spy to fire even when called on a plane-less stub.
my class ParkSpy does Selkie::Widget {
has Int $.park-count = 0;
method render() { self.clear-dirty }
method park() { $!park-count++ }
}
my $cl = Selkie::Widget::CardList.new;
my @roots;
for ^3 -> $i {
my $root = ParkSpy.new(sizing => Sizing.fixed(5));
my $widget = StubWidget.new;
$cl.add-item($widget, :$root, :height(5));
@roots.push($root);
}
is @roots[0].park-count, 0, "precondition: roots not parked yet";
$cl.park;
is @roots[0].park-count, 1, "first card root parked";
is @roots[1].park-count, 1, "middle card root parked";
is @roots[2].park-count, 1, "last card root parked";
};