Selkie.git | t/ | 01-widget.rakutest

---

use Test;
use lib 'lib';

use Selkie::Widget;
use Selkie::Widget::FocusableByDefault;
use Selkie::Widget::Button;
use Selkie::Widget::Checkbox;
use Selkie::Event;
use Selkie::Style;
use Selkie::Theme;
use Selkie::Sizing;
use Notcurses::Native::Types;

# Concrete stub for testing the Widget role
class TestWidget does Selkie::Widget {
    method render() { self.clear-dirty }
}

plan 19;

subtest "construction defaults" => {
    plan 7;
    my $w = TestWidget.new;
    ok $w.is-dirty, "starts dirty";
    is $w.rows, 0, "rows default 0";
    is $w.cols, 0, "cols default 0";
    is $w.y, 0, "y default 0";
    is $w.x, 0, "x default 0";
    nok $w.focusable, "not focusable by default";
    nok $w.plane.defined, "no plane initially";
};

subtest "construction with sizing" => {
    plan 2;
    my $w = TestWidget.new(sizing => Sizing.fixed(5));
    is $w.sizing.mode, SizeFixed, "sizing mode set";
    is $w.sizing.value, 5, "sizing value set";
};

subtest "construction with focusable" => {
    plan 1;
    my $w = TestWidget.new(focusable => True);
    ok $w.focusable, "focusable when set";
};

subtest "dirty tracking - mark and clear" => {
    plan 3;
    my $w = TestWidget.new;
    ok $w.is-dirty, "starts dirty";
    $w.clear-dirty;
    nok $w.is-dirty, "clean after clear-dirty";
    $w.mark-dirty;
    ok $w.is-dirty, "dirty after mark-dirty";
};

subtest "dirty tracking - mark is idempotent" => {
    plan 1;
    my $w = TestWidget.new;
    $w.clear-dirty;
    $w.mark-dirty;
    $w.mark-dirty;
    ok $w.is-dirty, "still dirty after double mark";
};

subtest "dirty tracking - propagates to parent" => {
    plan 2;
    my $parent = TestWidget.new;
    my $child = TestWidget.new;
    $child.parent = $parent;
    $parent.clear-dirty;
    $child.clear-dirty;
    nok $parent.is-dirty, "parent starts clean";
    $child.mark-dirty;
    ok $parent.is-dirty, "parent dirty after child marked";
};

subtest "theme - default when no theme set" => {
    plan 1;
    my $w = TestWidget.new;
    my $theme = $w.theme;
    ok $theme.defined, "gets default theme when none set";
};

subtest "theme - inherits from parent" => {
    plan 1;
    my $custom = Selkie::Theme.default;
    my $parent = TestWidget.new;
    $parent.set-theme($custom);
    my $child = TestWidget.new;
    $child.parent = $parent;
    ok $child.theme === $custom, "child inherits parent theme";
};

subtest "theme - own theme overrides parent" => {
    plan 1;
    my $parent-theme = Selkie::Theme.default;
    my $child-theme = Selkie::Theme.default;
    my $parent = TestWidget.new;
    $parent.set-theme($parent-theme);
    my $child = TestWidget.new;
    $child.parent = $parent;
    $child.set-theme($child-theme);
    ok $child.theme === $child-theme, "own theme takes precedence";
};

subtest "set-theme marks dirty" => {
    plan 1;
    my $w = TestWidget.new;
    $w.clear-dirty;
    $w.set-theme(Selkie::Theme.default);
    ok $w.is-dirty, "dirty after set-theme";
};

subtest "resize without plane" => {
    plan 4;
    my $w = TestWidget.new;
    $w.clear-dirty;
    $w.resize(10, 80);
    is $w.rows, 10, "rows updated";
    is $w.cols, 80, "cols updated";
    ok $w.is-dirty, "marked dirty";

    # No-op when same dimensions
    $w.clear-dirty;
    $w.resize(10, 80);
    nok $w.is-dirty, "not dirty when size unchanged";
};

subtest "reposition without plane" => {
    plan 4;
    my $w = TestWidget.new;
    $w.reposition(5, 10);
    is $w.y, 5, "y updated";
    is $w.x, 10, "x updated";

    # No-op when same position
    $w.reposition(5, 10);
    is $w.y, 5, "y unchanged";
    is $w.x, 10, "x unchanged";
};

subtest "keybind registration and dispatch" => {
    plan 2;
    my $w = TestWidget.new;
    my $called = False;
    $w.on-key('ctrl+q', -> $ { $called = True });

    my $ev = Selkie::Event.new(
        id        => 'q'.ord,
        modifiers => Set(Mod-Ctrl),
        input-type => NCTYPE_PRESS,
        event-type => KeyEvent,
    );
    my $consumed = $w.handle-event($ev);
    ok $called, "handler invoked";
    ok $consumed, "event consumed";
};

subtest "keybind - non-matching event not consumed" => {
    plan 2;
    my $w = TestWidget.new;
    my $called = False;
    $w.on-key('ctrl+q', -> $ { $called = True });

    my $ev = Selkie::Event.new(
        id        => 'x'.ord,
        modifiers => Set(),
        input-type => NCTYPE_PRESS,
        event-type => KeyEvent,
    );
    my $consumed = $w.handle-event($ev);
    nok $called, "handler not invoked";
    nok $consumed, "event not consumed";
};

