Selkie.git | t/ | 102-image-crop-cache.rakutest


use Test;
use lib 'lib';
use NativeCall;

use Notcurses::Native;
use Notcurses::Native::Types;
use Notcurses::Native::Plane;
use Notcurses::Native::Visual;

use Selkie::Sizing;
use Selkie::Test::SnapshotPlatform;
use Selkie::Trace;
use Selkie::Widget::Image;   # exports crop-cache-key, plane-address

=begin pod
C<Image.render-viewport-crop> used to call C<destroy-blit-plane>
unconditionally on every invocation. The destroy marks every widget
under the removed sprixel's rect dirty, which re-dirties the very card
that just asked for the render — a self-sustaining teardown loop that
measured at 33% of all frame time in App::Cantina.

Two layers of coverage here:

=item The cache key itself (C<crop-cache-key>), a pure function, is
    pinned field by field: every input that can change the emitted
    sprixel must change the key, and nothing else may.
=item The live behaviour — no teardown when the inputs repeat, a
    teardown when any of them changes, and correct invalidation across
    park / occlusion — needs a notcurses context, so it is gated the
    same way F<t/69-image-clip-only-blit.rakutest> is.
=end pod

plan 9;

# --- Pure cache-key coverage (no terminal needed) --------------------

my %base =
    parent-plane => 0x1000,
    source-id    => 'avatar.png',
    clip-only    => True,
    self-rows    => 8,   self-cols  => 12,
    cell-px-y    => 20,  cell-px-x  => 10,
    dest-y       => 3,   dest-x     => 1,
    source-row   => 0,   source-col => 0,
    rows         => 8,   cols       => 12,
    pixel-impl   => 3,
;

subtest 'identical inputs produce an identical key' => {
    plan 2;
    is crop-cache-key(|%base), crop-cache-key(|%base),
        'same arguments, same key';
    isnt crop-cache-key(|%base), '',
        'key is a non-empty token';
};

subtest 'every keyed input changes the key' => {
    # One assertion per field: if any of these ever stops mattering,
    # the cache starts serving a stale sprixel.
    my %deltas =
        parent-plane => 0x2000,
        source-id    => 'other.png',
        clip-only    => False,
        self-rows    => 9,   self-cols  => 13,
        cell-px-y    => 21,  cell-px-x  => 11,
        dest-y       => 4,   dest-x     => 2,
        source-row   => 1,   source-col => 1,
        rows         => 7,   cols       => 11,
        pixel-impl   => 2,
    ;
    plan %deltas.elems;
    my $baseline = crop-cache-key(|%base);
    for %deltas.keys.sort -> $field {
        my %m = %base;
        %m{$field} = %deltas{$field};
        isnt crop-cache-key(|%m), $baseline,
            "changing $field invalidates the key";
    }
};

subtest 'an undefined source-id is a stable, distinct key' => {
    plan 3;
    my %none = %base;
    %none<source-id> = Str;
    is crop-cache-key(|%none), crop-cache-key(|%none),
        'undefined source-id keys are stable';
    isnt crop-cache-key(|%none), crop-cache-key(|%base),
        'undefined source-id differs from a named source';
    my %empty = %base;
    %empty<source-id> = '';
    is crop-cache-key(|%none), crop-cache-key(|%empty),
        'undefined and empty source-id coincide (both mean "no source")';
};

subtest 'source-id cannot forge a field boundary' => {
    plan 1;
    # Fields are NUL-joined precisely so a caller-supplied id can never
    # collide with a different (id, geometry) pair by concatenation.
    my %a = %base; %a<source-id> = 'a'; %a<self-rows> = 18;
    my %b = %base; %b<source-id> = 'a1'; %b<self-rows> = 8;
    isnt crop-cache-key(|%a), crop-cache-key(|%b),
        'ambiguous concatenations stay distinct';
};

subtest 'plane-address is 0 for an undefined handle' => {
    plan 2;
    is plane-address(NcplaneHandle), 0, 'undefined handle maps to 0';
    my $fake = nativecast(NcplaneHandle, Pointer.new(0xbeef));
    is plane-address($fake), 0xbeef, 'defined handle yields its address';
};

# --- Live render-viewport-crop behaviour (needs notcurses) -----------

my $LIVE = 4;   # subtests below this point

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

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

my $std = notcurses_stdplane($nc);

# A 16x16 RGBA square, handed to the widget by reference.
sub gradient-buf(--> Buf) {
    my $b = Buf.new;
    for ^16 -> $y {
        for ^16 -> $x {
            $b.push($y * 16, $x * 16, 64, 255);
        }
    }
    $b;
}

