1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
|
#!/usr/bin/perl
use v5.14;
use warnings;
use utf8;
use Test::More;
use Tickit::Test;
use Tickit::RenderBuffer qw( LINE_SINGLE );
use Tickit::Pen;
use Tickit::Rect;
my $term = mk_term;
my $rb = Tickit::RenderBuffer->new(
lines => 10,
cols => 20,
);
my $mask = Tickit::Rect->new(
top => 3,
left => 5,
lines => 4,
cols => 6,
);
# mask over text
{
$rb->mask( $mask );
# MMMMMM
$rb->text_at( 3, 2, "ABCDEFG" ); # before
$rb->text_at( 4, 6, "HI" ); # inside
$rb->text_at( 5, 8, "JKLMN" ); # after
$rb->text_at( 6, 2, "OPQRSTUVWXYZ" ); # spanning
$rb->flush_to_term( $term );
is_termlog( [ GOTO(3, 2), SETPEN(), PRINT("ABC"),
GOTO(5,11), SETPEN(), PRINT("MN"),
GOTO(6, 2), SETPEN(), PRINT("OPQ"),
GOTO(6,11), SETPEN(), PRINT("XYZ") ],
'@methods for text over mask' );
}
# mask over erase
{
$rb->mask( $mask );
$rb->erase_at( 3, 2, 6 ); # before
$rb->erase_at( 4, 6, 2 ); # inside
$rb->erase_at( 5, 8, 5 ); # after
$rb->erase_at( 6, 2, 12 ); # spanning
$rb->flush_to_term( $term );
is_termlog( [ GOTO(3, 2), SETPEN(), ERASECH(3),
GOTO(5,11), SETPEN(), ERASECH(2),
GOTO(6, 2), SETPEN(), ERASECH(3),
GOTO(6,11), SETPEN(), ERASECH(3) ],
'@methods for erase over mask' );
}
# mask over lines
{
$rb->mask( $mask );
$rb->hline_at( 3, 2, 8, LINE_SINGLE );
$rb->hline_at( 4, 6, 8, LINE_SINGLE );
$rb->hline_at( 5, 8, 13, LINE_SINGLE );
$rb->hline_at( 6, 2, 14, LINE_SINGLE );
$rb->flush_to_term( $term );
is_termlog( [ GOTO(3, 2), SETPEN(), PRINT("╶──"),
GOTO(5,11), SETPEN(), PRINT("──╴"),
GOTO(6, 2), SETPEN(), PRINT("╶──"),
GOTO(6,11), SETPEN(), PRINT("───╴") ],
'@methods for erase over mask' );
}
# restore removes masks
{
{
$rb->save;
$rb->mask( $mask );
$rb->text_at( 3, 0, "A"x20 );
$rb->restore;
}
$rb->text_at( 4, 0, "B"x20 );
$rb->flush_to_term( $term );
is_termlog( [ GOTO(3, 0), SETPEN(), PRINT("AAAAA"),
GOTO(3,11), SETPEN(), PRINT("AAAAAAAAA"),
GOTO(4, 0), SETPEN(), PRINT("BBBBBBBBBBBBBBBBBBBB") ],
'@methods for text_at after save/mask/remove' );
}
# translate over mask
{
$rb->mask( Tickit::Rect->new( top => 2, left => 2, lines => 1, cols => 1 ) );
{ $rb->save; $rb->translate( 0, 0 ); $rb->text_at( 0, 0, "A" ); $rb->restore }
{ $rb->save; $rb->translate( 0, 2 ); $rb->text_at( 0, 0, "B" ); $rb->restore }
{ $rb->save; $rb->translate( 2, 0 ); $rb->text_at( 0, 0, "C" ); $rb->restore }
{ $rb->save; $rb->translate( 2, 2 ); $rb->text_at( 0, 0, "D" ); $rb->restore }
$rb->flush_to_term( $term );
is_termlog( [ GOTO(0,0), SETPEN(), PRINT("A"),
GOTO(0,2), SETPEN(), PRINT("B"),
GOTO(2,0), SETPEN(), PRINT("C"),
# D was masked
],
'@methods for text_at after mask over translate' );
}
# mask out of limits doesn't segv
{
$rb->save;
# Too big
$rb->mask( Tickit::Rect->new( top => 0, left => 0, lines => 50, cols => 200 ) );
# Negative
$rb->mask( Tickit::Rect->new( top => -10, left => -20, lines => 5, cols => 20 ) );
$rb->restore;
}
done_testing;
|