subtest "keybind-chain collects from leaf upward, deduped, no undescribed" => {
    plan 6;
    my $root  = TestWidget.new;
    my $mid   = TestWidget.new;
    my $leaf  = TestWidget.new;
    $mid.parent  = $root;
    $leaf.parent = $mid;

    # Leaf has 'n' (described) and 'esc' (no description — internal).
    # Mid re-binds 'n' (described) — must lose to leaf's 'n' on dedupe.
    # Root contributes 'ctrl+h' (described).
    $leaf.on-key('n',      -> $ {}, :description('New character'));
    $leaf.on-key('esc',    -> $ {});  # no description: skipped
    $mid.on-key('n',       -> $ {}, :description('Mid-level new'));
    $mid.on-key('a',       -> $ {}, :description('Add item'));
    $root.on-key('ctrl+h', -> $ {}, :description('Show help'));

    my @chain = $leaf.keybind-chain;
    is @chain.elems, 3, "three deduped, described binds";
    is @chain[0]<spec>,        'n',              "leaf's 'n' wins position 0";
    is @chain[0]<description>, 'New character',  "leaf's description wins on dedupe";
    is @chain[1]<spec>,        'a',              "mid contributes 'a'";
    is @chain[2]<spec>,        'ctrl+h',         "root contributes 'ctrl+h'";
    ok @chain.grep({ .<spec> eq 'esc' }).elems == 0, "undescribed binds excluded";
};

# --- mark-dirty-tree / mark-screen-dirty ---

use Selkie::Container;
class TestContainer does Selkie::Container {
    method render() { self!render-children; self.clear-dirty }
}

subtest "mark-dirty-tree cascades to children + content" => {
    plan 4;
    my $parent = TestContainer.new;
    my $child-a = TestWidget.new;
    my $child-b = TestWidget.new;
    $parent.add($child-a);
    $parent.add($child-b);

    # Start from a clean tree so we can prove the cascade did the work
    $parent.clear-dirty;
    $child-a.clear-dirty;
    $child-b.clear-dirty;

    $parent.mark-dirty-tree;

    ok $parent.is-dirty, "container itself marked dirty";
    ok $child-a.is-dirty, "first child marked dirty";
    ok $child-b.is-dirty, "second child marked dirty";

    # Idempotent
    lives-ok { $parent.mark-dirty-tree },
        "calling mark-dirty-tree again is safe";
};

subtest "mark-screen-dirty walks up to root then cascades" => {
    plan 4;
    # root → mid → leaf. mark-screen-dirty from `leaf` should flag
    # root, mid, and leaf — even though the default mark-dirty
    # already propagates up, mark-dirty-tree adds the downward
    # cascade that default mark-dirty doesn't provide.
    my $root = TestContainer.new;
    my $mid = TestContainer.new;
    my $sibling-of-mid = TestWidget.new;
    my $leaf = TestWidget.new;
    $root.add($mid);
    $root.add($sibling-of-mid);
    $mid.add($leaf);

    $root.clear-dirty;
    $mid.clear-dirty;
    $sibling-of-mid.clear-dirty;
    $leaf.clear-dirty;

    $leaf.mark-screen-dirty;

    ok $leaf.is-dirty, "caller is dirty";
    ok $mid.is-dirty, "direct ancestor is dirty";
    ok $root.is-dirty, "root is dirty";
    ok $sibling-of-mid.is-dirty,
        "sibling branch reached via downward cascade from root";
};

subtest "FocusableByDefault role applies to focusable input widgets" => {
    plan 4;
    # The role is composed into 10 widgets to remove a duplicated
    # %args<focusable> //= True; callwith(...) opener. Verify it
    # actually applies, that the explicit override still wins, and
    # that more than one widget benefits (cross-widget composition).

    my $btn = Selkie::Widget::Button.new(label => 'OK');
    ok $btn.focusable, "Button is focusable by default";

    my $cb = Selkie::Widget::Checkbox.new(label => 'Yes');
    ok $cb.focusable, "Checkbox is focusable by default";

    my $btn-explicit = Selkie::Widget::Button.new(
        label => 'X', focusable => False
    );
    nok $btn-explicit.focusable,
        "explicit focusable=>False is honoured (Button)";

    my $cb-explicit = Selkie::Widget::Checkbox.new(
        label => 'No', focusable => False
    );
    nok $cb-explicit.focusable,
        "explicit focusable=>False is honoured (Checkbox)";
};

subtest "park-y returns the canonical off-screen Y" => {
    plan 3;
    # The framework standardises on a single off-screen Y so Container,
    # CardList, and any custom container override all park to the same
    # spot — making parked widgets greppable in snapshot tests and
    # easy to reason about in debugger output. `park-y` is a method
    # (not an `our` constant) because Raku doesn't allow our-scoped
    # symbols inside a role.
    my $w = TestWidget.new;
    ok $w.park-y.defined,
        "park-y is callable on every Widget consumer";
    ok $w.park-y >= 1000,
        "park-y is comfortably larger than any plausible terminal height";
    is $w.park-y, 10_000,
        "park-y is the documented value (regression pin)";
};