X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/f0960b14ef3c415ec87e69c8636fc81737099b48..a6eb1f94b51a50d11ec7435d1a8f680ec4fb8689:/t/t023palette.t diff --git a/t/t023palette.t b/t/t023palette.t index 6b081962..db37a0bc 100644 --- a/t/t023palette.t +++ b/t/t023palette.t @@ -1,15 +1,20 @@ #!perl -w # some of this is tested in t01introvert.t too use strict; -use lib 't'; -use Test::More tests => 64; -BEGIN { use_ok("Imager"); } +use Test::More tests => 226; +BEGIN { use_ok("Imager", ':handy'); } + +use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image is_color4 is_fcolor3); + +Imager->open_log(log => "testout/t023palette.log"); + +sub isbin($$$); my $img = Imager->new(xsize=>50, ysize=>50, type=>'paletted'); ok($img, "paletted image created"); -ok($img->type eq 'paletted', "got a paletted image"); +is($img->type, 'paletted', "got a paletted image"); my $black = Imager::Color->new(0,0,0); my $red = Imager::Color->new(255,0,0); @@ -24,7 +29,9 @@ my $blacki = $img->addcolors(colors=>[ $black, $red, $green, $blue ]); print "# blacki $blacki\n"; ok(defined $blacki && $blacki == 0, "we got the first color"); -ok($img->colorcount() == 4, "should have 4 colors"); +is($img->colorcount(), 4, "should have 4 colors"); +is($img->maxcolors, 256, "maxcolors always 256"); + my ($redi, $greeni, $bluei) = 1..3; my @all = $img->getcolors; @@ -78,20 +85,20 @@ $img->setcolors(start=>$red, colors=>[$red, $green]); # draw on the image, make sure it stays paletted when it should ok($img->box(color=>$red, filled=>1), "fill with red"); -ok($img->type eq 'paletted', "paletted after fill"); +is($img->type, 'paletted', "paletted after fill"); ok($img->box(color=>$green, filled=>1, xmin=>10, ymin=>10, xmax=>40, ymax=>40), "green box"); -ok($img->type eq 'paletted', 'still paletted after box'); +is($img->type, 'paletted', 'still paletted after box'); # an AA line will almost certainly convert the image to RGB, don't use # an AA line here ok($img->line(color=>$blue, x1=>10, y1=>10, x2=>40, y2=>40), "draw a line"); -ok($img->type eq 'paletted', 'still paletted after line'); +is($img->type, 'paletted', 'still paletted after line'); # draw with white - should convert to direct ok($img->box(color=>$white, filled=>1, xmin=>20, ymin=>20, xmax=>30, ymax=>30), "white box"); -ok($img->type eq 'direct', "now it should be direct"); +is($img->type, 'direct', "now it should be direct"); # various attempted to make a paletted image from our now direct image my $palimg = $img->to_paletted; @@ -140,7 +147,7 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/, SKIP: { skip("don't want to allocate 4Gb", 10) - unless $Config{intsize} == 4; + unless $Config{ptrsize} == 4; my $uint_range = 256 ** $Config{intsize}; my $dim1 = int(sqrt($uint_range))+1; @@ -175,7 +182,7 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/, # test the scanline allocation check # divide by 2 to get int range, by 3 so that the image (one byte/pixel) # doesn't integer overflow, but the scanline of i_color (4/pixel) does - my $dim4 = $uint_range / 2 / 3; + my $dim4 = $uint_range / 3; my $im_o = Imager->new(xsize=>$dim4, ysize=>1, channels=>3, type=>'paletted'); is($im_o, undef, "integer overflow check - scanline size"); cmp_ok(Imager->errstr, '=~', @@ -211,6 +218,450 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/, "set after the last color"); } +{ # https://rt.cpan.org/Ticket/Display.html?id=20056 + # added named color support to addcolor/setcolor + my $img = Imager->new(xsize => 10, ysize => 10, type => 'paletted'); + is($img->addcolors(colors => [ qw/000000 FF0000/ ]), "0 but true", + "add colors as strings instead of objects"); + my @colors = $img->getcolors; + iscolor($colors[0], $black, "check first color"); + iscolor($colors[1], $red, "check second color"); + ok($img->setcolors(colors => [ qw/00FF00 0000FF/ ]), + "setcolors as strings instead of objects"); + @colors = $img->getcolors; + iscolor($colors[0], $green, "check first color"); + iscolor($colors[1], $blue, "check second color"); + + # make sure we handle bad colors correctly + is($img->colorcount, 2, "start from a known state"); + is($img->addcolors(colors => [ 'XXFGXFXGXFX' ]), undef, + "fail to add unknown color"); + is($img->errstr, 'No color named XXFGXFXGXFX found', 'check error message'); + is($img->setcolors(colors => [ 'XXFGXFXGXFXZ' ]), undef, + "fail to set to unknown color"); + is($img->errstr, 'No color named XXFGXFXGXFXZ found', 'check error message'); +} + +{ # https://rt.cpan.org/Ticket/Display.html?id=20338 + # OO interface to i_glin/i_plin + my $im = Imager->new(xsize => 10, ysize => 10, type => 'paletted'); + is($im->addcolors(colors => [ "#000", "#F00", "#0F0", "#00F" ]), "0 but true", + "add some test colors") + or print "# ", $im->errstr, "\n"; + # set a pixel to check + $im->setpixel(x => 1, 'y' => 0, color => "#0F0"); + is_deeply([ $im->getscanline('y' => 0, type=>'index') ], + [ 0, 2, (0) x 8 ], "getscanline index in list context"); + isbin($im->getscanline('y' => 0, type=>'index'), + "\x00\x02" . "\x00" x 8, + "getscanline index in scalar context"); + is($im->setscanline('y' => 0, pixels => [ 1, 2, 0, 3 ], type => 'index'), + 4, "setscanline with list"); + is($im->setscanline('y' => 0, x => 4, pixels => pack("C*", 3, 2, 1, 0, 3), + type => 'index'), + 5, "setscanline with pv"); + is_deeply([ $im->getscanline(type => 'index', 'y' => 0) ], + [ 1, 2, 0, 3, 3, 2, 1, 0, 3, 0 ], + "check values set"); + eval { # should croak on OOR index + $im->setscanline('y' => 1, pixels => [ 255 ], type=>'index'); + }; + ok($@, "croak on setscanline() to invalid index"); + eval { # same again with pv + $im->setscanline('y' => 1, pixels => "\xFF", type => 'index'); + }; + ok($@, "croak on setscanline() with pv to invalid index"); +} + +{ + print "# make_colors => mono\n"; + # test mono make_colors + my $imrgb = Imager->new(xsize => 10, ysize => 10); + $imrgb->setpixel(x => 0, 'y' => 0, color => '#FFF'); + $imrgb->setpixel(x => 1, 'y' => 0, color => '#FF0'); + $imrgb->setpixel(x => 2, 'y' => 0, color => '#000'); + my $mono = $imrgb->to_paletted(make_colors => 'mono', + translate => 'closest'); + is($mono->type, 'paletted', "check we get right image type"); + is($mono->colorcount, 2, "only 2 colors"); + my ($is_mono, $ziw) = $mono->is_bilevel; + ok($is_mono, "check monochrome check true"); + is($ziw, 0, "check ziw false"); + my @colors = $mono->getcolors; + iscolor($colors[0], $black, "check first entry"); + iscolor($colors[1], $white, "check second entry"); + my @pixels = $mono->getscanline(x => 0, 'y' => 0, width => 3, type=>'index'); + is($pixels[0], 1, "check white pixel"); + is($pixels[1], 1, "check yellow pixel"); + is($pixels[2], 0, "check black pixel"); +} + +{ # check for the various mono images we accept + my $mono_8_bw_3 = Imager->new(xsize => 2, ysize => 2, channels => 3, + type => 'paletted'); + ok($mono_8_bw_3->addcolors(colors => [ qw/000000 FFFFFF/ ]), + "mono8bw3 - add colors"); + ok($mono_8_bw_3->is_bilevel, "it's mono"); + is(($mono_8_bw_3->is_bilevel)[1], 0, 'zero not white'); + + my $mono_8_wb_3 = Imager->new(xsize => 2, ysize => 2, channels => 3, + type => 'paletted'); + ok($mono_8_wb_3->addcolors(colors => [ qw/FFFFFF 000000/ ]), + "mono8wb3 - add colors"); + ok($mono_8_wb_3->is_bilevel, "it's mono"); + is(($mono_8_wb_3->is_bilevel)[1], 1, 'zero is white'); + + my $mono_8_bw_1 = Imager->new(xsize => 2, ysize => 2, channels => 1, + type => 'paletted'); + ok($mono_8_bw_1->addcolors(colors => [ qw/000000 FFFFFF/ ]), + "mono8bw - add colors"); + ok($mono_8_bw_1->is_bilevel, "it's mono"); + is(($mono_8_bw_1->is_bilevel)[1], 0, 'zero not white'); + + my $mono_8_wb_1 = Imager->new(xsize => 2, ysize => 2, channels => 1, + type => 'paletted'); + ok($mono_8_wb_1->addcolors(colors => [ qw/FFFFFF 000000/ ]), + "mono8wb - add colors"); + ok($mono_8_wb_1->is_bilevel, "it's mono"); + is(($mono_8_wb_1->is_bilevel)[1], 1, 'zero is white'); +} + +{ # check bounds checking + my $im = Imager->new(xsize => 10, ysize => 10, type=>'paletted'); + ok($im->addcolors(colors => [ $black ]), "add color of pixel bounds check writes"); + + image_bounds_checks($im); +} + +{ # test colors array returns colors + my $data; + my $im = test_image(); + my @colors; + my $imp = $im->to_paletted(colors => \@colors, + make_colors => 'webmap', + translate => 'closest'); + ok($imp, "made paletted"); + is(@colors, 216, "should be 216 colors in the webmap"); + is_color3($colors[0], 0, 0, 0, "first should be 000000"); + is_color3($colors[1], 0, 0, 0x33, "second should be 000033"); + is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366"); +} + +{ # RT 68508 + my $im = Imager->new(xsize => 10, ysize => 10); + $im->box(filled => 1, color => Imager::Color->new(255, 0, 0)); + my $palim = $im->to_paletted(make_colors => "mono", translate => "errdiff"); + ok($palim, "convert to mono with error diffusion"); + my $blank = Imager->new(xsize => 10, ysize => 10); + isnt_image($palim, $blank, "make sure paletted isn't all black"); +} + +{ # check validation of palette entries + my $im = Imager->new(xsize => 10, ysize => 10, type => 'paletted'); + $im->addcolors(colors => [ $black, $red ]); + { + my $no_croak = eval { + $im->setscanline(y => 0, type => 'index', pixels => [ 0, 1 ]); + 1; + }; + ok($no_croak, "valid values don't croak"); + } + { + my $no_croak = eval { + $im->setscanline(y => 0, type => 'index', pixels => pack("C*", 0, 1)); + 1; + }; + ok($no_croak, "valid values don't croak (packed)"); + } + { + my $no_croak = eval { + $im->setscanline(y => 0, type => 'index', pixels => [ 2, 255 ]); + 1; + }; + ok(!$no_croak, "invalid values do croak"); + } + { + my $no_croak = eval { + $im->setscanline(y => 0, type => 'index', pixels => pack("C*", 2, 255)); + 1; + }; + ok(!$no_croak, "invalid values do croak (packed)"); + } +} + +{ + my $im = Imager->new(xsize => 1, ysize => 1); + my $im_bad = Imager->new; + { + my @map = Imager->make_palette({}); + ok(!@map, "make_palette should fail with no images"); + is(Imager->errstr, "make_palette: supply at least one image", + "check error message"); + } + { + my @map = Imager->make_palette({}, $im, $im_bad, $im); + ok(!@map, "make_palette should fail with an empty image"); + is(Imager->errstr, "make_palette: image 2 is empty", + "check error message"); + } + { + my @map = Imager->make_palette({ make_colors => "mono" }, $im); + is(@map, 2, "mono should make 2 color palette") + or skip("unexpected color count", 2); + is_color4($map[0], 0, 0, 0, 255, "check map[0]"); + is_color4($map[1], 255, 255, 255, 255, "check map[1]"); + } + { + my @map = Imager->make_palette({ make_colors => "gray4" }, $im); + is(@map, 4, "gray4 should make 4 color palette") + or skip("unexpected color count", 4); + is_color4($map[0], 0, 0, 0, 255, "check map[0]"); + is_color4($map[1], 85, 85, 85, 255, "check map[1]"); + is_color4($map[2], 170, 170, 170, 255, "check map[2]"); + is_color4($map[3], 255, 255, 255, 255, "check map[3]"); + } + { + my @map = Imager->make_palette({ make_colors => "gray16" }, $im); + is(@map, 16, "gray16 should make 16 color palette") + or skip("unexpected color count", 4); + is_color4($map[0], 0, 0, 0, 255, "check map[0]"); + is_color4($map[1], 17, 17, 17, 255, "check map[1]"); + is_color4($map[2], 34, 34, 34, 255, "check map[2]"); + is_color4($map[15], 255, 255, 255, 255, "check map[15]"); + } + { + my @map = Imager->make_palette({ make_colors => "gray" }, $im); + is(@map, 256, "gray16 should make 256 color palette") + or skip("unexpected color count", 4); + is_color4($map[0], 0, 0, 0, 255, "check map[0]"); + is_color4($map[1], 1, 1, 1, 255, "check map[1]"); + is_color4($map[33], 33, 33, 33, 255, "check map[2]"); + is_color4($map[255], 255, 255, 255, 255, "check map[15]"); + } +} + +my $psamp_outside_error = "Image position outside of image"; +{ # psamp + print "# psamp\n"; + my $imraw = Imager::i_img_pal_new(10, 10, 3, 255); + my @colors = + ( + NC(0, 0, 0), NC(255, 128, 64), NC(64, 128, 192), + NC(64, 0, 192), NC(255, 128, 0), NC(64, 32, 0), + NC(128, 63, 32), NC(255, 128, 32), NC(64, 32, 16), + ); + is(Imager::i_addcolors($imraw, @colors), "0 but true", + "add colors needed for testing"); + { + is(Imager::i_psamp($imraw, 0, 2, undef, [ 255, 128, 64 ]), 3, + "i_psamp def channels, 3 samples"); + is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64, + "check color written"); + Imager::i_img_setmask($imraw, 5); + is(Imager::i_psamp($imraw, 1, 3, undef, [ 64, 128, 192 ]), 3, + "i_psamp def channels, 3 samples, masked"); + is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 192, + "check color written"); + is(Imager::i_psamp($imraw, 1, 7, [ 0, 1, 2 ], [ 64, 128, 192 ]), 3, + "i_psamp channels listed, 3 samples, masked"); + is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 192, + "check color written"); + Imager::i_img_setmask($imraw, ~0); + is(Imager::i_psamp($imraw, 2, 4, [ 0, 1 ], [ 255, 128, 64, 32 ]), 4, + "i_psamp channels [0, 1], 4 samples"); + is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0, + "check first color written"); + is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0, + "check second color written"); + is(Imager::i_psamp($imraw, 0, 5, [ 0, 1, 2 ], [ (128, 63, 32) x 10 ]), 30, + "write a full row"); + is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ], + [ (128, 63, 32) x 10 ], + "check full row"); + is(Imager::i_psamp($imraw, 8, 8, [ 0, 1, 2 ], + [ 255, 128, 32, 64, 32, 16, 32, 16, 8 ]), + 6, "i_psamp channels [0, 1, 2], 9 samples, but room for 6"); + } + { # errors we catch + is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, 3 ], [ 255, 128, 32 ]), + undef, "i_psamp channels [0, 1, 3], 3 samples (invalid channel number)"); + is(_get_error(), "No channel 3 in this image", + "check error message"); + is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, -1 ], [ 255, 128, 32 ]), + undef, "i_psamp channels [0, 1, -1], 3 samples (invalid channel number)"); + is(_get_error(), "No channel -1 in this image", + "check error message"); + is(Imager::i_psamp($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef, + "negative y"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psamp($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef, + "y overflow"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psamp($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef, + "negative x"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psamp($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef, + "x overflow"); + is(_get_error(), $psamp_outside_error, "check message"); + } + ok(Imager::i_img_type($imraw), "still paletted"); + print "# end psamp tests\n"; +} + +{ # psampf + print "# psampf\n"; + my $imraw = Imager::i_img_pal_new(10, 10, 3, 255); + my @colors = + ( + NC(0, 0, 0), NC(255, 128, 64), NC(64, 128, 192), + NC(64, 0, 191), NC(255, 128, 0), NC(64, 32, 0), + NC(128, 64, 32), NC(255, 128, 32), NC(64, 32, 16), + ); + is(Imager::i_addcolors($imraw, @colors), "0 but true", + "add colors needed for testing"); + { + is(Imager::i_psampf($imraw, 0, 2, undef, [ 1, 0.5, 0.25 ]), 3, + "i_psampf def channels, 3 samples"); + is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64, + "check color written"); + Imager::i_img_setmask($imraw, 5); + is(Imager::i_psampf($imraw, 1, 3, undef, [ 0.25, 0.5, 0.75 ]), 3, + "i_psampf def channels, 3 samples, masked"); + is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 191, + "check color written"); + is(Imager::i_psampf($imraw, 1, 7, [ 0, 1, 2 ], [ 0.25, 0.5, 0.75 ]), 3, + "i_psampf channels listed, 3 samples, masked"); + is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 191, + "check color written"); + Imager::i_img_setmask($imraw, ~0); + is(Imager::i_psampf($imraw, 2, 4, [ 0, 1 ], [ 1, 0.5, 0.25, 0.125 ]), 4, + "i_psampf channels [0, 1], 4 samples"); + is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0, + "check first color written"); + is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0, + "check second color written"); + is(Imager::i_psampf($imraw, 0, 5, [ 0, 1, 2 ], [ (0.5, 0.25, 0.125) x 10 ]), 30, + "write a full row"); + is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ], + [ (128, 64, 32) x 10 ], + "check full row"); + is(Imager::i_psampf($imraw, 8, 8, [ 0, 1, 2 ], + [ 1.0, 0.5, 0.125, 0.25, 0.125, 0.0625, 0.125, 0, 1 ]), + 6, "i_psampf channels [0, 1, 2], 9 samples, but room for 6"); + } + { # errors we catch + is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, 3 ], [ 1, 0.5, 0.125 ]), + undef, "i_psampf channels [0, 1, 3], 3 samples (invalid channel number)"); + is(_get_error(), "No channel 3 in this image", + "check error message"); + is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, -1 ], [ 1, 0.5, 0.125 ]), + undef, "i_psampf channels [0, 1, -1], 3 samples (invalid channel number)"); + is(_get_error(), "No channel -1 in this image", + "check error message"); + is(Imager::i_psampf($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef, + "negative y"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psampf($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef, + "y overflow"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psampf($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef, + "negative x"); + is(_get_error(), $psamp_outside_error, "check message"); + is(Imager::i_psampf($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef, + "x overflow"); + is(_get_error(), $psamp_outside_error, "check message"); + } + ok(Imager::i_img_type($imraw), "still paletted"); + print "# end psampf tests\n"; +} + +{ # 75258 - gpixf() broken for paletted images + my $im = Imager->new(xsize => 10, ysize => 10, type => "paletted"); + ok($im, "make a test image"); + my @colors = ( $black, $red, $green, $blue ); + is($im->addcolors(colors => \@colors), "0 but true", + "add some colors"); + $im->setpixel(x => 0, y => 0, color => $red); + $im->setpixel(x => 1, y => 0, color => $green); + $im->setpixel(x => 2, y => 0, color => $blue); + is_fcolor3($im->getpixel(x => 0, y => 0, type => "float"), + 1.0, 0, 0, "get a pixel in float form, make sure it's red"); + is_fcolor3($im->getpixel(x => 1, y => 0, type => "float"), + 0, 1.0, 0, "get a pixel in float form, make sure it's green"); + is_fcolor3($im->getpixel(x => 2, y => 0, type => "float"), + 0, 0, 1.0, "get a pixel in float form, make sure it's blue"); +} + +{ + my $empty = Imager->new; + ok(!$empty->to_paletted, "can't convert an empty image"); + is($empty->errstr, "to_paletted: empty input image", + "check error message"); + + is($empty->addcolors(colors => [ $black ]), -1, + "can't addcolors() to an empty image"); + is($empty->errstr, "addcolors: empty input image", + "check error message"); + + ok(!$empty->setcolors(colors => [ $black ]), + "can't setcolors() to an empty image"); + is($empty->errstr, "setcolors: empty input image", + "check error message"); + + ok(!$empty->getcolors(), + "can't getcolors() from an empty image"); + is($empty->errstr, "getcolors: empty input image", + "check error message"); + + is($empty->colorcount, -1, "can't colorcount() an empty image"); + is($empty->errstr, "colorcount: empty input image", + "check error message"); + + is($empty->maxcolors, -1, "can't maxcolors() an empty image"); + is($empty->errstr, "maxcolors: empty input image", + "check error message"); + + is($empty->findcolor(color => $blue), undef, + "can't findcolor an empty image"); + is($empty->errstr, "findcolor: empty input image", + "check error message"); +} + +Imager->close_log; + +unless ($ENV{IMAGER_KEEP_FILES}) { + unlink "testout/t023palette.log" +} + +sub iscolor { + my ($c1, $c2, $msg) = @_; + + my $builder = Test::Builder->new; + my @c1 = $c1->rgba; + my @c2 = $c2->rgba; + if (!$builder->ok($c1[0] == $c2[0] && $c1[1] == $c2[1] && $c1[2] == $c2[2], + $msg)) { + $builder->diag(<new; + if (!$builder->ok($got eq $expected, $msg)) { + (my $got_dec = $got) =~ s/([^ -~])/sprintf("\\x%02x", ord $1)/ge; + (my $exp_dec = $expected) =~ s/([^ -~])/sprintf("\\x%02x", ord $1)/ge; + $builder->diag(<[0], @errors); +}