Selkie.git | t/ | 77-image-rgba-blit.rakutest

---

use Test;
use lib 'lib';
use NativeCall;
use Notcurses::Native;
use Notcurses::Native::Types;
use Notcurses::Native::Cell;
use Notcurses::Native::Plane;
use Notcurses::Native::Channel;
use Notcurses::Native::Visual;

use Selkie::Test::SnapshotPlatform;

=begin pod
Integration guard for the native wiring behind C<Image.set-rgba>.

C<Image.!load> builds its visual with
C<ncvisual_from_rgba(ptr, height, width × 4, width)> from the retained
RGBA buffer. This file proves those exact parameters round-trip: a
B<non-square> 4×2 image (so a width/height transposition or a wrong
rowstride would corrupt the output) laid out as a flat
C<Buf[uint8]> of R,G,B,A bytes — precisely what C<set-rgba> is handed —
blits back to the original per-pixel colours.

The state-machine side of set-rgba (source-id, source switching, size
validation) is covered headlessly by F<t/76-image-rgba-source.rakutest>;
everything downstream of C<$!visual> (scaling, emit-blit, teardown) is
shared with the file path proven by F<t/69-image-clip-only-blit.rakutest>.
=end pod

plan 1;

unless $*ERR.t || %*ENV<NOTCURSES_FORCE>.so {
    skip 'No terminal available', 1;
    exit 0;
}

my Pointer $devnull = snapshot-fopen(NULL-PATH, 'w');
my $opts = NotcursesOptions.new(
    :loglevel(NCLOGLEVEL_SILENT),
    :flags(NCOPTION_SUPPRESS_BANNERS
        +| NCOPTION_NO_ALTERNATE_SCREEN
        +| NCOPTION_INHIBIT_SETLOCALE),
);
my $nc = notcurses_init($opts, $devnull);
unless $nc.defined {
    skip 'notcurses_init failed (no usable terminal)', 1;
    exit 0;
}
LEAVE {
    notcurses_stop($nc) if $nc.defined;
    snapshot-fclose($devnull) if $devnull.defined;
}

# A 4-wide × 2-tall RGBA image as a flat Buf[uint8] — the layout
# Image.set-rgba retains (R,G,B,A per pixel, row-major, tightly packed).
constant W = 4;
constant H = 2;
my @pixels =
    (255,0,0),   (0,255,0),   (0,0,255),     (255,255,0),    # row 0
    (255,0,255), (0,255,255), (128,128,128), (255,255,255);  # row 1
my $rgba = Buf[uint8].new;
$rgba.append($_[0], $_[1], $_[2], 255) for @pixels;

sub cell-bg-rgb($plane, Int $y, Int $x) {
    my $cell = Nccell.new;
    ncplane_at_yx_cell($plane, $y, $x, $cell);
    my uint32 $r; my uint32 $g; my uint32 $b;
    ncchannels_bg_rgb8($cell.channels, $r, $g, $b);
    nccell_release($plane, $cell);
    ($r.Int, $g.Int, $b.Int);
}

subtest 'set-rgba parameters blit back to the source pixels' => {
    plan W * H + 1;

    # Mirror Image.!load exactly: set-rgba retains the caller's Buf and
    # !load hands its storage straight to ncvisual_from_rgba via
    # nativecast(Pointer, $buf) — zero copy. Pass the Buf the same way.
    my $visual = ncvisual_from_rgba(nativecast(Pointer, $rgba), H, W * 4, W);
    ok $visual.defined, 'ncvisual_from_rgba built a visual from the RGBA Buf';
    LEAVE { ncvisual_destroy($visual) if $visual.defined }

    # Blit 1:1 — NCBLIT_1x1 so one cell == one source pixel.
    my $std  = notcurses_stdplane($nc);
    my $opts = NcplaneOptions.new(y => 0, x => 0, rows => H, cols => W);
    my $plane = ncplane_create($std, $opts);
    LEAVE { ncplane_destroy($plane) if $plane.defined }

    my $vopts = NcvisualOptions.new(scaling => NCSCALE_NONE, blitter => NCBLIT_1x1);
    $vopts.set-plane($plane);
    ncvisual_blit($nc, $visual, $vopts);

    for ^H -> $y {
        for ^W -> $x {
            my $want = @pixels[$y * W + $x].List;
            is-deeply cell-bg-rgb($plane, $y, $x), $want,
                "cell ($y,$x) == source pixel ({$want.join(',')})";
        }
    }
};

done-testing;