Notcurses-Native.git | xt/ | 02-plane.rakutest edit

---

use Test;
use lib 'lib';
use lib 't/lib';
use TestHelper;
use NativeCall;
use Notcurses::Native;
use Notcurses::Native::Types;
use Notcurses::Native::Plane;

plan 10;


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', 5;
	exit 0;
}

LEAVE { notcurses_stop($nc) if $nc.defined }

my $std = notcurses_stdplane($nc);

subtest 'Standard plane exists' => {
	plan 1;
	ok $std.defined, 'Standard plane returned';
};

subtest 'Plane dimensions' => {
	plan 2;
	my uint32 ($rows, $cols);
	ncplane_dim_yx($std, $rows, $cols);
	ok $rows > 0, "Rows > 0 (got $rows)";
	ok $cols > 0, "Cols > 0 (got $cols)";
};

subtest 'Plane dim helpers (FFI)' => {
	plan 2;
	my $y = ncplane_dim_y($std);
	my $x = ncplane_dim_x($std);
	ok $y > 0, "dim_y > 0 (got $y)";
	ok $x > 0, "dim_x > 0 (got $x)";
};

subtest 'Create child plane' => {
	plan 3;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(5), :cols(10));
	my $child = ncplane_create($std, $child-opts);
	ok $child.defined, 'Child plane created';
	my $cy = ncplane_dim_y($child);
	my $cx = ncplane_dim_x($child);
	is $cy, 5, 'Child rows = 5';
	is $cx, 10, 'Child cols = 10';
	ncplane_destroy($child);
};

subtest 'Plane putstr and cursor' => {
	plan 2;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(3), :cols(20));
	my $child = ncplane_create($std, $child-opts);
	ncplane_putstr_yx($child, 0, 0, 'Hello');
	my uint32 ($cy, $cx);
	ncplane_cursor_yx($child, $cy, $cx);
	is $cy, 0, 'Cursor y = 0 (same row)';
	is $cx, 5, 'Cursor x = 5 (after Hello)';
	ncplane_destroy($child);
};

subtest 'Plane read back text' => {
	plan 1;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(3), :cols(20));
	my $child = ncplane_create($std, $child-opts);
	ncplane_putstr_yx($child, 0, 0, 'Hello');
	my uint16 $style;
	my uint64 $channels;
	my $ch = ncplane_at_cursor($child, $style, $channels);
	# Cursor is at (0,5) after "Hello", reading there gives space or empty
	# Read at (0,0) should give 'H'
	ncplane_cursor_move_yx($child, 0, 0);
	$ch = ncplane_at_yx($child, 0, 0, $style, $channels);
	is $ch, 'H', 'Read back H at (0,0)';
	ncplane_destroy($child);
};

subtest 'Plane colors (via Plane module)' => {
	plan 2;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(5), :cols(10));
	my $child = ncplane_create($std, $child-opts);
	ncplane_set_fg_rgb8($child, 255, 0, 0);
	ncplane_set_bg_rgb8($child, 0, 0, 255);
	my $fg = ncplane_fg_rgb($child);
	my $bg = ncplane_bg_rgb($child);
	is $fg, 0xFF0000, 'FG red via Plane module';
	is $bg, 0x0000FF, 'BG blue via Plane module';
	ncplane_destroy($child);
};

subtest 'Plane styles (via Plane module)' => {
	plan 2;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(5), :cols(10));
	my $child = ncplane_create($std, $child-opts);
	ncplane_on_styles($child, NCSTYLE_BOLD);
	my $s = ncplane_styles($child);
	ok $s +& NCSTYLE_BOLD, 'Bold set';
	ncplane_off_styles($child, NCSTYLE_BOLD);
	$s = ncplane_styles($child);
	nok $s +& NCSTYLE_BOLD, 'Bold cleared';
	ncplane_destroy($child);
};

subtest 'Plane navigation' => {
	plan 2;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(5), :cols(10));
	my $child = ncplane_create($std, $child-opts);
	my $parent = ncplane_parent($child);
	ok $parent.defined, 'Parent plane found';
	my $nc-from-plane = ncplane_notcurses($child);
	ok $nc-from-plane.defined, 'notcurses context from plane';
	ncplane_destroy($child);
};

subtest 'Plane printf (variadic)' => {
	plan 1;
	my $child-opts = NcplaneOptions.new(:y(0), :x(0), :rows(3), :cols(40));
	my $child = ncplane_create($std, $child-opts);
	my int32 $num = 42;
	ncplane_printf_yx($child, 0, 0, "val=%d", $num);
	my uint32 ($cy, $cx);
	ncplane_cursor_yx($child, $cy, $cx);
	is $cx, 6, 'Printf wrote 6 chars (val=42)';
	ncplane_destroy($child);
};

done-testing;