Selkie.git | t/ | 87-alpha.rakutest


use Test;
use lib 'lib';

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

use Selkie::Alpha;
use Selkie::Style;
use Selkie::Theme;
use Selkie::Widget;

=begin pod

Alpha plumbing: the C<AlphaMode> enum and its notcurses constants, the
two alpha slots on C<Selkie::Style>, the base-cell channel word a widget
primes its plane with, and the per-widget cache that keeps the opaque
path free of native calls.

The load-bearing test in here is B<base-channels is byte-identical for
the default theme>. C<!sync-plane-base> runs for every plane in every
Selkie app, so a one-bit change in that word is a visual regression
across the entire distribution and both downstream apps at once. The
expected value is hand-derived from the pre-alpha implementation and
hard-coded, deliberately: computing it through the same code it is
meant to guard would guard nothing.

Everything here is plane-free. The single FFI seam (C<apply-plane-alpha>)
is overridden by a probe class so the caching above it can be exercised
without a terminal.

=end pod

plan 14;

# A widget that records what would have been pushed to the plane
# instead of pushing it. Signature matches the role's method exactly.
class AlphaProbe does Selkie::Widget {
    has @.alpha-calls;
    method render() { self.clear-dirty }
    method apply-plane-alpha(AlphaMode $fg-alpha, AlphaMode $bg-alpha --> Nil) {
        @!alpha-calls.push: [$fg-alpha, $bg-alpha];
        Nil
    }
}

class PlainWidget does Selkie::Widget {
    method render() { self.clear-dirty }
}

subtest "alpha-constant maps every mode to its NCALPHA_* constant" => {
    plan 5;
    is alpha-constant(AlphaOpaque),       NCALPHA_OPAQUE,       "opaque";
    is alpha-constant(AlphaBlend),        NCALPHA_BLEND,        "blend";
    is alpha-constant(AlphaTransparent),  NCALPHA_TRANSPARENT,  "transparent";
    is alpha-constant(AlphaHighContrast), NCALPHA_HIGHCONTRAST, "high contrast";
    # Two bits, four values, nothing else: every constant must live
    # inside the alpha field or notcurses rejects the write outright.
    is (AlphaOpaque, AlphaBlend, AlphaTransparent, AlphaHighContrast)
        .map({ alpha-constant($_) +& +^NC_BG_ALPHA_MASK }).unique.List,
        (0,), "every constant fits inside NC_BG_ALPHA_MASK";
};

subtest "AlphaMode enum surface" => {
    plan 3;
    is AlphaMode.enums.elems, 4, "exactly four modes — alpha is not continuous";
    is-deeply AlphaMode.enums.values.sort.List,
        <blend high-contrast opaque transparent>.List,
        "string values are the documented kebab-case names";
    is AlphaBlend.value, 'blend', "an individual mode stringifies to its value";
};

subtest "Style alpha defaults to undefined" => {
    plan 4;
    my $s = Selkie::Style.new(fg => 0xFF0000);
    nok $s.fg-alpha.defined, "fg-alpha undefined by default";
    nok $s.bg-alpha.defined, "bg-alpha undefined by default";
    # Mirrors fg/bg: undefined means "don't care", and the resolved
    # answer is what every widget rendered with before alpha existed.
    is $s.effective-fg-alpha, AlphaOpaque, "effective fg-alpha falls back to opaque";
    is $s.effective-bg-alpha, AlphaOpaque, "effective bg-alpha falls back to opaque";
};

subtest "Style alpha round-trips explicit values" => {
    plan 4;
    my $s = Selkie::Style.new(fg-alpha => AlphaBlend, bg-alpha => AlphaTransparent);
    is $s.fg-alpha, AlphaBlend, "fg-alpha stored";
    is $s.bg-alpha, AlphaTransparent, "bg-alpha stored";
    is $s.effective-fg-alpha, AlphaBlend, "effective fg-alpha is the explicit value";
    is $s.effective-bg-alpha, AlphaTransparent, "effective bg-alpha is the explicit value";
};

