view release on metacpan or  search on metacpan

t/Object/GP.t  view on Meta::CPAN

    [ 2, 2, 0 ],
    [ 1, 1, 0xFFFFFF ],
    [ 3, 3, 0xFFFFFF ]
];
run_tests( $x, $coordinates, "put_image");

# 18
$x-> color( cl::White);
$x-> bar( 0, 0, 7, 7);
$x-> stretch_image( 0, 0, 16, 16, $image);
$coordinates = [
    [ 2, 4, 0 ],
    [ 4, 2, 0 ],
    [ 4, 6, 0 ],
    [ 6, 4, 0 ],
    [ 4, 4, 0 ],
    [ 2, 2, 0xFFFFFF ],
    [ 6, 6, 0xFFFFFF ],
    ];
run_tests( $x, $coordinates, "stretch_image");

# 19
$x-> put_image_indirect( $image, 0, 0, 0, 0, 16, 16, 8, 8, rop::XorPut);
$coordinates = [
    [ 0, 0, 0 ],
    [ 1, 1, 0 ],
    [ 2, 2, 0 ],
    [ 3, 3, 0 ],
    [ 4, 4, 0 ],
    [ 5, 5, 0 ],
    [ 6, 6, 0 ],
    [ 7, 7, 0 ],
];
run_tests( $x, $coordinates, "xor_put");
$image-> destroy;

# 20
sub text_out_test
{
	my $x = shift;
	$x-> color( cl::White);
	$x-> bar( 0, 0, 7, 7);
	$x-> color( cl::Black);
	$x-> font-> height( 8);
	$x-> text_out( "xyz", 0, 0);
	my $xi = $x-> image;
	$xi->type(im::BW);
	my ( $i, $j);
	my ( $wh, $bl) = ( 0, 0);
	for ( $i = 0; $i < 8; $i++) {
		for ( $j = 0; $j < 8; $j++) {
			$xi-> pixel( $i,$j) == 0 ?
				$bl++ : $wh++;
		}
	}
	return $bl;
}

my $bl = text_out_test($x);
if ( $bl == 0 ) {
	# did we hit this bug? https://gitlab.freedesktop.org/xorg/xserver/issues/87
	my $x = Prima::DeviceBitmap-> create( type => dbt::Pixmap, width => 8, height => 8);
	$bl = text_out_test($x);
}

	
cmp_ok( $bl, '>', 5, "text_out");

# 21
my $y = Prima::DeviceBitmap-> create( type => dbt::Bitmap, width => 2, height => 2);
$y-> clear;
$y-> pixel( 0, 0, cl::Black);
$y-> translate( 1, 1);
$x-> color( cl::White);
$x-> bar(0,0,8,8);
$x-> set( color => cl::Black, backColor => cl::White);
$x-> put_image( 0, 0, $y);
$y-> destroy;
is( $x-> pixel( 0, 0), 0, 'dbm(put_image)');

$x-> destroy;

sub run_tests {
    my ($x, $coordinates, $name) =  @_;
    for my $coordinate( @$coordinates ) {
        my ($xco, $yco, $expected) = @$coordinate;
        is( $x->pixel( $xco, $yco ), $expected, "$name ($xco, $yco)" );
    }
}

done_testing;