-Imager::init(log=>'testout/t67convert.log');
-
+#!perl -w
+use strict;
use Imager qw(:all :handy);
+use Test::More tests => 27;
+use Imager::Test qw(test_colorf_gpix is_fcolor1 is_fcolor3);
-print "1..4\n";
+Imager::init("log"=>'testout/t67convert.log');
my $imbase = Imager::ImgRaw::new(200,300,3);
# first a basic test, make sure the basic things happen ok
# make a 1 channel image from the above (black) image
# but with 1 as the 'extra' value
-my $imnew = Imager::i_img_new();
-unless (i_convert($imnew, $imbase, [ [ 0, 0, 0, 1 ] ])) {
- print "not ok 1 # call failed\n";
- print "ok 2 # skipped\n";
- print "ok 3 # skipped\n";
-}
-else {
- print "ok 1\n";
- my ($w, $h, $ch) = i_img_info($imnew);
+SKIP:
+{
+ my $im_white = i_convert($imbase, [ [ 0, 0, 0, 1 ] ]);
+ skip("convert to white failed", 3)
+ unless ok($im_white, "convert to white");
+
+ my ($w, $h, $ch) = i_img_info($im_white);
# the output image should now have one channel
- if ($ch == 1) {
- print "ok 2\n";
- }
- else {
- print "not ok 2 # $ch channels in output\n";
- }
+ is($ch, 1, "one channel image now");
# should have the same width and height
- if ($w == 200 && $h == 300) {
- print "ok 3\n";
- }
- else {
- print "not ok 3 # output image is the wrong size!\n";
- }
+ ok($w == 200 && $h == 300, "check converted size is the same");
+
# should be a white image now, let's check
- my $c = Imager::i_get_pixel($imnew, 20, 20);
+ my $c = Imager::i_get_pixel($im_white, 20, 20);
my @c = $c->rgba;
print "# @c\n";
- if (($c->rgba())[0] == 255) {
- print "ok 4\n";
- }
- else {
- print "not ok 4 # wrong colour in output image",($c->rgba())[0],"\n";
- }
+ is($c[0], 255, "check image is white");
}
# test the highlevel interface
# currently this requires visual inspection of the output files
my $im = Imager->new;
-if ($im->read(file=>'testimg/scale.ppm')) {
- my $out;
- $out = $im->convert(preset=>'gray')
- or die "Cannot convert to gray:", $im->errstr;
- # FIXME we can't save 1 channel ppm files yet
- $out->write(file=>'testout/t67_gray.ppm', type=>'pnm')
- or print "# Cannot save testout/t67_gray.ppm:", $out->errstr;
- $out = $im->convert(preset=>'blue')
- or die "Cannot convert blue:", $im->errstr;
- # FIXME we can't save 1 channel ppm files yet
- $out->write(file=>'testout/t67_blue.ppm', type=>'pnm')
- or print "# Cannot save testout/t67_blue.ppm:", $out->errstr;
+SKIP:
+{
+ skip("could not load scale.ppm", 3)
+ unless $im->read(file=>'testimg/scale.ppm');
+ my $out = $im->convert(preset=>'gray');
+ ok($out, "convert preset gray");
+ ok($out->write(file=>'testout/t67_gray.ppm', type=>'pnm'),
+ "save grey image");
+ $out = $im->convert(preset=>'blue');
+ ok($out, "convert preset blue");
+
+ ok($out->write(file=>'testout/t67_blue.ppm', type=>'pnm'),
+ "save blue image");
}
-else {
- die "could not load testout/scale.ppm\n";
+
+# test against 16-bit/sample images
+{
+ SKIP:
+ {
+ my $imbase16 = Imager::i_img_16_new(200, 200, 3);
+
+ my $im16targ = i_convert($imbase16, [ [ 0, 0, 0, 1 ],
+ [ 0, 0, 0, 0 ],
+ [ 0, 0, 0, 0 ] ]);
+ ok($im16targ, "convert 16/bit sample image")
+ or skip("could not convert 16-bit image", 2);
+
+ # image should still be 16-bit
+ is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample");
+
+ # make sure that it's roughly red
+ test_colorf_gpix($im16targ, 0, 0, NCF(1, 0, 0), 0.001, "image roughly red");
+ }
+ SKIP:
+ {
+ my $imbase16 = Imager->new(xsize => 10, ysize => 10, bits => 16);
+ ok($imbase16->setpixel
+ (x => 5, y => 2, color => Imager::Color::Float->new(0.1, 0.2, 0.3)),
+ "set a sample pixel");
+ my $c1 = $imbase16->getpixel(x => 5, y => 2, type => "float");
+ is_fcolor3($c1, 0.1, 0.2, 0.3, "check it was set")
+ or print "#", join(",", $c1->rgba), "\n";
+
+ my $targ16 = $imbase16->convert(matrix => [ [ 0.05, 0.15, 0.01, 0.5 ] ]);
+ ok($targ16, "convert another 16/bit sample image")
+ or skip("could not convert", 3);
+ is($targ16->getchannels, 1, "convert should be 1 channel");
+ is($targ16->bits, 16, "and 16-bits");
+ my $c = $targ16->getpixel(x => 5, y => 2, type => "float");
+ is_fcolor1($c, 0.538, 1/32768, "check grey value");
+ }
+}
+
+# test against palette based images
+my $impal = Imager::i_img_pal_new(200, 300, 3, 256);
+my $black = NC(0, 0, 0);
+my $blackindex = Imager::i_addcolors($impal, $black);
+ok($blackindex, "add black to paletted");
+for my $y (0..299) {
+ Imager::i_ppal($impal, 0, $y, ($blackindex) x 200);
+}
+
+SKIP:
+{
+ my $impalout = i_convert($impal, [ [ 0, 0, 0, 0 ],
+ [ 0, 0, 0, 1 ],
+ [ 0, 0, 0, 0 ] ]);
+ skip("could not convert paletted", 3)
+ unless ok($impalout, "convert paletted");
+ is(Imager::i_img_type($impalout), 1, "image still paletted");
+ is(Imager::i_colorcount($impalout), 1, "still only one colour");
+ my $c = Imager::i_getcolors($impalout, $blackindex);
+ ok($c, "get color from palette");
+ my @ch = $c->rgba;
+ print "# @ch\n";
+ ok($ch[0] == 0 && $ch[1] == 255 && $ch[2] == 0,
+ "colour is as expected");
+}
+
+{ # http://rt.cpan.org/NoAuth/Bug.html?id=9672
+ # methods that return a new image should warn in void context
+ my $warning;
+ local $SIG{__WARN__} =
+ sub {
+ $warning = "@_";
+ my $printed = $warning;
+ $printed =~ s/\n$//;
+ $printed =~ s/\n/\n\#/g;
+ print "# ",$printed, "\n";
+ };
+ my $img = Imager->new(xsize=>10, ysize=>10);
+ $img->convert(preset=>"grey");
+ cmp_ok($warning, '=~', 'void', "correct warning");
+ cmp_ok($warning, '=~', 't67convert\\.t', "correct file");
+}
+
+{ # http://rt.cpan.org/NoAuth/Bug.html?id=28492
+ # convert() doesn't preserve image sample size
+ my $im = Imager->new(xsize => 20, ysize => 20, channels => 3,
+ bits => 'double');
+ is($im->bits, 'double', 'check source bits');
+ my $conv = $im->convert(preset => 'grey');
+ is($conv->bits, 'double', 'make sure result has extra bits');
}
projects / imager.git / blobdiff