]>
Commit | Line | Data |
---|---|---|
f1ac5027 TC |
1 | #!perl -w |
2 | use strict; | |
7a98c442 | 3 | use Test::More tests => 157; |
efdc2568 | 4 | |
f1ac5027 TC |
5 | use Imager ':handy'; |
6 | use Imager::Fill; | |
7 | use Imager::Color::Float; | |
e958b64e | 8 | use Imager::Test qw(is_image is_color4 is_fcolor4 is_color3); |
f3b59de8 | 9 | use Config; |
f1ac5027 | 10 | |
40e78f96 TC |
11 | -d "testout" or mkdir "testout"; |
12 | ||
efdc2568 | 13 | Imager::init_log("testout/t20fill.log", 1); |
f1ac5027 TC |
14 | |
15 | my $blue = NC(0,0,255); | |
16 | my $red = NC(255, 0, 0); | |
17 | my $redf = Imager::Color::Float->new(1, 0, 0); | |
e2d5ca90 | 18 | my $bluef = Imager::Color::Float->new(0, 0, 1); |
f1ac5027 | 19 | my $rsolid = Imager::i_new_fill_solid($blue, 0); |
109bec2d | 20 | ok($rsolid, "building solid fill"); |
f1ac5027 TC |
21 | my $raw1 = Imager::ImgRaw::new(100, 100, 3); |
22 | # use the normal filled box | |
23 | Imager::i_box_filled($raw1, 0, 0, 99, 99, $blue); | |
24 | my $raw2 = Imager::ImgRaw::new(100, 100, 3); | |
25 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rsolid); | |
109bec2d | 26 | ok(1, "drawing with solid fill"); |
f1ac5027 | 27 | my $diff = Imager::i_img_diff($raw1, $raw2); |
109bec2d | 28 | ok($diff == 0, "solid fill doesn't match"); |
f1ac5027 TC |
29 | Imager::i_box_filled($raw1, 0, 0, 99, 99, $red); |
30 | my $rsolid2 = Imager::i_new_fill_solidf($redf, 0); | |
109bec2d | 31 | ok($rsolid2, "creating float solid fill"); |
f1ac5027 TC |
32 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rsolid2); |
33 | $diff = Imager::i_img_diff($raw1, $raw2); | |
109bec2d | 34 | ok($diff == 0, "float solid fill doesn't match"); |
f1ac5027 TC |
35 | |
36 | # ok solid still works, let's try a hatch | |
37 | # hash1 is a 2x2 checkerboard | |
38 | my $rhatcha = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 0, 0); | |
39 | my $rhatchb = Imager::i_new_fill_hatch($blue, $red, 0, 1, undef, 2, 0); | |
109bec2d | 40 | ok($rhatcha && $rhatchb, "can't build hatched fill"); |
f1ac5027 TC |
41 | |
42 | # the offset should make these match | |
43 | Imager::i_box_cfill($raw1, 0, 0, 99, 99, $rhatcha); | |
44 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb); | |
109bec2d | 45 | ok(1, "filling with hatch"); |
f1ac5027 | 46 | $diff = Imager::i_img_diff($raw1, $raw2); |
109bec2d | 47 | ok($diff == 0, "hatch images different"); |
f1ac5027 TC |
48 | $rhatchb = Imager::i_new_fill_hatch($blue, $red, 0, 1, undef, 4, 6); |
49 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb); | |
50 | $diff = Imager::i_img_diff($raw1, $raw2); | |
109bec2d | 51 | ok($diff == 0, "hatch images different"); |
f1ac5027 TC |
52 | |
53 | # I guess I was tired when I originally did this - make sure it keeps | |
54 | # acting the way it's meant to | |
55 | # I had originally expected these to match with the red and blue swapped | |
56 | $rhatchb = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 2, 2); | |
57 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb); | |
58 | $diff = Imager::i_img_diff($raw1, $raw2); | |
109bec2d | 59 | ok($diff == 0, "hatch images different"); |
f1ac5027 TC |
60 | |
61 | # this shouldn't match | |
62 | $rhatchb = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 1, 1); | |
63 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb); | |
64 | $diff = Imager::i_img_diff($raw1, $raw2); | |
109bec2d | 65 | ok($diff, "hatch images the same!"); |
f1ac5027 TC |
66 | |
67 | # custom hatch | |
68 | # the inverse of the 2x2 checkerboard | |
69 | my $hatch = pack("C8", 0x33, 0x33, 0xCC, 0xCC, 0x33, 0x33, 0xCC, 0xCC); | |
70 | my $rcustom = Imager::i_new_fill_hatch($blue, $red, 0, 0, $hatch, 0, 0); | |
71 | Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rcustom); | |
72 | $diff = Imager::i_img_diff($raw1, $raw2); | |
109bec2d | 73 | ok(!$diff, "custom hatch mismatch"); |
f1ac5027 | 74 | |
e2d5ca90 TC |
75 | { |
76 | # basic test of floating color hatch fills | |
77 | # this will exercise the code that the gcc shipped with OS X 10.4 | |
78 | # forgets to generate | |
79 | # the float version is called iff we're working with a non-8-bit image | |
80 | # i_new_fill_hatchf() makes the same object as i_new_fill_hatch() but | |
81 | # we test the other construction code path here | |
82 | my $fraw1 = Imager::i_img_double_new(100, 100, 3); | |
83 | my $fhatch1 = Imager::i_new_fill_hatchf($redf, $bluef, 0, 1, undef, 0, 0); | |
84 | ok($fraw1, "making double image 1"); | |
85 | ok($fhatch1, "making float hatch 1"); | |
86 | Imager::i_box_cfill($fraw1, 0, 0, 99, 99, $fhatch1); | |
87 | my $fraw2 = Imager::i_img_double_new(100, 100, 3); | |
88 | my $fhatch2 = Imager::i_new_fill_hatchf($bluef, $redf, 0, 1, undef, 0, 2); | |
89 | ok($fraw2, "making double image 2"); | |
90 | ok($fhatch2, "making float hatch 2"); | |
91 | Imager::i_box_cfill($fraw2, 0, 0, 99, 99, $fhatch2); | |
92 | ||
93 | $diff = Imager::i_img_diff($fraw1, $fraw2); | |
94 | ok(!$diff, "float custom hatch mismatch"); | |
95 | save($fraw1, "testout/t20hatchf1.ppm"); | |
96 | save($fraw2, "testout/t20hatchf2.ppm"); | |
97 | } | |
98 | ||
f1ac5027 TC |
99 | # test the oo interface |
100 | my $im1 = Imager->new(xsize=>100, ysize=>100); | |
101 | my $im2 = Imager->new(xsize=>100, ysize=>100); | |
102 | ||
efdc2568 | 103 | my $solid = Imager::Fill->new(solid=>'#FF0000'); |
109bec2d TC |
104 | ok($solid, "creating oo solid fill"); |
105 | ok($solid->{fill}, "bad oo solid fill"); | |
f1ac5027 TC |
106 | $im1->box(fill=>$solid); |
107 | $im2->box(filled=>1, color=>$red); | |
108 | $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG}); | |
109bec2d | 109 | ok(!$diff, "oo solid fill"); |
f1ac5027 TC |
110 | |
111 | my $hatcha = Imager::Fill->new(hatch=>'check2x2'); | |
112 | my $hatchb = Imager::Fill->new(hatch=>'check2x2', dx=>2); | |
113 | $im1->box(fill=>$hatcha); | |
114 | $im2->box(fill=>$hatchb); | |
115 | # should be different | |
116 | $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG}); | |
109bec2d | 117 | ok($diff, "offset checks the same!"); |
f1ac5027 TC |
118 | $hatchb = Imager::Fill->new(hatch=>'check2x2', dx=>2, dy=>2); |
119 | $im2->box(fill=>$hatchb); | |
120 | $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG}); | |
109bec2d | 121 | ok(!$diff, "offset into similar check should be the same"); |
f1ac5027 TC |
122 | |
123 | # test dymanic build of fill | |
124 | $im2->box(fill=>{hatch=>'check2x2', dx=>2, fg=>NC(255,255,255), | |
125 | bg=>NC(0,0,0)}); | |
126 | $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG}); | |
109bec2d | 127 | ok(!$diff, "offset and flipped should be the same"); |
f1ac5027 TC |
128 | |
129 | # a simple demo | |
130 | my $im = Imager->new(xsize=>200, ysize=>200); | |
131 | ||
132 | $im->box(xmin=>10, ymin=>10, xmax=>190, ymax=>190, | |
133 | fill=>{ hatch=>'check4x4', | |
134 | fg=>NC(128, 0, 0), | |
569795e8 TC |
135 | bg=>NC(128, 64, 0) }) |
136 | or print "# ",$im->errstr,"\n"; | |
f1ac5027 TC |
137 | $im->arc(r=>80, d1=>45, d2=>75, |
138 | fill=>{ hatch=>'stipple2', | |
139 | combine=>1, | |
efdc2568 | 140 | fg=>[ 0, 0, 0, 255 ], |
569795e8 TC |
141 | bg=>{ rgba=>[255,255,255,160] } }) |
142 | or print "# ",$im->errstr,"\n"; | |
f1ac5027 | 143 | $im->arc(r=>80, d1=>75, d2=>135, |
569795e8 TC |
144 | fill=>{ fountain=>'radial', xa=>100, ya=>100, xb=>20, yb=>100 }) |
145 | or print "# ",$im->errstr,"\n"; | |
f1ac5027 TC |
146 | $im->write(file=>'testout/t20_sample.ppm'); |
147 | ||
cc6483e0 TC |
148 | # flood fill tests |
149 | my $rffimg = Imager::ImgRaw::new(100, 100, 3); | |
150 | # build a H | |
151 | Imager::i_box_filled($rffimg, 10, 10, 20, 90, $blue); | |
152 | Imager::i_box_filled($rffimg, 80, 10, 90, 90, $blue); | |
153 | Imager::i_box_filled($rffimg, 20, 45, 80, 55, $blue); | |
154 | my $black = Imager::Color->new(0, 0, 0); | |
155 | Imager::i_flood_fill($rffimg, 15, 15, $red); | |
156 | my $rffcmp = Imager::ImgRaw::new(100, 100, 3); | |
157 | # build a H | |
158 | Imager::i_box_filled($rffcmp, 10, 10, 20, 90, $red); | |
159 | Imager::i_box_filled($rffcmp, 80, 10, 90, 90, $red); | |
160 | Imager::i_box_filled($rffcmp, 20, 45, 80, 55, $red); | |
161 | $diff = Imager::i_img_diff($rffimg, $rffcmp); | |
109bec2d | 162 | ok(!$diff, "flood fill difference"); |
cc6483e0 TC |
163 | |
164 | my $ffim = Imager->new(xsize=>100, ysize=>100); | |
165 | my $yellow = Imager::Color->new(255, 255, 0); | |
166 | $ffim->box(xmin=>10, ymin=>10, xmax=>20, ymax=>90, color=>$blue, filled=>1); | |
167 | $ffim->box(xmin=>20, ymin=>45, xmax=>80, ymax=>55, color=>$blue, filled=>1); | |
168 | $ffim->box(xmin=>80, ymin=>10, xmax=>90, ymax=>90, color=>$blue, filled=>1); | |
109bec2d | 169 | ok($ffim->flood_fill('x'=>50, 'y'=>50, color=>$red), "flood fill"); |
cc6483e0 | 170 | $diff = Imager::i_img_diff($rffcmp, $ffim->{IMG}); |
109bec2d | 171 | ok(!$diff, "oo flood fill difference"); |
9d540150 | 172 | $ffim->flood_fill('x'=>50, 'y'=>50, |
cc6483e0 | 173 | fill=> { |
3efb0915 TC |
174 | hatch => 'check2x2', |
175 | fg => '0000FF', | |
cc6483e0 TC |
176 | }); |
177 | # fill=>{ | |
178 | # fountain=>'radial', | |
179 | # xa=>50, ya=>50, | |
180 | # xb=>10, yb=>10, | |
181 | # }); | |
182 | $ffim->write(file=>'testout/t20_ooflood.ppm'); | |
183 | ||
3efb0915 TC |
184 | my $copy = $ffim->copy; |
185 | ok($ffim->flood_fill('x' => 50, 'y' => 50, | |
186 | color => $red, border => '000000'), | |
187 | "border solid flood fill"); | |
188 | is(Imager::i_img_diff($ffim->{IMG}, $rffcmp), 0, "compare"); | |
189 | ok($ffim->flood_fill('x' => 50, 'y' => 50, | |
190 | fill => { hatch => 'check2x2', fg => '0000FF', }, | |
191 | border => '000000'), | |
192 | "border cfill fill"); | |
193 | is(Imager::i_img_diff($ffim->{IMG}, $copy->{IMG}), 0, | |
194 | "compare"); | |
195 | ||
efdc2568 TC |
196 | # test combining modes |
197 | my $fill = NC(192, 128, 128, 128); | |
198 | my $target = NC(64, 32, 64); | |
9b1ec2b8 | 199 | my $trans_target = NC(64, 32, 64, 128); |
efdc2568 TC |
200 | my %comb_tests = |
201 | ( | |
9b1ec2b8 TC |
202 | none=> |
203 | { | |
204 | opaque => $fill, | |
205 | trans => $fill, | |
206 | }, | |
207 | normal=> | |
208 | { | |
209 | opaque => NC(128, 80, 96), | |
210 | trans => NC(150, 96, 107, 191), | |
211 | }, | |
212 | multiply => | |
213 | { | |
214 | opaque => NC(56, 24, 48), | |
215 | trans => NC(101, 58, 74, 192), | |
216 | }, | |
217 | dissolve => | |
218 | { | |
219 | opaque => [ $target, NC(192, 128, 128, 255) ], | |
220 | trans => [ $trans_target, NC(192, 128, 128, 255) ], | |
221 | }, | |
222 | add => | |
223 | { | |
224 | opaque => NC(159, 96, 128), | |
225 | trans => NC(128, 80, 96, 255), | |
226 | }, | |
227 | subtract => | |
228 | { | |
229 | opaque => NC(0, 0, 0), | |
230 | trans => NC(0, 0, 0, 255), | |
231 | }, | |
232 | diff => | |
233 | { | |
234 | opaque => NC(96, 64, 64), | |
235 | trans => NC(127, 85, 85, 192), | |
236 | }, | |
237 | lighten => | |
238 | { | |
239 | opaque => NC(128, 80, 96), | |
240 | trans => NC(149, 95, 106, 192), | |
241 | }, | |
242 | darken => | |
243 | { | |
244 | opaque => $target, | |
245 | trans => NC(106, 63, 85, 192), | |
246 | }, | |
efdc2568 TC |
247 | # the following results are based on the results of the tests and |
248 | # are suspect for that reason (and were broken at one point <sigh>) | |
249 | # but trying to work them out manually just makes my head hurt - TC | |
9b1ec2b8 TC |
250 | hue => |
251 | { | |
252 | opaque => NC(64, 32, 47), | |
253 | trans => NC(64, 32, 42, 128), | |
254 | }, | |
255 | saturation => | |
256 | { | |
257 | opaque => NC(63, 37, 64), | |
258 | trans => NC(64, 39, 64, 128), | |
259 | }, | |
260 | value => | |
261 | { | |
262 | opaque => NC(127, 64, 128), | |
263 | trans => NC(149, 75, 150, 128), | |
264 | }, | |
265 | color => | |
266 | { | |
267 | opaque => NC(64, 37, 52), | |
268 | trans => NC(64, 39, 50, 128), | |
269 | }, | |
efdc2568 TC |
270 | ); |
271 | ||
efdc2568 TC |
272 | for my $comb (Imager::Fill->combines) { |
273 | my $test = $comb_tests{$comb}; | |
efdc2568 | 274 | my $fillobj = Imager::Fill->new(solid=>$fill, combine=>$comb); |
9b1ec2b8 TC |
275 | |
276 | for my $bits (qw(8 double)) { | |
277 | { | |
278 | my $targim = Imager->new(xsize=>4, ysize=>4, bits => $bits); | |
279 | $targim->box(filled=>1, color=>$target); | |
280 | $targim->box(fill=>$fillobj); | |
281 | my $c = Imager::i_get_pixel($targim->{IMG}, 1, 1); | |
282 | my $allowed = $test->{opaque}; | |
283 | $allowed =~ /ARRAY/ or $allowed = [ $allowed ]; | |
284 | ok(scalar grep(color_close($_, $c), @$allowed), | |
285 | "opaque '$comb' $bits bits") | |
286 | or print "# got:",join(",", $c->rgba)," allowed: ", | |
287 | join("|", map { join(",", $_->rgba) } @$allowed),"\n"; | |
288 | } | |
289 | ||
290 | { | |
291 | # make sure the alpha path in the combine function produces the same | |
292 | # or at least as sane a result as the non-alpha path | |
293 | my $targim = Imager->new(xsize=>4, ysize=>4, channels => 4, bits => $bits); | |
294 | $targim->box(filled=>1, color=>$target); | |
295 | $targim->box(fill=>$fillobj); | |
296 | my $c = Imager::i_get_pixel($targim->{IMG}, 1, 1); | |
297 | my $allowed = $test->{opaque}; | |
298 | $allowed =~ /ARRAY/ or $allowed = [ $allowed ]; | |
299 | ok(scalar grep(color_close4($_, $c), @$allowed), | |
300 | "opaque '$comb' 4-channel $bits bits") | |
301 | or print "# got:",join(",", $c->rgba)," allowed: ", | |
302 | join("|", map { join(",", $_->rgba) } @$allowed),"\n"; | |
303 | } | |
304 | ||
305 | { | |
306 | my $transim = Imager->new(xsize => 4, ysize => 4, channels => 4, bits => $bits); | |
307 | $transim->box(filled=>1, color=>$trans_target); | |
308 | $transim->box(fill => $fillobj); | |
309 | my $c = $transim->getpixel(x => 1, 'y' => 1); | |
310 | my $allowed = $test->{trans}; | |
311 | $allowed =~ /ARRAY/ or $allowed = [ $allowed ]; | |
312 | ok(scalar grep(color_close4($_, $c), @$allowed), | |
313 | "translucent '$comb' $bits bits") | |
314 | or print "# got:",join(",", $c->rgba)," allowed: ", | |
315 | join("|", map { join(",", $_->rgba) } @$allowed),"\n"; | |
316 | } | |
efdc2568 TC |
317 | } |
318 | } | |
319 | ||
109bec2d | 320 | ok($ffim->arc(r=>45, color=>$blue, aa=>1), "aa circle"); |
0d321238 TC |
321 | $ffim->write(file=>"testout/t20_aacircle.ppm"); |
322 | ||
f576ce7e TC |
323 | # image based fills |
324 | my $green = NC(0, 255, 0); | |
325 | my $fillim = Imager->new(xsize=>40, ysize=>40, channels=>4); | |
326 | $fillim->box(filled=>1, xmin=>5, ymin=>5, xmax=>35, ymax=>35, | |
327 | color=>NC(0, 0, 255, 128)); | |
328 | $fillim->arc(filled=>1, r=>10, color=>$green, aa=>1); | |
329 | my $ooim = Imager->new(xsize=>150, ysize=>150); | |
330 | $ooim->box(filled=>1, color=>$green, xmin=>70, ymin=>25, xmax=>130, ymax=>125); | |
331 | $ooim->box(filled=>1, color=>$blue, xmin=>20, ymin=>25, xmax=>80, ymax=>125); | |
332 | $ooim->arc(r=>30, color=>$red, aa=>1); | |
333 | ||
334 | my $oocopy = $ooim->copy(); | |
109bec2d | 335 | ok($oocopy->arc(fill=>{image=>$fillim, |
f576ce7e TC |
336 | combine=>'normal', |
337 | xoff=>5}, r=>40), | |
338 | "image based fill"); | |
339 | $oocopy->write(file=>'testout/t20_image.ppm'); | |
340 | ||
341 | # a more complex version | |
342 | use Imager::Matrix2d ':handy'; | |
343 | $oocopy = $ooim->copy; | |
109bec2d | 344 | ok($oocopy->arc(fill=>{ |
f576ce7e TC |
345 | image=>$fillim, |
346 | combine=>'normal', | |
347 | matrix=>m2d_rotate(degrees=>30), | |
348 | xoff=>5 | |
349 | }, r=>40), | |
350 | "transformed image based fill"); | |
351 | $oocopy->write(file=>'testout/t20_image_xform.ppm'); | |
352 | ||
109bec2d | 353 | ok(!$oocopy->arc(fill=>{ hatch=>"not really a hatch" }, r=>20), |
569795e8 | 354 | "error handling of automatic fill conversion"); |
109bec2d | 355 | ok($oocopy->errstr =~ /Unknown hatch type/, |
569795e8 TC |
356 | "error message for automatic fill conversion"); |
357 | ||
2de568dc TC |
358 | # previous box fills to float images, or using the fountain fill |
359 | # got into a loop here | |
f3b59de8 | 360 | |
109bec2d TC |
361 | SKIP: |
362 | { | |
363 | skip("can't test without alarm()", 1) unless $Config{d_alarm}; | |
2de568dc TC |
364 | local $SIG{ALRM} = sub { die; }; |
365 | ||
366 | eval { | |
367 | alarm(2); | |
109bec2d | 368 | ok($ooim->box(xmin=>20, ymin=>20, xmax=>80, ymax=>40, |
2de568dc TC |
369 | fill=>{ fountain=>'linear', xa=>20, ya=>20, xb=>80, |
370 | yb=>20 }), "linear box fill"); | |
13b8afa0 | 371 | alarm 0; |
2de568dc | 372 | }; |
109bec2d | 373 | $@ and ok(0, "linear box fill $@"); |
f3b59de8 | 374 | } |
2de568dc | 375 | |
109bec2d TC |
376 | # test that passing in a non-array ref returns an error |
377 | { | |
378 | my $fill = Imager::Fill->new(fountain=>'linear', | |
379 | xa => 20, ya=>20, xb=>20, yb=>40, | |
380 | segments=>"invalid"); | |
381 | ok(!$fill, "passing invalid segments produces an error"); | |
382 | cmp_ok(Imager->errstr, '=~', 'array reference', | |
383 | "check the error message"); | |
384 | } | |
f1ac5027 | 385 | |
109bec2d TC |
386 | # test that colors in segments are converted |
387 | { | |
388 | my @segs = | |
389 | ( | |
390 | [ 0.0, 0.5, 1.0, '000000', '#FFF', 0, 0 ], | |
391 | ); | |
392 | my $fill = Imager::Fill->new(fountain=>'linear', | |
393 | xa => 0, ya=>20, xb=>49, yb=>20, | |
394 | segments=>\@segs); | |
395 | ok($fill, "check that color names are converted") | |
396 | or print "# ",Imager->errstr,"\n"; | |
397 | my $im = Imager->new(xsize=>50, ysize=>50); | |
398 | $im->box(fill=>$fill); | |
399 | my $left = $im->getpixel('x'=>0, 'y'=>20); | |
400 | ok(color_close($left, Imager::Color->new(0,0,0)), | |
401 | "check black converted correctly"); | |
402 | my $right = $im->getpixel('x'=>49, 'y'=>20); | |
403 | ok(color_close($right, Imager::Color->new(255,255,255)), | |
404 | "check white converted correctly"); | |
405 | ||
406 | # check that invalid colors handled correctly | |
407 | ||
408 | my @segs2 = | |
409 | ( | |
410 | [ 0.0, 0.5, 1.0, '000000', 'FxFxFx', 0, 0 ], | |
411 | ); | |
412 | my $fill2 = Imager::Fill->new(fountain=>'linear', | |
413 | xa => 0, ya=>20, xb=>49, yb=>20, | |
414 | segments=>\@segs2); | |
415 | ok(!$fill2, "check handling of invalid color names"); | |
416 | cmp_ok(Imager->errstr, '=~', 'No color named', "check error message"); | |
efdc2568 TC |
417 | } |
418 | ||
04f85f63 TC |
419 | { # RT #35278 |
420 | # hatch fills on a grey scale image don't adapt colors | |
421 | for my $bits (8, 'double') { | |
422 | my $im_g = Imager->new(xsize => 10, ysize => 10, channels => 1, bits => $bits); | |
423 | $im_g->box(filled => 1, color => 'FFFFFF'); | |
424 | my $fill = Imager::Fill->new | |
425 | ( | |
426 | combine => 'normal', | |
427 | hatch => 'weave', | |
428 | fg => '000000', | |
429 | bg => 'FFFFFF' | |
430 | ); | |
431 | $im_g->box(fill => $fill); | |
432 | my $im_c = Imager->new(xsize => 10, ysize => 10, channels => 3, bits => $bits); | |
433 | $im_c->box(filled => 1, color => 'FFFFFF'); | |
434 | $im_c->box(fill => $fill); | |
435 | my $im_cg = $im_g->convert(preset => 'rgb'); | |
a256aec5 TC |
436 | is_image($im_c, $im_cg, "check hatch is the same between color and greyscale (bits $bits)"); |
437 | ||
438 | # check the same for image fills | |
439 | my $grey_fill = Imager::Fill->new | |
440 | ( | |
441 | image => $im_g, | |
442 | combine => 'normal' | |
443 | ); | |
444 | my $im_cfg = Imager->new(xsize => 20, ysize => 20, bits => $bits); | |
445 | $im_cfg->box(filled => 1, color => '808080'); | |
446 | $im_cfg->box(fill => $grey_fill); | |
447 | my $rgb_fill = Imager::Fill->new | |
448 | ( | |
449 | image => $im_cg, | |
450 | combine => 'normal' | |
451 | ); | |
452 | my $im_cfc = Imager->new(xsize => 20, ysize => 20, bits => $bits); | |
453 | $im_cfc->box(filled => 1, color => '808080'); | |
454 | $im_cfc->box(fill => $rgb_fill); | |
455 | is_image($im_cfg, $im_cfc, "check filling from grey image matches filling from rgb (bits = $bits)"); | |
456 | ||
457 | my $im_gfg = Imager->new(xsize => 20, ysize => 20, channels => 1, bits => $bits); | |
458 | $im_gfg->box(filled => 1, color => '808080'); | |
459 | $im_gfg->box(fill => $grey_fill); | |
460 | my $im_gfg_c = $im_gfg->convert(preset => 'rgb'); | |
461 | is_image($im_gfg_c, $im_cfg, "check grey filled with grey against base (bits = $bits)"); | |
462 | ||
463 | my $im_gfc = Imager->new(xsize => 20, ysize => 20, channels => 1, bits => $bits); | |
464 | $im_gfc->box(filled => 1, color => '808080'); | |
465 | $im_gfc->box(fill => $rgb_fill); | |
466 | my $im_gfc_c = $im_gfc->convert(preset => 'rgb'); | |
467 | is_image($im_gfc_c, $im_cfg, "check grey filled with color against base (bits = $bits)"); | |
04f85f63 TC |
468 | } |
469 | } | |
470 | ||
52f2b10a TC |
471 | { # alpha modifying fills |
472 | { # 8-bit/sample | |
473 | my $base_img = Imager->new(xsize => 4, ysize => 2, channels => 4); | |
474 | $base_img->setscanline | |
475 | ( | |
476 | x => 0, | |
477 | y => 0, | |
478 | pixels => | |
479 | [ | |
480 | map Imager::Color->new($_), | |
481 | qw/FF000020 00FF0080 00008040 FFFF00FF/, | |
482 | ], | |
483 | ); | |
484 | $base_img->setscanline | |
485 | ( | |
486 | x => 0, | |
487 | y => 1, | |
488 | pixels => | |
489 | [ | |
490 | map Imager::Color->new($_), | |
491 | qw/FFFF00FF FF000000 00FF0080 00008040/ | |
492 | ] | |
493 | ); | |
494 | my $base_fill = Imager::Fill->new | |
495 | ( | |
496 | image => $base_img, | |
497 | combine => "normal", | |
498 | ); | |
499 | ok($base_fill, "make the base image fill"); | |
500 | my $fill50 = Imager::Fill->new(type => "opacity", opacity => 0.5, other => $base_fill) | |
501 | or print "# ", Imager->errstr, "\n"; | |
502 | ok($fill50, "make 50% alpha translation fill"); | |
e958b64e TC |
503 | |
504 | { # 4 channel image | |
505 | my $out = Imager->new(xsize => 10, ysize => 10, channels => 4); | |
506 | $out->box(fill => $fill50); | |
507 | is_color4($out->getpixel(x => 0, y => 0), | |
508 | 255, 0, 0, 16, "check alpha output"); | |
509 | is_color4($out->getpixel(x => 2, y => 1), | |
510 | 0, 255, 0, 64, "check alpha output"); | |
511 | $out->box(filled => 1, color => "000000"); | |
512 | is_color4($out->getpixel(x => 0, y => 0), | |
513 | 0, 0, 0, 255, "check after clear"); | |
514 | $out->box(fill => $fill50); | |
515 | is_color4($out->getpixel(x => 4, y => 2), | |
516 | 16, 0, 0, 255, "check drawn against background"); | |
517 | is_color4($out->getpixel(x => 6, y => 3), | |
518 | 0, 64, 0, 255, "check drawn against background"); | |
519 | } | |
520 | { # 3 channel image | |
521 | my $out = Imager->new(xsize => 10, ysize => 10, channels => 3); | |
522 | $out->box(fill => $fill50); | |
523 | is_color3($out->getpixel(x => 0, y => 0), | |
524 | 16, 0, 0, "check alpha output"); | |
525 | is_color3($out->getpixel(x => 2, y => 1), | |
526 | 0, 64, 0, "check alpha output"); | |
527 | is_color3($out->getpixel(x => 0, y => 1), | |
528 | 128, 128, 0, "check alpha output"); | |
529 | } | |
52f2b10a TC |
530 | } |
531 | { # double/sample | |
532 | use Imager::Color::Float; | |
533 | my $base_img = Imager->new(xsize => 4, ysize => 2, channels => 4, bits => "double"); | |
534 | $base_img->setscanline | |
535 | ( | |
536 | x => 0, | |
537 | y => 0, | |
538 | pixels => | |
539 | [ | |
540 | map Imager::Color::Float->new(@$_), | |
541 | [ 1, 0, 0, 0.125 ], | |
542 | [ 0, 1, 0, 0.5 ], | |
543 | [ 0, 0, 0.5, 0.25 ], | |
544 | [ 1, 1, 0, 1 ], | |
545 | ], | |
546 | ); | |
547 | $base_img->setscanline | |
548 | ( | |
549 | x => 0, | |
550 | y => 1, | |
551 | pixels => | |
552 | [ | |
553 | map Imager::Color::Float->new(@$_), | |
554 | [ 1, 1, 0, 1 ], | |
555 | [ 1, 0, 0, 0 ], | |
556 | [ 0, 1, 0, 0.5 ], | |
557 | [ 0, 0, 0.5, 0.25 ], | |
558 | ] | |
559 | ); | |
560 | my $base_fill = Imager::Fill->new | |
561 | ( | |
562 | image => $base_img, | |
563 | combine => "normal", | |
564 | ); | |
565 | ok($base_fill, "make the base image fill"); | |
566 | my $fill50 = Imager::Fill->new(type => "opacity", opacity => 0.5, other => $base_fill) | |
567 | or print "# ", Imager->errstr, "\n"; | |
568 | ok($fill50, "make 50% alpha translation fill"); | |
569 | my $out = Imager->new(xsize => 10, ysize => 10, channels => 4, bits => "double"); | |
570 | $out->box(fill => $fill50); | |
571 | is_fcolor4($out->getpixel(x => 0, y => 0, type => "float"), | |
572 | 1, 0, 0, 0.0625, "check alpha output at 0,0"); | |
573 | is_fcolor4($out->getpixel(x => 2, y => 1, type => "float"), | |
574 | 0, 1, 0, 0.25, "check alpha output at 2,1"); | |
575 | $out->box(filled => 1, color => "000000"); | |
576 | is_fcolor4($out->getpixel(x => 0, y => 0, type => "float"), | |
577 | 0, 0, 0, 1, "check after clear"); | |
578 | $out->box(fill => $fill50); | |
579 | is_fcolor4($out->getpixel(x => 4, y => 2, type => "float"), | |
580 | 0.0625, 0, 0, 1, "check drawn against background at 4,2"); | |
581 | is_fcolor4($out->getpixel(x => 6, y => 3, type => "float"), | |
582 | 0, 0.25, 0, 1, "check drawn against background at 6,3"); | |
583 | } | |
6f1e1621 TC |
584 | ok(!Imager::Fill->new(type => "opacity"), |
585 | "should fail to make an opacity fill with no other fill object"); | |
a16bae72 | 586 | is(Imager->errstr, "'other' parameter required to create opacity fill", |
6f1e1621 TC |
587 | "check error message"); |
588 | ok(!Imager::Fill->new(type => "opacity", other => "xx"), | |
589 | "should fail to make an opacity fill with a bad other parameter"); | |
a16bae72 | 590 | is(Imager->errstr, "'other' parameter must be an Imager::Fill object to create an opacity fill", |
6f1e1621 TC |
591 | "check error message"); |
592 | ||
593 | # check auto conversion of hashes | |
594 | ok(Imager::Fill->new(type => "opacity", other => { solid => "FF0000" }), | |
595 | "check we auto-create fills") | |
596 | or print "# ", Imager->errstr, "\n"; | |
e958b64e TC |
597 | |
598 | { | |
599 | # fill with combine none was modifying the wrong channel for a | |
600 | # no-alpha target image | |
601 | my $fill = Imager::Fill->new(solid => "#FFF", combine => "none"); | |
602 | my $fill2 = Imager::Fill->new | |
603 | ( | |
604 | type => "opacity", | |
605 | opacity => 0.5, | |
606 | other => $fill | |
607 | ); | |
608 | my $im = Imager->new(xsize => 1, ysize => 1); | |
609 | ok($im->box(fill => $fill2), "fill with replacement opacity fill"); | |
610 | is_color3($im->getpixel(x => 0, y => 0), 255, 255, 255, | |
611 | "check for correct colour"); | |
612 | } | |
8c194049 TC |
613 | |
614 | { | |
615 | require Imager::Fountain; | |
616 | my $fount = Imager::Fountain->new; | |
617 | $fount->add(c1 => "FFFFFF"); # simple white to black | |
618 | # base fill is a fountain | |
619 | my $base_fill = Imager::Fill->new | |
620 | ( | |
621 | fountain => "linear", | |
622 | segments => $fount, | |
623 | xa => 0, | |
624 | ya => 0, | |
625 | xb => 100, | |
626 | yb => 100, | |
627 | ); | |
628 | ok($base_fill, "made fountain fill base"); | |
629 | my $op_fill = Imager::Fill->new | |
630 | ( | |
631 | type => "opacity", | |
632 | other => $base_fill, | |
633 | opacity => 0.5, | |
634 | ); | |
635 | ok($op_fill, "made opacity fountain fill"); | |
636 | my $im = Imager->new(xsize => 100, ysize => 100); | |
637 | ok($im->box(fill => $op_fill), "draw with it"); | |
638 | } | |
52f2b10a TC |
639 | } |
640 | ||
7a98c442 TC |
641 | { # RT 71309 |
642 | my $fount = Imager::Fountain->simple(colors => [ '#804041', '#804041' ], | |
643 | positions => [ 0, 1 ]); | |
644 | my $im = Imager->new(xsize => 40, ysize => 40); | |
645 | $im->box(filled => 1, color => '#804040'); | |
646 | my $fill = Imager::Fill->new | |
647 | ( | |
648 | combine => 0, | |
649 | fountain => "linear", | |
650 | segments => $fount, | |
651 | xa => 0, ya => 0, | |
652 | xb => 40, yb => 40, | |
653 | ); | |
654 | $im->polygon(fill => $fill, | |
655 | points => | |
656 | [ | |
657 | [ 0, 0 ], | |
658 | [ 40, 20 ], | |
659 | [ 20, 40 ], | |
660 | ] | |
661 | ); | |
662 | # the bug magnified the differences between the source and destination | |
663 | # color, blending between the background and fill colors here only allows | |
664 | # for those 2 colors in the result. | |
665 | # with the bug extra colors appeared along the edge of the polygon. | |
666 | is($im->getcolorcount, 2, "only original and fill color"); | |
667 | } | |
668 | ||
efdc2568 TC |
669 | sub color_close { |
670 | my ($c1, $c2) = @_; | |
671 | ||
672 | my @c1 = $c1->rgba; | |
673 | my @c2 = $c2->rgba; | |
674 | ||
675 | for my $i (0..2) { | |
676 | if (abs($c1[$i]-$c2[$i]) > 2) { | |
677 | return 0; | |
678 | } | |
679 | } | |
680 | return 1; | |
f1ac5027 TC |
681 | } |
682 | ||
9b1ec2b8 TC |
683 | sub color_close4 { |
684 | my ($c1, $c2) = @_; | |
685 | ||
686 | my @c1 = $c1->rgba; | |
687 | my @c2 = $c2->rgba; | |
688 | ||
689 | for my $i (0..3) { | |
690 | if (abs($c1[$i]-$c2[$i]) > 2) { | |
691 | return 0; | |
692 | } | |
693 | } | |
694 | return 1; | |
695 | } | |
696 | ||
f1ac5027 TC |
697 | # for use during testing |
698 | sub save { | |
699 | my ($im, $name) = @_; | |
700 | ||
701 | open FH, "> $name" or die "Cannot create $name: $!"; | |
702 | binmode FH; | |
703 | my $io = Imager::io_new_fd(fileno(FH)); | |
704 | Imager::i_writeppm_wiol($im, $io) or die "Cannot save to $name"; | |
705 | undef $io; | |
706 | close FH; | |
707 | } |