Selkie.git | t/ | 92-gradient.rakutest

---

use Test;
use lib 'lib';

use Notcurses::Native::Types;
use Notcurses::Native::Channel;

use Selkie::Gradient;
use Selkie::Widget::GradientFill;

=begin pod

The C<Gradient> value type, the corner-collapse rule that makes
degenerate regions paintable, and the packed channel words handed to
notcurses.

Everything here is plane-free. The load-bearing subtests are the
B<collapse table> and B<the collapse never changes a legal gradient>:
C<ncplane_gradient> validates its corners against the region's shape and
silently paints B<nothing> (returns C<-1>) when they disagree, so a
one-row selection bar built from a two-dimensional gradient is a
no-op without the collapse. The end-to-end proof that the collapse
produces a real ramp rather than a blank row lives in
C<xt/snapshots/57-gradient-one-row-styled.raku>.

The rules replicated here, verified against notcurses's C<src/lib/fill.c>:

=item C<ncplane_gradient>, rows == 1 && cols == 1 — all four corners must be equal.
=item C<ncplane_gradient>, rows == 1 — C<ul == ll> and C<ur == lr>.
=item C<ncplane_gradient>, cols == 1 — C<ul == ur> and C<ll == lr>.
=item C<ncplane_gradient2x1>, cols == 1 — C<ul == ur> and C<ll == lr>. No row rule: it interpolates over C<rows * 2>.
=item Any of them: the four foreground channels must be all-default or all-explicit, likewise the backgrounds, and all four alphas must match.

Note that notcurses compares the packed C<uint64> B<words>, not the RGB
values, which is why the precondition subtest asserts on
C<gradient-channels> output rather than on the corners.

=end pod

plan 15;

# A gradient with four genuinely different corners — every collapse
# below has to actually move something.
sub quad(--> Gradient) {
    Gradient.corners(
        top-left     => 0x102030, top-right    => 0x405060,
        bottom-left  => 0x708090, bottom-right => 0xA0B0C0,
    );
}

sub corners-of(Gradient:D $g --> List) {
    ($g.top-left, $g.top-right, $g.bottom-left, $g.bottom-right);
}

subtest "factories place the corners where they say they do" => {
    plan 4;

    is-deeply corners-of(Gradient.horizontal(0x111111, 0x222222)),
        (0x111111, 0x222222, 0x111111, 0x222222),
        "horizontal repeats the pair down both rows";

    is-deeply corners-of(Gradient.vertical(0x111111, 0x222222)),
        (0x111111, 0x111111, 0x222222, 0x222222),
        "vertical repeats the pair across both columns";

    is-deeply corners-of(Gradient.uniform(0x333333)),
        (0x333333, 0x333333, 0x333333, 0x333333),
        "uniform is flat";

    is-deeply corners-of(quad()),
        (0x102030, 0x405060, 0x708090, 0xA0B0C0),
        "corners keeps all four independent";
};

subtest "the one-dimensional factories are pre-collapsed for their own axis" => {
    plan 4;
    # This is why Gradient.horizontal "just works" in a selection bar
    # even before for-region is involved — and why Gradient.corners
    # does not.
    my $h = Gradient.horizontal(0x111111, 0x222222);
    is $h.top-left,  $h.bottom-left,  "horizontal: left column agrees (legal in one row)";
    is $h.top-right, $h.bottom-right, "horizontal: right column agrees";

    my $v = Gradient.vertical(0x111111, 0x222222);
    is $v.top-left,    $v.top-right,    "vertical: top row agrees (legal in one column)";
    is $v.bottom-left, $v.bottom-right, "vertical: bottom row agrees";
};

subtest "corner colours are validated at the construction site" => {
    plan 5;
    # notcurses masks the high bits off without complaint, turning a
    # typo'd 0xRRGGBBAA into a plausible wrong colour a long way from
    # the code that wrote it.
    throws-like { Gradient.uniform(0x1000000) }, Exception,
        message => /'outside the 0x000000..0xFFFFFF RGB range'/,
        "one past white throws";
    throws-like { Gradient.corners(top-left => 0, top-right => 0,
                                   bottom-left => 0, bottom-right => 0xFFFFFFF) },
        Exception, message => /'bottom-right'/,
        "the failing corner is named";
    lives-ok { Gradient.uniform(0x000000) }, "black is fine";
    lives-ok { Gradient.uniform(0xFFFFFF) }, "white is fine";
    dies-ok  { Gradient.new(top-left => 0) }, "all four corners are required";
};

