]>
Commit | Line | Data |
---|---|---|
a8652edf | 1 | #!perl -w |
3a9a4241 | 2 | use strict; |
1136f089 | 3 | use Test::More tests => 256; |
40068b33 | 4 | use Imager ':all'; |
353eb6e7 | 5 | use Imager::Test qw(is_color3 is_image); |
40068b33 | 6 | use constant PI => 3.14159265358979; |
3a9a4241 | 7 | |
40e78f96 TC |
8 | -d "testout" or mkdir "testout"; |
9 | ||
3a9a4241 TC |
10 | init_log("testout/t21draw.log",1); |
11 | ||
12 | my $redobj = NC(255, 0, 0); | |
13 | my $red = 'FF0000'; | |
14 | my $greenobj = NC(0, 255, 0); | |
15 | my $green = [ 0, 255, 0 ]; | |
16 | my $blueobj = NC(0, 0, 255); | |
17 | my $blue = { hue=>240, saturation=>1, value=>1 }; | |
18 | my $white = '#FFFFFF'; | |
19 | ||
40068b33 TC |
20 | { |
21 | my $img = Imager->new(xsize=>100, ysize=>500); | |
22 | ||
23 | ok($img->box(color=>$blueobj, xmin=>10, ymin=>10, xmax=>48, ymax=>18), | |
24 | "box with color obj"); | |
25 | ok($img->box(color=>$blue, xmin=>10, ymin=>20, xmax=>48, ymax=>28), | |
26 | "box with color"); | |
27 | ok($img->box(color=>$redobj, xmin=>10, ymin=>30, xmax=>28, ymax=>48, filled=>1), | |
28 | "filled box with color obj"); | |
29 | ok($img->box(color=>$red, xmin=>30, ymin=>30, xmax=>48, ymax=>48, filled=>1), | |
30 | "filled box with color"); | |
31 | ||
32 | ok($img->arc('x'=>75, 'y'=>25, r=>24, color=>$redobj), | |
33 | "filled arc with colorobj"); | |
34 | ||
35 | ok($img->arc('x'=>75, 'y'=>25, r=>20, color=>$green), | |
36 | "filled arc with colorobj"); | |
37 | ok($img->arc('x'=>75, 'y'=>25, r=>18, color=>$white, d1=>325, d2=>225), | |
38 | "filled arc with color"); | |
39 | ||
40 | ok($img->arc('x'=>75, 'y'=>25, r=>18, color=>$blue, d1=>225, d2=>325), | |
41 | "filled arc with color"); | |
42 | ok($img->arc('x'=>75, 'y'=>25, r=>15, color=>$green, aa=>1), | |
43 | "filled arc with color"); | |
44 | ||
45 | ok($img->line(color=>$blueobj, x1=>5, y1=>55, x2=>35, y2=>95), | |
46 | "line with colorobj"); | |
47 | ||
48 | # FIXME - neither the start nor end-point is set for a non-aa line | |
49 | my $c = Imager::i_get_pixel($img->{IMG}, 5, 55); | |
50 | ok(color_cmp($c, $blueobj) == 0, "# TODO start point not set"); | |
51 | ||
52 | ok($img->line(color=>$red, x1=>10, y1=>55, x2=>40, y2=>95, aa=>1), | |
53 | "aa line with color"); | |
54 | ok($img->line(color=>$green, x1=>15, y1=>55, x2=>45, y2=>95, antialias=>1), | |
55 | "antialias line with color"); | |
56 | ||
57 | ok($img->polyline(points=>[ [ 55, 55 ], [ 90, 60 ], [ 95, 95] ], | |
58 | color=>$redobj), | |
59 | "polyline points with color obj"); | |
60 | ok($img->polyline('x'=>[ 55, 85, 90 ], 'y'=>[60, 65, 95], color=>$green, aa=>1), | |
61 | "polyline xy with color aa"); | |
62 | ok($img->polyline('x'=>[ 55, 80, 85 ], 'y'=>[65, 70, 95], color=>$green, | |
63 | antialias=>1), | |
64 | "polyline xy with color antialias"); | |
65 | ||
66 | ok($img->setpixel('x'=>[35, 37, 39], 'y'=>[55, 57, 59], color=>$red), | |
67 | "set array of pixels"); | |
68 | ok($img->setpixel('x'=>39, 'y'=>55, color=>$green), | |
69 | "set single pixel"); | |
70 | use Imager::Color::Float; | |
71 | my $flred = Imager::Color::Float->new(1, 0, 0, 0); | |
72 | my $flgreen = Imager::Color::Float->new(0, 1, 0, 0); | |
73 | ok($img->setpixel('x'=>[41, 43, 45], 'y'=>[55, 57, 59], color=>$flred), | |
74 | "set array of float pixels"); | |
75 | ok($img->setpixel('x'=>45, 'y'=>55, color=>$flgreen), | |
76 | "set single float pixel"); | |
77 | my @gp = $img->getpixel('x'=>[41, 43, 45], 'y'=>[55, 57, 59]); | |
78 | ok(grep($_->isa('Imager::Color'), @gp) == 3, "check getpixel result type"); | |
79 | ok(grep(color_cmp($_, NC(255, 0, 0)) == 0, @gp) == 3, | |
80 | "check getpixel result colors"); | |
81 | my $gp = $img->getpixel('x'=>45, 'y'=>55); | |
82 | ok($gp->isa('Imager::Color'), "check scalar getpixel type"); | |
83 | ok(color_cmp($gp, NC(0, 255, 0)) == 0, "check scalar getpixel color"); | |
84 | @gp = $img->getpixel('x'=>[35, 37, 39], 'y'=>[55, 57, 59], type=>'float'); | |
85 | ok(grep($_->isa('Imager::Color::Float'), @gp) == 3, | |
86 | "check getpixel float result type"); | |
87 | ok(grep(color_cmp($_, $flred) == 0, @gp) == 3, | |
88 | "check getpixel float result type"); | |
89 | $gp = $img->getpixel('x'=>39, 'y'=>55, type=>'float'); | |
90 | ok($gp->isa('Imager::Color::Float'), "check scalar float getpixel type"); | |
91 | ok(color_cmp($gp, $flgreen) == 0, "check scalar float getpixel color"); | |
92 | ||
93 | # more complete arc tests | |
94 | ok($img->arc(x=>25, 'y'=>125, r=>20, d1=>315, d2=>45, color=>$greenobj), | |
95 | "color arc through angle 0"); | |
96 | # use diff combine here to make sure double writing is noticable | |
97 | ok($img->arc(x=>75, 'y'=>125, r=>20, d1=>315, d2=>45, | |
98 | fill => { solid=>$blueobj, combine => 'diff' }), | |
99 | "fill arc through angle 0"); | |
100 | ok($img->arc(x=>25, 'y'=>175, r=>20, d1=>315, d2=>225, color=>$redobj), | |
101 | "concave color arc"); | |
102 | angle_marker($img, 25, 175, 23, 315, 225); | |
103 | ok($img->arc(x=>75, 'y'=>175, r=>20, d1=>315, d2=>225, | |
104 | fill => { solid=>$greenobj, combine=>'diff' }), | |
105 | "concave fill arc"); | |
106 | angle_marker($img, 75, 175, 23, 315, 225); | |
107 | ok($img->arc(x=>25, y=>225, r=>20, d1=>135, d2=>45, color=>$redobj), | |
108 | "another concave color arc"); | |
109 | angle_marker($img, 25, 225, 23, 45, 135); | |
110 | ok($img->arc(x=>75, y=>225, r=>20, d1=>135, d2=>45, | |
111 | fill => { solid=>$blueobj, combine=>'diff' }), | |
112 | "another concave fillarc"); | |
113 | angle_marker($img, 75, 225, 23, 45, 135); | |
114 | ok($img->arc(x=>25, y=>275, r=>20, d1=>135, d2=>45, color=>$redobj, aa=>1), | |
115 | "concave color arc aa"); | |
116 | ok($img->arc(x=>75, y=>275, r=>20, d1=>135, d2=>45, | |
117 | fill => { solid=>$blueobj, combine=>'diff' }, aa=>1), | |
118 | "concave fill arc aa"); | |
119 | ||
120 | ok($img->circle(x=>25, y=>325, r=>20, color=>$redobj), | |
121 | "color circle no aa"); | |
122 | ok($img->circle(x=>75, y=>325, r=>20, color=>$redobj, aa=>1), | |
123 | "color circle aa"); | |
124 | ok($img->circle(x=>25, 'y'=>375, r=>20, | |
125 | fill => { hatch=>'stipple', fg=>$blueobj, bg=>$redobj }), | |
126 | "fill circle no aa"); | |
127 | ok($img->circle(x=>75, 'y'=>375, r=>20, aa=>1, | |
128 | fill => { hatch=>'stipple', fg=>$blueobj, bg=>$redobj }), | |
129 | "fill circle aa"); | |
130 | ||
131 | ok($img->arc(x=>50, y=>450, r=>45, d1=>135, d2=>45, | |
132 | fill => { solid=>$blueobj, combine=>'diff' }), | |
133 | "another concave fillarc"); | |
134 | angle_marker($img, 50, 450, 47, 45, 135); | |
135 | ||
136 | ok($img->write(file=>'testout/t21draw.ppm'), | |
137 | "saving output"); | |
138 | } | |
139 | ||
140 | { | |
141 | my $im = Imager->new(xsize => 400, ysize => 400); | |
142 | ok($im->arc(x => 200, y => 202, r => 10, filled => 0), | |
143 | "draw circle outline"); | |
144 | is_color3($im->getpixel(x => 200, y => 202), 0, 0, 0, | |
145 | "check center not filled"); | |
146 | ok($im->arc(x => 198, y => 200, r => 13, filled => 0, color => "#f88"), | |
147 | "draw circle outline"); | |
148 | is_color3($im->getpixel(x => 198, y => 200), 0, 0, 0, | |
149 | "check center not filled"); | |
150 | ok($im->arc(x => 200, y => 200, r => 24, filled => 0, color => "#0ff"), | |
151 | "draw circle outline"); | |
152 | my $r = 40; | |
153 | while ($r < 180) { | |
154 | ok($im->arc(x => 200, y => 200, r => $r, filled => 0, color => "#ff0"), | |
155 | "draw circle outline r $r"); | |
156 | $r += 15; | |
157 | } | |
158 | ok($im->write(file => "testout/t21circout.ppm"), | |
159 | "save arc outline"); | |
160 | } | |
161 | ||
162 | { | |
163 | my $im = Imager->new(xsize => 400, ysize => 400); | |
164 | { | |
165 | my $lc = Imager::Color->new(32, 32, 32); | |
166 | my $an = 0; | |
167 | while ($an < 360) { | |
168 | my $an_r = $an * PI / 180; | |
169 | my $ca = cos($an_r); | |
170 | my $sa = sin($an_r); | |
171 | $im->line(aa => 1, color => $lc, | |
172 | x1 => 198 + 5 * $ca, y1 => 202 + 5 * $sa, | |
173 | x2 => 198 + 190 * $ca, y2 => 202 + 190 * $sa); | |
174 | $an += 5; | |
175 | } | |
176 | } | |
177 | my $d1 = 0; | |
178 | my $r = 20; | |
179 | while ($d1 < 350) { | |
180 | ok($im->arc(x => 198, y => 202, r => $r, d1 => $d1, d2 => $d1+300, filled => 0), | |
181 | "draw arc outline r$r d1$d1 len 300"); | |
182 | ok($im->arc(x => 198, y => 202, r => $r+3, d1 => $d1, d2 => $d1+40, filled => 0, color => '#FFFF00'), | |
183 | "draw arc outline r$r d1$d1 len 40"); | |
184 | $d1 += 15; | |
185 | $r += 6; | |
186 | } | |
187 | is_color3($im->getpixel(x => 198, y => 202), 0, 0, 0, | |
188 | "check center not filled"); | |
189 | ok($im->write(file => "testout/t21arcout.ppm"), | |
190 | "save arc outline"); | |
191 | } | |
192 | ||
193 | { | |
194 | my $im = Imager->new(xsize => 400, ysize => 400); | |
195 | ok($im->arc(x => 197, y => 201, r => 10, filled => 0, aa => 1, color => 'white'), | |
196 | "draw circle outline"); | |
197 | is_color3($im->getpixel(x => 197, y => 201), 0, 0, 0, | |
198 | "check center not filled"); | |
199 | ok($im->arc(x => 197, y => 205, r => 13, filled => 0, color => "#f88", aa => 1), | |
200 | "draw circle outline"); | |
201 | is_color3($im->getpixel(x => 197, y => 205), 0, 0, 0, | |
202 | "check center not filled"); | |
203 | ok($im->arc(x => 190, y => 215, r => 24, filled => 0, color => [0,0, 255, 128], aa => 1), | |
204 | "draw circle outline"); | |
205 | my $r = 40; | |
206 | while ($r < 190) { | |
207 | ok($im->arc(x => 197, y => 201, r => $r, filled => 0, aa => 1, color => '#ff0'), "draw aa circle rad $r"); | |
208 | $r += 7; | |
209 | } | |
210 | ok($im->write(file => "testout/t21aacircout.ppm"), | |
211 | "save arc outline"); | |
212 | } | |
213 | ||
214 | { | |
215 | my $im = Imager->new(xsize => 400, ysize => 400); | |
216 | { | |
217 | my $lc = Imager::Color->new(32, 32, 32); | |
218 | my $an = 0; | |
219 | while ($an < 360) { | |
220 | my $an_r = $an * PI / 180; | |
221 | my $ca = cos($an_r); | |
222 | my $sa = sin($an_r); | |
223 | $im->line(aa => 1, color => $lc, | |
224 | x1 => 198 + 5 * $ca, y1 => 202 + 5 * $sa, | |
225 | x2 => 198 + 190 * $ca, y2 => 202 + 190 * $sa); | |
226 | $an += 5; | |
227 | } | |
228 | } | |
229 | my $d1 = 0; | |
230 | my $r = 20; | |
231 | while ($d1 < 350) { | |
232 | ok($im->arc(x => 198, y => 202, r => $r, d1 => $d1, d2 => $d1+300, filled => 0, aa => 1), | |
233 | "draw aa arc outline r$r d1$d1 len 300"); | |
234 | ok($im->arc(x => 198, y => 202, r => $r+3, d1 => $d1, d2 => $d1+40, filled => 0, color => '#FFFF00', aa => 1), | |
235 | "draw aa arc outline r$r d1$d1 len 40"); | |
236 | $d1 += 15; | |
237 | $r += 6; | |
238 | } | |
239 | is_color3($im->getpixel(x => 198, y => 202), 0, 0, 0, | |
240 | "check center not filled"); | |
241 | ok($im->write(file => "testout/t21aaarcout.ppm"), | |
242 | "save arc outline"); | |
243 | } | |
244 | ||
245 | { | |
246 | my $im = Imager->new(xsize => 400, ysize => 400); | |
247 | ||
248 | my $an = 0; | |
249 | my $step = 15; | |
250 | while ($an <= 360-$step) { | |
251 | my $cx = int(200 + 20 * cos(($an+$step/2) * PI / 180)); | |
252 | my $cy = int(200 + 20 * sin(($an+$step/2) * PI / 180)); | |
253 | ||
254 | ok($im->arc(x => $cx, y => $cy, aa => 1, color => "#fff", | |
255 | d1 => $an, d2 => $an+$step, filled => 0, r => 170), | |
256 | "angle starting from $an"); | |
b3b57f5a | 257 | ok($im->arc(x => $cx+0.5, y => $cy+0.5, aa => 1, color => "#ff0", |
40068b33 TC |
258 | d1 => $an, d2 => $an+$step, r => 168), |
259 | "filled angle starting from $an"); | |
260 | ||
261 | $an += $step; | |
262 | } | |
263 | ok($im->write(file => "testout/t21aaarcs.ppm"), | |
264 | "save arc outline"); | |
265 | } | |
266 | ||
fa8c8ad9 TC |
267 | { |
268 | # we document that drawing from d1 to d2 where d2 > d1 will draw an | |
269 | # arc going through 360 degrees, test that | |
270 | my $im = Imager->new(xsize => 200, ysize => 200); | |
271 | ok($im->arc(x => 100, y => 100, aa => 0, filled => 0, color => '#fff', | |
272 | d1 => 270, d2 => 90, r => 90), "draw non-aa arc through 0"); | |
273 | ok($im->arc(x => 100, y => 100, aa => 1, filled => 0, color => '#fff', | |
274 | d1 => 270, d2 => 90, r => 80), "draw aa arc through 0"); | |
275 | ok($im->write(file => "testout/t21arc0.ppm"), | |
276 | "save arc through 0"); | |
277 | } | |
3a9a4241 | 278 | |
efa2cd20 TC |
279 | { |
280 | # test drawing color defaults | |
281 | { | |
282 | my $im = Imager->new(xsize => 10, ysize => 10); | |
283 | ok($im->box(), "default outline the image"); # should outline the image | |
284 | is_color3($im->getpixel(x => 0, y => 0), 255, 255, 255, | |
285 | "check outline default color TL"); | |
286 | is_color3($im->getpixel(x => 9, y => 5), 255, 255, 255, | |
287 | "check outline default color MR"); | |
288 | } | |
289 | ||
290 | { | |
291 | my $im = Imager->new(xsize => 10, ysize => 10); | |
292 | ok($im->box(filled => 1), "default fill the image"); # should fill the image | |
293 | is_color3($im->getpixel(x => 0, y => 0), 255, 255, 255, | |
294 | "check fill default color TL"); | |
295 | is_color3($im->getpixel(x => 5, y => 5), 255, 255, 255, | |
296 | "check fill default color MM"); | |
297 | } | |
298 | } | |
299 | ||
1136f089 TC |
300 | { |
301 | my $empty = Imager->new; | |
302 | ok(!$empty->box(), "can't draw box to empty image"); | |
303 | is($empty->errstr, "box: empty input image", "check error message"); | |
304 | ok(!$empty->arc(), "can't draw arc to empty image"); | |
305 | is($empty->errstr, "arc: empty input image", "check error message"); | |
306 | ok(!$empty->line(x1 => 0, y1 => 0, x2 => 10, y2 => 0), | |
307 | "can't draw line to empty image"); | |
308 | is($empty->errstr, "line: empty input image", "check error message"); | |
309 | ok(!$empty->polyline(points => [ [ 0, 0 ], [ 10, 0 ] ]), | |
310 | "can't draw polyline to empty image"); | |
311 | is($empty->errstr, "polyline: empty input image", "check error message"); | |
312 | ok(!$empty->polygon(points => [ [ 0, 0 ], [ 10, 0 ], [ 0, 10 ] ]), | |
313 | "can't draw polygon to empty image"); | |
314 | is($empty->errstr, "polygon: empty input image", "check error message"); | |
315 | ok(!$empty->flood_fill(x => 0, y => 0), "can't flood fill to empty image"); | |
316 | is($empty->errstr, "flood_fill: empty input image", "check error message"); | |
317 | } | |
318 | ||
353eb6e7 | 319 | |
3a9a4241 TC |
320 | malloc_state(); |
321 | ||
40068b33 TC |
322 | unless ($ENV{IMAGER_KEEP_FILES}) { |
323 | unlink "testout/t21draw.ppm"; | |
324 | unlink "testout/t21circout.ppm"; | |
325 | unlink "testout/t21aacircout.ppm"; | |
326 | unlink "testout/t21arcout.ppm"; | |
327 | unlink "testout/t21aaarcout.ppm"; | |
328 | unlink "testout/t21aaarcs.ppm"; | |
fa8c8ad9 | 329 | unlink "testout/t21arc0.ppm"; |
40068b33 TC |
330 | } |
331 | ||
3a9a4241 TC |
332 | sub color_cmp { |
333 | my ($l, $r) = @_; | |
334 | my @l = $l->rgba; | |
335 | my @r = $r->rgba; | |
336 | # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n"; | |
337 | return $l[0] <=> $r[0] | |
338 | || $l[1] <=> $r[1] | |
339 | || $l[2] <=> $r[2]; | |
340 | } | |
b254292b | 341 | |
b254292b TC |
342 | sub angle_marker { |
343 | my ($img, $x, $y, $radius, @angles) = @_; | |
344 | ||
345 | for my $angle (@angles) { | |
346 | my $x1 = int($x + $radius * cos($angle * PI / 180) + 0.5); | |
347 | my $y1 = int($y + $radius * sin($angle * PI / 180) + 0.5); | |
348 | my $x2 = int($x + (5+$radius) * cos($angle * PI / 180) + 0.5); | |
349 | my $y2 = int($y + (5+$radius) * sin($angle * PI / 180) + 0.5); | |
350 | ||
351 | $img->line(x1=>$x1, y1=>$y1, x2=>$x2, y2=>$y2, color=>'#FFF'); | |
352 | } | |
353 | } |