subtest "explicit AlphaOpaque is a value, not an absence" => {
    plan 3;
    my $s = Selkie::Style.new(fg-alpha => AlphaOpaque);
    ok $s.fg-alpha.defined, "explicit opaque is a defined value";
    is $s.effective-fg-alpha, AlphaOpaque, "resolves to opaque";
    # This is what makes "pin this element opaque over a blended base"
    # expressible through merge — see the merge matrix below.
    nok $s.bg-alpha.defined, "the other channel is untouched";
};

subtest "AlphaHighContrast on a background fails loud" => {
    plan 5;
    throws-like { Selkie::Style.new(bg-alpha => AlphaHighContrast) },
        Exception, message => /'foreground-only'/,
        "constructing bg-alpha => AlphaHighContrast throws";
    lives-ok { Selkie::Style.new(fg-alpha => AlphaHighContrast) },
        "the same mode is legal on a foreground";
    # notcurses is the reason: ncchannels_set_bg_alpha returns -1 for
    # HIGHCONTRAST and leaves the channel untouched, so without the
    # guard the failure is a background alpha that silently does
    # nothing, far from the style that asked for it.
    my uint64 $c = 0;
    is ncchannels_set_bg_alpha($c, NCALPHA_HIGHCONTRAST), -1,
        "notcurses itself rejects high contrast on a background";
    is $c, 0, "and leaves the channel word unchanged";
    # Merge builds a new Style, so it inherits the same guard.
    throws-like { Selkie::Style.new(bg => 0x101010)
                    .merge(Selkie::Style.new(bg-alpha => AlphaHighContrast)) },
        Exception, "merging one in throws too";
};

subtest "merge — override wins" => {
    plan 2;
    my $base = Selkie::Style.new(fg-alpha => AlphaOpaque, bg-alpha => AlphaOpaque);
    my $over = Selkie::Style.new(fg-alpha => AlphaBlend, bg-alpha => AlphaTransparent);
    my $m = $base.merge($over);
    is $m.fg-alpha, AlphaBlend, "override fg-alpha wins";
    is $m.bg-alpha, AlphaTransparent, "override bg-alpha wins";
};

subtest "merge — undefined inherits" => {
    plan 4;
    my $base = Selkie::Style.new(fg-alpha => AlphaBlend, bg-alpha => AlphaTransparent);
    my $m = $base.merge(Selkie::Style.new(fg => 0x00FF00, bold => True));
    is $m.fg-alpha, AlphaBlend, "fg-alpha inherited from base";
    is $m.bg-alpha, AlphaTransparent, "bg-alpha inherited from base";
    is $m.fg, 0x00FF00, "colours still merge as before";
    ok $m.bold, "flags still OR as before";
};

subtest "merge — explicit opaque override is respected" => {
    plan 3;
    # The escape hatch: opting one element out of a translucent parent
    # style. If merge treated AlphaOpaque as "unset" this would silently
    # inherit AlphaBlend and the element would stay see-through.
    my $base = Selkie::Style.new(fg-alpha => AlphaBlend, bg-alpha => AlphaBlend);
    my $m = $base.merge(Selkie::Style.new(fg-alpha => AlphaOpaque, bg-alpha => AlphaOpaque));
    is $m.fg-alpha, AlphaOpaque, "explicit opaque fg override pins opaque";
    is $m.bg-alpha, AlphaOpaque, "explicit opaque bg override pins opaque";
    is $m.effective-fg-alpha, AlphaOpaque, "and effective agrees";
};