subtest "COLLAPSE TABLE — for-region by region shape" => {
    plan 6;

    my $g = quad();

    is-deeply corners-of($g.for-region(8, 12)),
        (0x102030, 0x405060, 0x708090, 0xA0B0C0),
        "N x M: nothing collapses";

    # Single row: notcurses reads only the top pair, so the bottom pair
    # is replaced by it. The ramp that survives is the top edge's.
    is-deeply corners-of($g.for-region(1, 20)),
        (0x102030, 0x405060, 0x102030, 0x405060),
        "1 x N: bottom pair becomes the top pair";

    # Single column: notcurses reads only the left pair.
    is-deeply corners-of($g.for-region(20, 1)),
        (0x102030, 0x102030, 0x708090, 0x708090),
        "N x 1: right pair becomes the left pair";

    is-deeply corners-of($g.for-region(1, 1)),
        (0x102030, 0x102030, 0x102030, 0x102030),
        "1 x 1: flat at top-left";

    # A zero extent is the "everything remaining" sentinel of the
    # painting subs — it says nothing about the real shape, so it must
    # not trigger a collapse.
    is-deeply corners-of($g.for-region(0, 0)),
        (0x102030, 0x405060, 0x708090, 0xA0B0C0),
        "0 x 0: unknown extent constrains nothing";

    is-deeply corners-of($g.for-region(1, 0)),
        (0x102030, 0x405060, 0x102030, 0x405060),
        "1 x 0: a known single row still collapses";
};

subtest "for-region returns the invocant when there is nothing to do" => {
    plan 4;
    # Cheap identity check, and it documents that Gradient is a value:
    # nobody downstream may mutate what they get back.
    my $g = quad();
    ok $g.for-region(4, 4) === $g, "non-degenerate region returns self";
    ok $g.for-region(0, 0) === $g, "unknown extent returns self";

    my $u = Gradient.uniform(0x123456);
    ok $u.for-region(1, 1) === $u, "already-flat 1x1 returns self";

    my $h = Gradient.horizontal(0x111111, 0x222222);
    ok $h.for-region(1, 40) === $h, "horizontal in one row is already legal";
};

subtest "COLLAPSE TABLE — for-region :hires" => {
    plan 4;

    my $g = quad();

    # ncplane_gradient2x1 interpolates over rows*2, so one row of half
    # blocks is two ramp steps — collapsing it would throw the vertical
    # component away.
    is-deeply corners-of($g.for-region(1, 20, :hires)),
        (0x102030, 0x405060, 0x708090, 0xA0B0C0),
        "1 x N hires: rows are NOT collapsed";

    is-deeply corners-of($g.for-region(20, 1, :hires)),
        (0x102030, 0x102030, 0x708090, 0x708090),
        "N x 1 hires: the column rule still applies";

    is-deeply corners-of($g.for-region(1, 1, :hires)),
        (0x102030, 0x102030, 0x708090, 0x708090),
        "1 x 1 hires: still a two-step vertical ramp";

    ok $g.for-region(1, 20, :hires) === $g, "and the row-only case is a no-op";
};

subtest "PRECONDITIONS — collapsed corners satisfy notcurses's own checks" => {
    plan 8;

    # notcurses compares the packed 64-bit words, not the RGB values, so
    # these assertions are made where the comparison actually happens.
    sub words(Gradient:D $g) { gradient-channels($g, fg => Gradient.uniform(0xFFFFFF)) }

    my $g = quad();

    my ($ul, $ur, $ll, $lr) = words($g.for-region(1, 30));
    ok $ul == $ll, "1 x N: ul == ll";
    ok $ur == $lr, "1 x N: ur == lr";

    ($ul, $ur, $ll, $lr) = words($g.for-region(30, 1));
    ok $ul == $ur, "N x 1: ul == ur";
    ok $ll == $lr, "N x 1: ll == lr";

    ($ul, $ur, $ll, $lr) = words($g.for-region(1, 1));
    is ($ul, $ur, $ll, $lr).unique.elems, 1, "1 x 1: all four words identical";

    # The uncollapsed original must genuinely violate them, or the
    # subtest above proves nothing.
    ($ul, $ur, $ll, $lr) = words($g);
    ok $ul != $ll, "uncollapsed 1 x N would have been rejected";
    ok $ul != $ur, "uncollapsed N x 1 would have been rejected";

    # The half-block path compares 32-bit channels.
    my ($h-ul, $h-ur, $h-ll, $h-lr) =
        gradient-channels-hires($g.for-region(9, 1, :hires));
    ok $h-ul == $h-ur && $h-ll == $h-lr, "hires N x 1: column rule holds";
};

