use Test;
use lib 'lib';
use lib 't/lib';
use TestHelper;
use NativeCall;
use Notcurses::Native;
use Notcurses::Native::Types;
use Notcurses::Native::Plane;
use Notcurses::Native::Cell;
use Notcurses::Native::Channel;
use Notcurses::Native::Context;
plan 8;
my $opts = NotcursesOptions.new(
:loglevel(NCLOGLEVEL_SILENT),
:flags(NCOPTION_SUPPRESS_BANNERS +| NCOPTION_NO_ALTERNATE_SCREEN +| NCOPTION_INHIBIT_SETLOCALE),
);
my ($nc, $) = test-init-nc($opts);
unless $nc.defined {
skip 'No terminal available', 8;
exit 0;
}
LEAVE { notcurses_stop($nc) if $nc.defined }
my $std = notcurses_stdplane($nc);
# Helper: render and read back character + attributes at given position
sub rendered-at(Int $y, Int $x) {
my uint16 $style;
my uint64 $channels;
my $ch = notcurses_at_yx($nc, $y, $x, $style, $channels);
%( :$ch, :$style, :$channels,
fg => ncchannels_fg_rgb($channels),
bg => ncchannels_bg_rgb($channels) )
}
subtest 'Rendered text matches written text' => {
plan 10;
my $child = ncplane_create($std, NcplaneOptions.new(:rows(2), :cols(20)));
ncplane_putstr_yx($child, 0, 0, 'ABCDE');
ncplane_putstr_yx($child, 1, 0, 'FGHIJ');
notcurses_render($nc);
for
.kv -> $i, $expected {
my %r = rendered-at(0, $i);
is %r, $expected, "Position (0,$i) renders '$expected'";
}
for .kv -> $i, $expected {
my %r = rendered-at(1, $i);
is %r, $expected, "Position (1,$i) renders '$expected'";
}
ncplane_destroy($child);
};
subtest 'Rendered colors match set colors' => {
plan 8;
my $child = ncplane_create($std, NcplaneOptions.new(:rows(2), :cols(10)));
# Red text on blue background
ncplane_set_fg_rgb8($child, 255, 0, 0);
ncplane_set_bg_rgb8($child, 0, 0, 255);
ncplane_putstr_yx($child, 0, 0, 'Red');
# Green text on black background
ncplane_set_fg_rgb8($child, 0, 255, 0);
ncplane_set_bg_rgb8($child, 0, 0, 0);
ncplane_putstr_yx($child, 1, 0, 'Grn');
notcurses_render($nc);
my %r0 = rendered-at(0, 0);
is %r0, 'R', 'Char at (0,0) = R';
is %r0, 0xFF0000, 'FG at (0,0) = red';
is %r0, 0x0000FF, 'BG at (0,0) = blue';
my %r01 = rendered-at(0, 1);
is %r01, 0xFF0000, 'FG at (0,1) still red (same putstr)';
my %r1 = rendered-at(1, 0);
is %r1, 'G', 'Char at (1,0) = G';
is %r1, 0x00FF00, 'FG at (1,0) = green';
is %r1, 0x000000, 'BG at (1,0) = black';
my %r12 = rendered-at(1, 2);
is %r12, 0x00FF00, 'FG at (1,2) still green';
ncplane_destroy($child);
};
subtest 'Rendered styles match set styles' => {
plan 6;
my $child = ncplane_create($std, NcplaneOptions.new(:rows(3), :cols(10)));
ncplane_on_styles($child, NCSTYLE_BOLD);
ncplane_putstr_yx($child, 0, 0, 'B');
ncplane_off_styles($child, NCSTYLE_BOLD);
ncplane_on_styles($child, NCSTYLE_ITALIC);
ncplane_putstr_yx($child, 1, 0, 'I');
ncplane_off_styles($child, NCSTYLE_ITALIC);
ncplane_on_styles($child, NCSTYLE_BOLD +| NCSTYLE_UNDERLINE);
ncplane_putstr_yx($child, 2, 0, 'X');
notcurses_render($nc);
my %b = rendered-at(0, 0);
ok %b