Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 256 lines (222 sloc) 9.815 kb
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
1 #!perl -w
2 use strict;
95c08d7 - images with an translucent alpha channel were not scaled correctly
Tony Cook authored
3 use Test::More tests => 232;
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
4
01edbe4 convert to Test::More
Tony Cook authored
5 BEGIN { use_ok(Imager=>':all') }
95c08d7 - images with an translucent alpha channel were not scaled correctly
Tony Cook authored
6 use Imager::Test qw(is_image is_color4 is_image_similar);
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
7
40e78f9 @tonycoz RT#65088 make sure each test script that needs testout/ creates it
authored
8 -d "testout" or mkdir "testout";
9
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
10 Imager::init('log'=>'testout/t40scale.log');
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
11 my $img=Imager->new();
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
12
01edbe4 convert to Test::More
Tony Cook authored
13 ok($img->open(file=>'testimg/scale.ppm',type=>'pnm'),
14 "load test image") or print "# ",$img->errstr,"\n";
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
15
01edbe4 convert to Test::More
Tony Cook authored
16 my $scaleimg=$img->scale(scalefactor=>0.25)
17 or print "# ",$img->errstr,"\n";
18 ok($scaleimg, "scale it (good mode)");
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
19
01edbe4 convert to Test::More
Tony Cook authored
20 ok($scaleimg->write(file=>'testout/t40scale1.ppm',type=>'pnm'),
21 "save scaled image") or print "# ",$img->errstr,"\n";
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
22
01edbe4 convert to Test::More
Tony Cook authored
23 $scaleimg=$img->scale(scalefactor=>0.25,qtype=>'preview');
24 ok($scaleimg, "scale it (preview)") or print "# ",$img->errstr,"\n";
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
25
01edbe4 convert to Test::More
Tony Cook authored
26 ok($scaleimg->write(file=>'testout/t40scale2.ppm',type=>'pnm'),
27 "write preview scaled image") or print "# ",$img->errstr,"\n";
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
28
658f724 Merged in the scale branch:
Tony Cook authored
29 $scaleimg = $img->scale(scalefactor => 0.25, qtype => 'mixing');
30 ok($scaleimg, "scale it (mixing)") or print "# ", $img->errstr, "\n";
31 ok($scaleimg->write(file=>'testout/t40scale3.ppm', type=>'pnm'),
32 "write mixing scaled image") or print "# ", $img->errstr, "\n";
33
a10945a convert scale.c to scale.im so we have 8 bit/sample and double/sample
Tony Cook authored
34 { # double image scaling with mixing, since it has code to handle it
35 my $dimg = Imager->new(xsize => $img->getwidth, ysize => $img->getheight,
36 channels => $img->getchannels,
37 bits => 'double');
38 ok($dimg, "create double/sample image");
39 $dimg->paste(src => $img);
40 $scaleimg = $dimg->scale(scalefactor => 0.25, qtype => 'mixing');
41 ok($scaleimg, "scale it (mixing, double)");
42 ok($scaleimg->write(file => 'testout/t40mixdbl.ppm', type => 'pnm'),
43 "write double/mixing scaled image");
44 is($scaleimg->bits, 'double', "got the right image type as output");
45
46 # hscale only, mixing
47 $scaleimg = $dimg->scale(xscalefactor => 0.33, yscalefactor => 1.0,
48 qtype => 'mixing');
49 ok($scaleimg, "scale it (hscale, mixing, double)");
50 is($scaleimg->getheight, $dimg->getheight, "same height");
51 ok($scaleimg->write(file => 'testout/t40hscdmix.ppm', type => 'pnm'),
52 "save it");
53
54 # vscale only, mixing
55 $scaleimg = $dimg->scale(xscalefactor => 1.0, yscalefactor => 0.33,
56 qtype => 'mixing');
57 ok($scaleimg, "scale it (vscale, mixing, double)");
58 is($scaleimg->getwidth, $dimg->getwidth, "same width");
59 ok($scaleimg->write(file => 'testout/t40vscdmix.ppm', type => 'pnm'),
60 "save it");
61 }
62
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
63 {
64 # check for a warning when scale() is called in void context
65 my $warning;
66 local $SIG{__WARN__} =
67 sub {
68 $warning = "@_";
69 my $printed = $warning;
70 $printed =~ s/\n$//;
71 $printed =~ s/\n/\n\#/g;
72 print "# ",$printed, "\n";
73 };
74 $img->scale(scalefactor=>0.25);
01edbe4 convert to Test::More
Tony Cook authored
75 cmp_ok($warning, '=~', qr/void/, "check warning");
76 cmp_ok($warning, '=~', qr/t40scale\.t/, "check filename");
34b3f7e - the convert, crop, rotate, copy, matrix_transform, to_paletted, to_rgb...
Tony Cook authored
77 $warning = '';
78 $img->scaleX(scalefactor=>0.25);
79 cmp_ok($warning, '=~', qr/void/, "check warning");
80 cmp_ok($warning, '=~', qr/t40scale\.t/, "check filename");
81 $warning = '';
82 $img->scaleY(scalefactor=>0.25);
83 cmp_ok($warning, '=~', qr/void/, "check warning");
84 cmp_ok($warning, '=~', qr/t40scale\.t/, "check filename");
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
85 }
86 { # https://rt.cpan.org/Ticket/Display.html?id=7467
87 # segfault in Imager 0.43
88 # make sure scale() doesn't let us make an image zero pixels high or wide
89 # it does this by making the given axis as least 1 pixel high
90 my $out = $img->scale(scalefactor=>0.00001);
01edbe4 convert to Test::More
Tony Cook authored
91 is($out->getwidth, 1, "min scale width");
92 is($out->getheight, 1, "min scale height");
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
93
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
94 $out = $img->scale(scalefactor=>0.00001, qtype => 'preview');
01edbe4 convert to Test::More
Tony Cook authored
95 is($out->getwidth, 1, "min scale width (preview)");
96 is($out->getheight, 1, "min scale height (preview)");
658f724 Merged in the scale branch:
Tony Cook authored
97
98 $out = $img->scale(scalefactor=>0.00001, qtype => 'mixing');
99 is($out->getwidth, 1, "min scale width (mixing)");
100 is($out->getheight, 1, "min scale height (mixing)");
1501d9b - previously, if you supplied to_paletted and empty color map
Tony Cook authored
101 }
5168ca3 - make scale() fail if an invalid type is supplied (previously
Tony Cook authored
102
103 { # error handling - NULL image
104 my $im = Imager->new;
105 ok(!$im->scale(scalefactor => 0.5), "try to scale empty image");
106 is($im->errstr, "empty input image", "check error message");
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
107
108 # scaleX/scaleY
109 ok(!$im->scaleX(scalefactor => 0.5), "try to scaleX empty image");
110 is($im->errstr, "empty input image", "check error message");
111 ok(!$im->scaleY(scalefactor => 0.5), "try to scaleY empty image");
112 is($im->errstr, "empty input image", "check error message");
5168ca3 - make scale() fail if an invalid type is supplied (previously
Tony Cook authored
113 }
114
115 { # invalid qtype value
116 my $im = Imager->new(xsize => 100, ysize => 100);
117 ok(!$im->scale(scalefactor => 0.5, qtype=>'unknown'), "unknown qtype");
118 is($im->errstr, "invalid value for qtype parameter", "check error message");
119
120 # invalid type value
121 ok(!$im->scale(xpixels => 10, ypixels=>50, type=>"unknown"), "unknown type");
122 is($im->errstr, "invalid value for type parameter", "check error message");
123 }
124
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
125 SKIP:
126 { # Image::Math::Constrain support
127 eval "require Image::Math::Constrain;";
4f57931 - sick of $opts{scalefactor} in scale(), give it a scalar to call it's
Tony Cook authored
128 $@ and skip "optional module Image::Math::Constrain not installed", 3;
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
129 my $constrain = Image::Math::Constrain->new(20, 100);
130 my $im = Imager->new(xsize => 160, ysize => 96);
131 my $result = $im->scale(constrain => $constrain);
132 ok($result, "successful scale with Image::Math::Constrain");
133 is($result->getwidth, 20, "check result width");
134 is($result->getheight, 12, "check result height");
135 }
136
137 { # scale size checks
138 my $im = Imager->new(xsize => 160, ysize => 96); # some random size
139
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
140 scale_test($im, 'scale', 80, 48, "48 x 48 def type",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
141 xpixels => 48, ypixels => 48);
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
142 scale_test($im, 'scale', 80, 48, "48 x 48 max type",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
143 xpixels => 48, ypixels => 48, type => 'max');
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
144 scale_test($im, 'scale', 80, 48, "80 x 80 min type",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
145 xpixels => 80, ypixels => 80, type => 'min');
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
146 scale_test($im, 'scale', 80, 48, "no scale parameters (default to 0.5 scalefactor)");
147 scale_test($im, 'scale', 120, 72, "0.75 scalefactor",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
148 scalefactor => 0.75);
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
149 scale_test($im, 'scale', 80, 48, "80 width",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
150 xpixels => 80);
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
151 scale_test($im, 'scale', 120, 72, "72 height",
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
152 ypixels => 72);
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
153
658f724 Merged in the scale branch:
Tony Cook authored
154 # new scaling parameters in 0.54
155 scale_test($im, 'scale', 80, 48, "xscale 0.5",
156 xscalefactor => 0.5);
157 scale_test($im, 'scale', 80, 48, "yscale 0.5",
158 yscalefactor => 0.5);
159 scale_test($im, 'scale', 40, 48, "xscale 0.25 yscale 0.5",
160 xscalefactor => 0.25, yscalefactor => 0.5);
161 scale_test($im, 'scale', 160, 48, "xscale 1.0 yscale 0.5",
162 xscalefactor => 1.0, yscalefactor => 0.5);
163 scale_test($im, 'scale', 160, 48, "xpixels 160 ypixels 48 type nonprop",
164 xpixels => 160, ypixels => 48, type => 'nonprop');
165 scale_test($im, 'scale', 160, 96, "xpixels 160 ypixels 96",
166 xpixels => 160, ypixels => 96);
167 scale_test($im, 'scale', 80, 96, "xpixels 80 ypixels 96 type nonprop",
168 xpixels => 80, ypixels => 96, type => 'nonprop');
169
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
170 # scaleX
171 scale_test($im, 'scaleX', 80, 96, "defaults");
172 scale_test($im, 'scaleX', 40, 96, "0.25 scalefactor",
173 scalefactor => 0.25);
174 scale_test($im, 'scaleX', 120, 96, "pixels 120",
175 pixels => 120);
176
177 # scaleY
178 scale_test($im, 'scaleY', 160, 48, "defaults");
179 scale_test($im, 'scaleY', 160, 192, "2.0 scalefactor",
180 scalefactor => 2.0);
181 scale_test($im, 'scaleY', 160, 144, "pixels 144",
182 pixels => 144);
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
183 }
184
95c08d7 - images with an translucent alpha channel were not scaled correctly
Tony Cook authored
185 { # check proper alpha handling for mixing
874c55d alpha channel fixes for mixing scaling
Tony Cook authored
186 my $im = Imager->new(xsize => 40, ysize => 40, channels => 4);
187 $im->box(filled => 1, color => 'C0C0C0');
188 my $rot = $im->rotate(degrees => -4)
189 or die;
190 $rot = $rot->to_rgb16;
191 my $sc = $rot->scale(qtype => 'mixing', xpixels => 40);
192 my $out = Imager->new(xsize => $sc->getwidth, ysize => $sc->getheight);
193 $out->box(filled => 1, color => 'C0C0C0');
194 my $cmp = $out->copy;
195 $out->rubthrough(src => $sc);
95c08d7 - images with an translucent alpha channel were not scaled correctly
Tony Cook authored
196 is_image($out, $cmp, "check we get the right image after scaling (mixing)");
197
198 # we now set alpha=0 pixels to zero on scaling
199 is_color4($sc->getpixel('x' => 39, 'y' => 39), 0, 0, 0, 0,
200 "check we set alpha=0 pixels to zero on scaling");
201 }
202
203 { # check proper alpha handling for default scaling
204 my $im = Imager->new(xsize => 40, ysize => 40, channels => 4);
205 $im->box(filled => 1, color => 'C0C0C0');
206 my $rot = $im->rotate(degrees => -4)
207 or die;
208 my $sc = $rot->scale(qtype => "normal", xpixels => 40);
209 my $out = Imager->new(xsize => $sc->getwidth, ysize => $sc->getheight);
210 $out->box(filled => 1, color => 'C0C0C0');
211 my $cmp = $out->copy;
212 $out->rubthrough(src => $sc);
213 is_image_similar($out, $cmp, 100, "check we get the right image after scaling (normal)");
2757bad - mixing qtype scaling now sets all channels of a pixel to zero if
Tony Cook authored
214
215 # we now set alpha=0 pixels to zero on scaling
216 is_color4($sc->getpixel('x' => 39, 'y' => 39), 0, 0, 0, 0,
217 "check we set alpha=0 pixels to zero on scaling");
874c55d alpha channel fixes for mixing scaling
Tony Cook authored
218 }
219
2a836a0 add some tests for scale_calculate()
Tony Cook authored
220 { # scale_calculate
221 my $im = Imager->new(xsize => 100, ysize => 120);
222 is_deeply([ $im->scale_calculate(scalefactor => 0.5) ],
223 [ 0.5, 0.5, 50, 60 ],
224 "simple scale_calculate");
225 is_deeply([ Imager->scale_calculate(scalefactor => 0.5) ],
226 [], "failed scale_calculate");
227 is_deeply([ Imager->scale_calculate(width => 120, height => 150,
228 xpixels => 240) ],
229 [ 2.0, 2.0, 240, 300 ],
230 "class method scale_factor");
231 }
232
de47089 - check that the result of fileno($fh) is defined rather than simply
Tony Cook authored
233 { # passing a reference for scaling parameters should fail
234 # RT #35172
235 my $im = Imager->new(xsize => 100, ysize => 100);
236 ok(!$im->scale(xpixels => {}), "can't use a reference as a size");
237 cmp_ok($im->errstr, '=~', "xpixels parameter cannot be a reference",
238 "check error message");
239 }
240
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
241 sub scale_test {
15327bf - add tests for scaleX()/scaleY()
Tony Cook authored
242 my ($in, $method, $exp_width, $exp_height, $note, @parms) = @_;
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
243
244 print "# $note: @parms\n";
658f724 Merged in the scale branch:
Tony Cook authored
245 for my $qtype (qw(normal preview mixing)) {
246 SKIP:
247 {
248 my $scaled = $in->$method(@parms, qtype => $qtype);
249 ok($scaled, "$method $note qtype $qtype")
250 or skip("failed to scale", 2);
251 is($scaled->getwidth, $exp_width, "check width");
252 is($scaled->getheight, $exp_height, "check height");
253 }
41c7d05 - scale() can now expect an Image::Math::Constrain object as a scaling
Tony Cook authored
254 }
255 }
Something went wrong with that request. Please try again.