Skip to content
Newer
Older
100644 335 lines (299 sloc) 11.7 KB
a8652ed - arc(..., fill=> ...) wasn't handling concave areas correctly
Tony Cook authored Nov 26, 2005
1 #!perl -w
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
2 use strict;
95b9922 fix flood_fill some more
Tony Cook authored Sep 26, 2010
3 use Test::More tests => 244;
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
4 use Imager ':all';
353eb6e flood_fill() wouldn't fill the right side of a single scan-line fill …
Tony Cook authored Sep 19, 2010
5 use Imager::Test qw(is_color3 is_image);
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
6 use constant PI => 3.14159265358979;
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
7
40e78f9 @tonycoz RT#65088 make sure each test script that needs testout/ creates it
authored Feb 3, 2011
8 -d "testout" or mkdir "testout";
9
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
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
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
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");
b3b57f5 offset in the test code instead
Tony Cook authored Mar 11, 2010
257 ok($im->arc(x => $cx+0.5, y => $cy+0.5, aa => 1, color => "#ff0",
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
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
fa8c8ad test the documented mechanism for drawing an arc through 0 degrees
Tony Cook authored Mar 15, 2010
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 }
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
278
efa2cd2 test default color for box drawing
Tony Cook authored Sep 5, 2010
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
353eb6e flood_fill() wouldn't fill the right side of a single scan-line fill …
Tony Cook authored Sep 19, 2010
300
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
301 malloc_state();
302
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
303 unless ($ENV{IMAGER_KEEP_FILES}) {
304 unlink "testout/t21draw.ppm";
305 unlink "testout/t21circout.ppm";
306 unlink "testout/t21aacircout.ppm";
307 unlink "testout/t21arcout.ppm";
308 unlink "testout/t21aaarcout.ppm";
309 unlink "testout/t21aaarcs.ppm";
fa8c8ad test the documented mechanism for drawing an arc through 0 degrees
Tony Cook authored Mar 15, 2010
310 unlink "testout/t21arc0.ppm";
40068b3 merge circle outline branch
Tony Cook authored Feb 25, 2010
311 }
312
3a9a424 make color values smarter for the drawing functions
Tony Cook authored Nov 21, 2001
313 sub color_cmp {
314 my ($l, $r) = @_;
315 my @l = $l->rgba;
316 my @r = $r->rgba;
317 # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
318 return $l[0] <=> $r[0]
319 || $l[1] <=> $r[1]
320 || $l[2] <=> $r[2];
321 }
b254292 - the straight edges of filled arcs weren't being drawn correctly,
Tony Cook authored Nov 29, 2005
322
323 sub angle_marker {
324 my ($img, $x, $y, $radius, @angles) = @_;
325
326 for my $angle (@angles) {
327 my $x1 = int($x + $radius * cos($angle * PI / 180) + 0.5);
328 my $y1 = int($y + $radius * sin($angle * PI / 180) + 0.5);
329 my $x2 = int($x + (5+$radius) * cos($angle * PI / 180) + 0.5);
330 my $y2 = int($y + (5+$radius) * sin($angle * PI / 180) + 0.5);
331
332 $img->line(x1=>$x1, y1=>$y1, x2=>$x2, y2=>$y2, color=>'#FFF');
333 }
334 }
Something went wrong with that request. Please try again.