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