subtest "the collapse never changes a gradient notcurses already accepts" => {
    plan 6;
    # for-region can turn a refusal into a painted ramp; it must never
    # turn one painted ramp into a different one. Every shape where
    # notcurses would have accepted the original has to come back
    # byte-identical.
    for (Gradient.horizontal(0x001122, 0x334455),
         Gradient.vertical(0x001122, 0x334455),
         Gradient.uniform(0x667788)) -> $g {
        my $legal-shape = $g.top-left == $g.bottom-left ?? (1, 40) !! (40, 1);
        is-deeply corners-of($g.for-region(|$legal-shape)), corners-of($g),
            "{$legal-shape.join('x')} leaves an already-legal gradient alone";
    }

    # And the corners it does keep are the ones notcurses interpolates
    # from, so the painted result is unchanged even where the corners
    # did move: a one-row region reads the top pair either way.
    my $g = quad();
    is $g.for-region(1, 9).top-left,  $g.top-left,  "1 x N keeps top-left";
    is $g.for-region(1, 9).top-right, $g.top-right, "1 x N keeps top-right";
    is $g.for-region(9, 1).bottom-left, $g.bottom-left, "N x 1 keeps bottom-left";
};

subtest "CHANNEL WORDS — exact uint64 for a known colour pair" => {
    plan 6;

    # Hand-derived, deliberately not computed through the code under
    # test. ncchannel_set(channel, rgb) is
    #   (channel & ~(NC_BG_RGB_MASK | NC_BG_PALETTE)) | NC_BGDEFAULT_MASK | rgb
    # i.e. 0x40000000 | rgb, with the foreground occupying the high half:
    #
    #   fchannel = 0x40000000 | 0xC0C0C0 = 0x40C0C0C0
    #   bchannel = 0x40000000 | 0x1A1A2E = 0x401A1A2E
    #   => 0x40C0C0C0_401A1A2E
    #
    # Same word t/87 pins for the default theme's base cell, which is no
    # coincidence — both are "explicit RGB, opaque, not the terminal
    # default" and there is only one encoding of that.
    constant KNOWN-PAIR = 0x40C0C0C0401A1A2E;

    my @w = gradient-channels(Gradient.uniform(0x1A1A2E), fg => Gradient.uniform(0xC0C0C0));
    is @w.elems, 4, "four words, one per corner";
    is-deeply @w.List, (KNOWN-PAIR xx 4).List, "a flat pair packs to the known word";

    is ncchannels_fg_rgb(@w[0]), 0xC0C0C0, "foreground half is the fg colour";
    is ncchannels_bg_rgb(@w[0]), 0x1A1A2E, "background half is the bg colour";

    # All four alphas must match or notcurses rejects the call; opaque
    # is zero in both fields, which is what makes that true by
    # construction here.
    is @w.map({ (ncchannels_fg_alpha($_), ncchannels_bg_alpha($_)) }).unique(:with(&[eqv])).elems,
        1, "every corner carries the same alpha pair";
    is (ncchannels_fg_alpha(@w[0]), ncchannels_bg_alpha(@w[0])),
        (NCALPHA_OPAQUE, NCALPHA_OPAQUE), "and that pair is opaque";
};

subtest "CHANNEL WORDS — corner order and an omitted foreground" => {
    plan 6;

    my @w = gradient-channels(quad());

    # notcurses's order: upper-left, upper-right, lower-left, lower-right.
    is ncchannels_bg_rgb(@w[0]), 0x102030, "word 0 is top-left";
    is ncchannels_bg_rgb(@w[1]), 0x405060, "word 1 is top-right";
    is ncchannels_bg_rgb(@w[2]), 0x708090, "word 2 is bottom-left";
    is ncchannels_bg_rgb(@w[3]), 0xA0B0C0, "word 3 is bottom-right";

    # With no :fg the whole high half is zero, which notcurses reads as
    # "terminal default". All four are default together — a mixture is
    # what it rejects, not defaults as such.
    is @w.grep({ ncchannels_fg_default_p($_) }).elems, 4,
        "all four foregrounds default when :fg is omitted";
    is @w[0], 0x401A1A2E - 0x1A1A2E + 0x102030,
        "and the word is bchannel only";
};