subtest "merge — neither side sets alpha" => {
    plan 4;
    my $m = Selkie::Style.new(fg => 0x111111).merge(Selkie::Style.new(bg => 0x222222));
    nok $m.fg-alpha.defined, "fg-alpha stays undefined";
    nok $m.bg-alpha.defined, "bg-alpha stays undefined";
    is $m.effective-fg-alpha, AlphaOpaque, "resolves opaque";
    # Theme.rakumod builds dropdown-highlight through exactly this path.
    my $dh = Selkie::Theme.default.dropdown-highlight;
    nok $dh.fg-alpha.defined, "theme's merge-built slot is unaffected";
};

subtest "BYTE IDENTITY — default theme base-channels is unchanged" => {
    plan 5;

    # Hand-derived from the pre-alpha implementation:
    #
    #   my uint64 $channels = 0;
    #   ncchannels_set_fg_rgb($channels, $base.fg);   # 0xC0C0C0
    #   ncchannels_set_bg_rgb($channels, $base.bg);   # 0x1A1A2E
    #
    # ncchannel_set(channel, rgb) is
    #   (channel & ~(NC_BG_RGB_MASK | NC_BG_PALETTE)) | NC_BGDEFAULT_MASK | rgb
    # i.e. (0 & ~(0x00FFFFFF | 0x08000000)) | 0x40000000 | rgb.
    #
    #   fchannel = 0x40000000 | 0xC0C0C0 = 0x40C0C0C0, shifted into the
    #             high half by ncchannels_set_fg_rgb
    #   bchannel = 0x40000000 | 0x1A1A2E = 0x401A1A2E, the low half
    #
    #   => 0x40C0C0C0_401A1A2E
    #
    # The alpha fields (NC_BG_ALPHA_MASK, bits 28-29 of each half) are
    # zero, which is NCALPHA_OPAQUE — which is exactly why the new code
    # can skip the alpha writes entirely in the default case and still
    # produce this word bit for bit.
    constant PRE-ALPHA-BASE-CHANNELS = 0x40C0C0C0401A1A2E;

    my $w = PlainWidget.new;
    is $w.base-channels, PRE-ALPHA-BASE-CHANNELS,
        "base-channels for Selkie::Theme.default.base is byte-identical";
    is $w.base-egc, ' ', "base EGC is still a single space";

    # Decompose, so a failure above says which half moved.
    is ncchannels_fg_rgb($w.base-channels), 0xC0C0C0, "fg rgb intact";
    is ncchannels_bg_rgb($w.base-channels), 0x1A1A2E, "bg rgb intact";
    is (ncchannels_fg_alpha($w.base-channels), ncchannels_bg_alpha($w.base-channels)),
        (NCALPHA_OPAQUE, NCALPHA_OPAQUE), "both channels opaque";
};

subtest "base-style / base-egc are overridable hooks" => {
    plan 8;

    my $w = PlainWidget.new;
    is $w.base-style.fg, Selkie::Theme.default.base.fg, "default base-style is theme.base";

    # A scrim: no glyph of its own, both channels blended. gcluster 0
    # (empty EGC) is what lets the glyph search fall through to the
    # planes underneath.
    my class Scrim does Selkie::Widget {
        method render() { self.clear-dirty }
        method base-style(--> Selkie::Style) {
            Selkie::Style.new(
                fg => 0x000000, bg => 0x000000,
                fg-alpha => AlphaBlend, bg-alpha => AlphaBlend,
            );
        }
        method base-egc(--> Str) { '' }
    }
    my $s = Scrim.new;
    is $s.base-egc, '', "empty EGC survives the hook";
    is ncchannels_fg_alpha($s.base-channels), NCALPHA_BLEND, "fg blended";
    is ncchannels_bg_alpha($s.base-channels), NCALPHA_BLEND, "bg blended";
    is $s.base-channels, 0x5000000050000000, "packed word is alpha | rgb in both halves";

    # A style with alpha but no colours still marks the channel as
    # "not the terminal default" — ncchannel_set_alpha sets
    # NC_BGDEFAULT_MASK for any non-opaque alpha.
    my class Ghost does Selkie::Widget {
        method render() { self.clear-dirty }
        method base-style(--> Selkie::Style) {
            Selkie::Style.new(bg-alpha => AlphaTransparent);
        }
    }
    my $g = Ghost.new;
    is ncchannels_bg_alpha($g.base-channels), NCALPHA_TRANSPARENT, "bg transparent";
    is ncchannels_fg_alpha($g.base-channels), NCALPHA_OPAQUE, "fg untouched";
    is $g.base-channels, 0x60000000, "no fg half at all; bg is alpha + default-colour bit";
};

