]>
Commit | Line | Data |
---|---|---|
61753090 TC |
1 | #!perl -w |
2 | use strict; | |
f5991c03 | 3 | use Imager qw(:all :handy); |
1136f089 | 4 | use Test::More tests => 31; |
62869327 | 5 | use Imager::Test qw(test_colorf_gpix is_fcolor1 is_fcolor3); |
f5991c03 | 6 | |
40e78f96 TC |
7 | -d "testout" or mkdir "testout"; |
8 | ||
61753090 | 9 | Imager::init("log"=>'testout/t67convert.log'); |
f5991c03 TC |
10 | |
11 | my $imbase = Imager::ImgRaw::new(200,300,3); | |
12 | ||
13 | # first a basic test, make sure the basic things happen ok | |
14 | # make a 1 channel image from the above (black) image | |
15 | # but with 1 as the 'extra' value | |
61753090 TC |
16 | SKIP: |
17 | { | |
d5477d3d | 18 | my $im_white = i_convert($imbase, [ [ 0, 0, 0, 1 ] ]); |
61753090 | 19 | skip("convert to white failed", 3) |
d5477d3d | 20 | unless ok($im_white, "convert to white"); |
61753090 | 21 | |
d5477d3d | 22 | my ($w, $h, $ch) = i_img_info($im_white); |
f5991c03 TC |
23 | |
24 | # the output image should now have one channel | |
61753090 | 25 | is($ch, 1, "one channel image now"); |
f5991c03 | 26 | # should have the same width and height |
61753090 TC |
27 | ok($w == 200 && $h == 300, "check converted size is the same"); |
28 | ||
f5991c03 | 29 | # should be a white image now, let's check |
d5477d3d | 30 | my $c = Imager::i_get_pixel($im_white, 20, 20); |
f5991c03 TC |
31 | my @c = $c->rgba; |
32 | print "# @c\n"; | |
61753090 | 33 | is($c[0], 255, "check image is white"); |
f5991c03 TC |
34 | } |
35 | ||
36 | # test the highlevel interface | |
37 | # currently this requires visual inspection of the output files | |
38 | my $im = Imager->new; | |
61753090 TC |
39 | SKIP: |
40 | { | |
41 | skip("could not load scale.ppm", 3) | |
42 | unless $im->read(file=>'testimg/scale.ppm'); | |
43 | my $out = $im->convert(preset=>'gray'); | |
44 | ok($out, "convert preset gray"); | |
45 | ok($out->write(file=>'testout/t67_gray.ppm', type=>'pnm'), | |
46 | "save grey image"); | |
47 | $out = $im->convert(preset=>'blue'); | |
48 | ok($out, "convert preset blue"); | |
faa9b3e7 | 49 | |
61753090 TC |
50 | ok($out->write(file=>'testout/t67_blue.ppm', type=>'pnm'), |
51 | "save blue image"); | |
faa9b3e7 TC |
52 | } |
53 | ||
54 | # test against 16-bit/sample images | |
61753090 | 55 | { |
62869327 TC |
56 | SKIP: |
57 | { | |
58 | my $imbase16 = Imager::i_img_16_new(200, 200, 3); | |
59 | ||
60 | my $im16targ = i_convert($imbase16, [ [ 0, 0, 0, 1 ], | |
61 | [ 0, 0, 0, 0 ], | |
62 | [ 0, 0, 0, 0 ] ]); | |
63 | ok($im16targ, "convert 16/bit sample image") | |
64 | or skip("could not convert 16-bit image", 2); | |
65 | ||
66 | # image should still be 16-bit | |
67 | is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample"); | |
68 | ||
69 | # make sure that it's roughly red | |
70 | test_colorf_gpix($im16targ, 0, 0, NCF(1, 0, 0), 0.001, "image roughly red"); | |
71 | } | |
72 | SKIP: | |
73 | { | |
74 | my $imbase16 = Imager->new(xsize => 10, ysize => 10, bits => 16); | |
75 | ok($imbase16->setpixel | |
76 | (x => 5, y => 2, color => Imager::Color::Float->new(0.1, 0.2, 0.3)), | |
77 | "set a sample pixel"); | |
78 | my $c1 = $imbase16->getpixel(x => 5, y => 2, type => "float"); | |
79 | is_fcolor3($c1, 0.1, 0.2, 0.3, "check it was set") | |
80 | or print "#", join(",", $c1->rgba), "\n"; | |
81 | ||
82 | my $targ16 = $imbase16->convert(matrix => [ [ 0.05, 0.15, 0.01, 0.5 ] ]); | |
83 | ok($targ16, "convert another 16/bit sample image") | |
84 | or skip("could not convert", 3); | |
85 | is($targ16->getchannels, 1, "convert should be 1 channel"); | |
86 | is($targ16->bits, 16, "and 16-bits"); | |
87 | my $c = $targ16->getpixel(x => 5, y => 2, type => "float"); | |
88 | is_fcolor1($c, 0.538, 1/32768, "check grey value"); | |
89 | } | |
faa9b3e7 TC |
90 | } |
91 | ||
92 | # test against palette based images | |
93 | my $impal = Imager::i_img_pal_new(200, 300, 3, 256); | |
94 | my $black = NC(0, 0, 0); | |
61753090 TC |
95 | my $blackindex = Imager::i_addcolors($impal, $black); |
96 | ok($blackindex, "add black to paletted"); | |
faa9b3e7 | 97 | for my $y (0..299) { |
4cda4e76 | 98 | Imager::i_ppal($impal, 0, $y, ($blackindex) x 200); |
faa9b3e7 | 99 | } |
d5477d3d | 100 | |
61753090 TC |
101 | SKIP: |
102 | { | |
d5477d3d TC |
103 | my $impalout = i_convert($impal, [ [ 0, 0, 0, 0 ], |
104 | [ 0, 0, 0, 1 ], | |
105 | [ 0, 0, 0, 0 ] ]); | |
61753090 | 106 | skip("could not convert paletted", 3) |
d5477d3d | 107 | unless ok($impalout, "convert paletted"); |
61753090 TC |
108 | is(Imager::i_img_type($impalout), 1, "image still paletted"); |
109 | is(Imager::i_colorcount($impalout), 1, "still only one colour"); | |
110 | my $c = Imager::i_getcolors($impalout, $blackindex); | |
111 | ok($c, "get color from palette"); | |
faa9b3e7 TC |
112 | my @ch = $c->rgba; |
113 | print "# @ch\n"; | |
61753090 TC |
114 | ok($ch[0] == 0 && $ch[1] == 255 && $ch[2] == 0, |
115 | "colour is as expected"); | |
f5991c03 | 116 | } |
61753090 | 117 | |
34b3f7e6 | 118 | { # http://rt.cpan.org/NoAuth/Bug.html?id=9672 |
62869327 | 119 | # methods that return a new image should warn in void context |
34b3f7e6 TC |
120 | my $warning; |
121 | local $SIG{__WARN__} = | |
122 | sub { | |
123 | $warning = "@_"; | |
124 | my $printed = $warning; | |
125 | $printed =~ s/\n$//; | |
126 | $printed =~ s/\n/\n\#/g; | |
127 | print "# ",$printed, "\n"; | |
128 | }; | |
129 | my $img = Imager->new(xsize=>10, ysize=>10); | |
130 | $img->convert(preset=>"grey"); | |
131 | cmp_ok($warning, '=~', 'void', "correct warning"); | |
132 | cmp_ok($warning, '=~', 't67convert\\.t', "correct file"); | |
133 | } | |
d5477d3d TC |
134 | |
135 | { # http://rt.cpan.org/NoAuth/Bug.html?id=28492 | |
62869327 | 136 | # convert() doesn't preserve image sample size |
d5477d3d TC |
137 | my $im = Imager->new(xsize => 20, ysize => 20, channels => 3, |
138 | bits => 'double'); | |
139 | is($im->bits, 'double', 'check source bits'); | |
140 | my $conv = $im->convert(preset => 'grey'); | |
141 | is($conv->bits, 'double', 'make sure result has extra bits'); | |
142 | } | |
26eb06dd TC |
143 | |
144 | { # http://rt.cpan.org/NoAuth/Bug.html?id=79922 | |
145 | # Segfault in convert with bad params | |
146 | my $im = Imager->new(xsize => 10, ysize => 10); | |
147 | ok(!$im->convert(matrix => [ 10, 10, 10 ]), | |
148 | "this would crash"); | |
149 | is($im->errstr, "convert: invalid matrix: element 0 is not an array ref", | |
150 | "check the error message"); | |
151 | } | |
1136f089 TC |
152 | |
153 | { | |
154 | my $empty = Imager->new; | |
155 | ok(!$empty->convert(preset => "addalpha"), "can't convert an empty image"); | |
156 | is($empty->errstr, "convert: empty input image", "check error message"); | |
157 | } |