subtest "CHANNEL WORDS — the half-block path packs 32-bit channels" => {
    plan 4;

    my @w = gradient-channels-hires(quad());
    is @w.elems, 4, "four channels";
    is @w[0], 0x40102030, "explicit-RGB bit plus the colour";
    is ncchannel_rgb(@w[0]), 0x102030, "colour round-trips";
    nok ncchannel_default_p(@w[3]), "no corner is left at the terminal default";
};

subtest "painting subs refuse a plane that is not there" => {
    plan 3;
    # A CPointer type object is what a widget holds before init-plane.
    # Handing it to notcurses would dereference NULL, so the guard is
    # not merely tidy.
    my $g = Gradient.uniform(0x101010);
    is gradient-fill(NcplaneHandle, $g), -1, "gradient-fill returns -1";
    is gradient-stain(NcplaneHandle, $g), -1, "gradient-stain returns -1";
    is gradient-fill-hires(NcplaneHandle, $g), -1, "gradient-fill-hires returns -1";
};

subtest "a negative origin is a caller bug, not a cursor request" => {
    plan 4;
    # notcurses reads -1 as "start wherever the cursor is". Selkie does
    # not expose that, so a negative coordinate is almost always an
    # unclamped subtraction and should say so loudly. Checked before the
    # plane guard would matter, but after it — so use a real-looking
    # call shape.
    my $g = Gradient.uniform(0x101010);
    my $p = NcplaneHandle;
    # With a null plane the guard short-circuits first; that ordering is
    # deliberate (never touch a null pointer) and is asserted here so a
    # future reshuffle does not quietly start dereferencing it.
    is gradient-fill($p, $g, y => -1), -1, "null plane still wins over the origin check";

    # Force the origin check by giving the subs something non-null to
    # look at is impossible without a terminal, so assert the checker's
    # contract through the one path that does not need a plane: the
    # message text is part of the API.
    throws-like { Gradient.uniform(-1) }, Exception,
        "a negative colour is rejected by the value type";
    ok Gradient.uniform(0).for-region(0, 0).defined, "for-region tolerates zero extents";
    ok !(-1 ~~ UInt), "negative extents cannot reach the subs at all (UInt)";
};

subtest "GradientFill widget surface" => {
    plan 8;

    my $ramp = Gradient.horizontal(0x000000, 0xFFFFFF);
    my $w = Selkie::Widget::GradientFill.new(gradient => $ramp);

    nok $w.focusable, "decorative: not focusable by default";
    is $w.egc, ' ', "default EGC is a space — a background wash";
    nok $w.fg-gradient.defined, "no foreground ramp by default";
    ok $w.gradient === $ramp, "the gradient is held by identity, not copied";

    dies-ok { Selkie::Widget::GradientFill.new }, "gradient is required";

    $w.clear-dirty;
    $w.set-gradient(Gradient.uniform(0x123456));
    ok $w.is-dirty, "set-gradient marks dirty";
    is $w.gradient.top-left, 0x123456, "and swaps the value";

    # Rendering without a plane is the state every widget is in between
    # construction and mounting; it must be a silent no-op.
    lives-ok { Selkie::Widget::GradientFill.new(gradient => $ramp).render },
        "render before init-plane is a no-op";
};

subtest "GradientFill setters" => {
    plan 6;

    my $w = Selkie::Widget::GradientFill.new(
        gradient => Gradient.uniform(0x000000),
        egc      => '█',
    );
    is $w.egc, '█', "a non-blank EGC survives construction";

    $w.clear-dirty;
    my $fg = Gradient.horizontal(0x111111, 0x222222);
    $w.set-fg-gradient($fg);
    ok $w.is-dirty, "set-fg-gradient marks dirty";
    ok $w.fg-gradient === $fg, "and stores it";

    # The bare type object is the documented way to clear it back to the
    # terminal default.
    $w.set-fg-gradient(Gradient);
    nok $w.fg-gradient.defined, "the type object clears the foreground ramp";

    $w.clear-dirty;
    $w.set-egc('·');
    ok $w.is-dirty, "set-egc marks dirty";
    is $w.egc, '·', "and swaps the glyph";
};