subtest "alpha cache — the opaque path makes no native call" => {
    plan 6;

    my $probe = AlphaProbe.new;
    my $opaque = Selkie::Style.new(fg => 0xC0C0C0, bg => 0x1A1A2E);

    # A widget that has never been given a plane is in the same state
    # init-plane leaves it in: ncplane_create zeroes the plane's
    # channels, and zero in both alpha fields is NCALPHA_OPAQUE.
    $probe.sync-plane-alpha($opaque);
    is $probe.alpha-calls.elems, 0, "first opaque style: no alpha call";
    $probe.sync-plane-alpha($opaque);
    is $probe.alpha-calls.elems, 0, "second opaque style: still no alpha call";

    my $blend = Selkie::Style.new(fg-alpha => AlphaBlend, bg-alpha => AlphaBlend);
    $probe.sync-plane-alpha($blend);
    is $probe.alpha-calls.elems, 1, "switching to blend pushes once";
    is-deeply $probe.alpha-calls[0], [AlphaBlend, AlphaBlend], "both channels pushed";

    $probe.sync-plane-alpha($blend);
    is $probe.alpha-calls.elems, 1, "re-applying the same style pushes nothing";

    $probe.sync-plane-alpha($opaque);
    is-deeply $probe.alpha-calls[1], [AlphaOpaque, AlphaOpaque],
        "switching back pushes opaque explicitly";
};

subtest "alpha cache — per-channel granularity and invalidation" => {
    plan 7;

    my $probe = AlphaProbe.new;
    # Only the background changes: the foreground must be left alone
    # rather than redundantly re-stated.
    $probe.sync-plane-alpha(Selkie::Style.new(bg-alpha => AlphaTransparent));
    is $probe.alpha-calls.elems, 1, "one push";
    is-deeply $probe.alpha-calls[0], [AlphaMode, AlphaTransparent],
        "fg entry is undefined — 'leave this channel alone'";

    $probe.sync-plane-alpha(Selkie::Style.new(
        fg-alpha => AlphaHighContrast, bg-alpha => AlphaTransparent));
    is-deeply $probe.alpha-calls[1], [AlphaHighContrast, AlphaMode],
        "now only the foreground moves";

    # reset-style-cache forgets what the plane is believed to hold, so
    # the next apply re-states both channels even though nothing about
    # the style changed.
    $probe.reset-style-cache;
    $probe.sync-plane-alpha(Selkie::Style.new(
        fg-alpha => AlphaHighContrast, bg-alpha => AlphaTransparent));
    is $probe.alpha-calls.elems, 3, "reset-style-cache forces a re-push";
    is-deeply $probe.alpha-calls[2], [AlphaHighContrast, AlphaTransparent],
        "both channels re-stated";

    # An adopted plane belongs to someone else and may be in any state,
    # so adopt-plane drops the cache to unknown rather than assuming.
    my $adopter = AlphaProbe.new;
    $adopter.adopt-plane(NcplaneHandle, rows => 4, cols => 4);
    $adopter.sync-plane-alpha(Selkie::Style.new(fg => 0xFFFFFF));
    is $adopter.alpha-calls.elems, 1, "adopt-plane invalidates the cache";
    is-deeply $adopter.alpha-calls[0], [AlphaOpaque, AlphaOpaque],
        "opaque is stated explicitly on a borrowed plane";
};