# Build an Image parented under a host plane, sized 8x8 cells, with an
# in-memory RGBA source so no file IO is involved.
sub make-image(Str :$id = 'crop-cache', Bool :$clip-only = True) {
    my $img = Selkie::Widget::Image.new(
        sizing => Sizing.fixed(8), :$clip-only);
    $img.init-plane($std, y => 0, x => 0, rows => 8, cols => 8);
    $img.set-viewport(abs-y => 0, abs-x => 0, rows => 8, cols => 8);
    $img.set-rgba(gradient-buf(), :width(16), :height(16), :$id);
    $img;
}

sub crop($img, |c) {
    $img.render-viewport-crop(
        parent-plane => $std,
        dest-y => 0, dest-x => 0,
        source-row => 0, source-col => 0,
        rows => 8, cols => 8,
        |c,
    );
}

# Count image.destroy-blit-plane spans emitted while &body runs. Only
# real teardowns emit — the method's no-op guard runs before the span.
sub destroys-during(&body --> Int) {
    my $path = $*TMPDIR.add("selkie-crop-cache-{$*PID}-{now.Int}-{(^10000).pick}.json").Str;
    Selkie::Trace.init(mode => 'trace', trace-path => $path);
    body();
    Selkie::Trace.shutdown;
    my $json = $path.IO.slurp;
    $path.IO.unlink if $path.IO.e;
    +$json.comb(/'"image.destroy-blit-plane"'/);
}

subtest 'repeat crops with unchanged geometry do not tear the sprixel down' => {
    plan 3;
    my $img = make-image();
    ok crop($img), 'first crop renders';
    ok $img.has-blit-plane, 'a blit-plane exists after the first crop';

    my $destroys = destroys-during({ crop($img) for ^20 });
    is $destroys, 0,
        '20 identical crops perform zero blit-plane teardowns';
    $img.destroy;
};

subtest 'any geometry change invalidates the cache' => {
    my @cases =
        'dest-y'     => %( dest-y     => 2 ),
        'dest-x'     => %( dest-x     => 2 ),
        'source-row' => %( source-row => 2 ),
        'source-col' => %( source-col => 2 ),
        'rows'       => %( rows       => 6 ),
        'cols'       => %( cols       => 6 ),
    ;
    plan @cases.elems + 2;

    for @cases -> $case {
        my $img = make-image();
        crop($img);
        my $destroys = destroys-during({ crop($img, |$case.value) });
        is $destroys, 1,
            "changing {$case.key} forces exactly one teardown + re-blit";
        $img.destroy;
    }

    # Source swap: same geometry, different picture.
    my $img = make-image();
    crop($img);
    my $destroys = destroys-during({
        $img.set-rgba(gradient-buf(), :width(16), :height(16), :id<other>);
        crop($img);
    });
    is $destroys, 1, 'a new source id forces a teardown + re-blit';

    # ...and settles again straight afterwards.
    is destroys-during({ crop($img) for ^5 }), 0,
        'the cache re-arms against the new source';
    $img.destroy;
};

subtest 'render leaves a crop-owned sprixel alone for clip-only images' => {
    plan 5;
    # The other half of the loop: a card's own render pass runs before
    # the container merges it, and Image.render's clip-only branch used
    # to destroy whatever blit-plane it found. For a clip-only Image the
    # crop path is the only blit authority, so that teardown re-dirtied
    # the card it had just rendered and the cycle restarted every frame.
    my $img = make-image();
    crop($img);
    ok $img.has-blit-plane, 'crop produced a sprixel';

    is destroys-during({ $img.render for ^10 }), 0,
        'render does not tear the crop-owned sprixel down';
    ok $img.has-blit-plane, 'the sprixel is still live after rendering';
    is destroys-during({ crop($img) }), 0,
        'and the crop cache is still armed (no re-blit needed)';

    # But render must still tear it down when the picture goes away —
    # ownership is not a licence to keep painting a dead source.
    $img.clear-image;
    $img.render;
    nok $img.has-blit-plane,
        'clearing the source makes render drop the sprixel';
    $img.destroy;
};

subtest 'park and occlusion invalidate; unpark re-blits' => {
    plan 6;
    my $img = make-image();
    crop($img);
    ok $img.has-blit-plane, 'blit-plane live before park';

    $img.park;
    nok $img.has-blit-plane, 'park tore the blit-plane down';
    is destroys-during({ crop($img) }), 0,
        'the post-park crop has nothing to destroy';
    ok $img.has-blit-plane, 'and re-blits rather than serving a stale cache';

    # Modal occlusion: Image consults the app-level modal provider, and
    # a modal that is not an ancestor of this Image occludes it.
    use Selkie::Tree;
    my $modal = make-image(id => 'modal-stand-in');
    set-modal-provider(-> { $modal });
    LEAVE { set-modal-provider(-> { Nil }) }

    is destroys-during({ crop($img) }), 1,
        'becoming occluded tears the sprixel down';
    nok $img.has-blit-plane, 'no sprixel survives occlusion';
    $modal.destroy;
    $img.destroy;
};

done-testing;