merge the thickline branch polygon fix
[imager.git] / t / t75polyaa.t
CommitLineData
1c5252ed 1#!perl -w
02d1d628 2
1c5252ed
TC
3use strict;
4use Test::More tests => 18;
02d1d628 5
1c5252ed
TC
6use Imager qw/NC/;
7use Imager::Test qw(is_image is_color3);
02d1d628 8
9982a307 9sub PI () { 3.14159265358979323846 }
02d1d628 10
1c5252ed
TC
11Imager::init_log("testout/t75aapolyaa.log",1);
12
13my $red = Imager::Color->new(255,0,0);
14my $green = Imager::Color->new(0,255,0);
15my $blue = Imager::Color->new(0,0,255);
16my $white = Imager::Color->new(255,255,255);
17
18{ # artifacts with multiple vertical lobes
19 # https://rt.cpan.org/Ticket/Display.html?id=43518
20 # previously this would have a full coverage pixel at (0,0) caused
21 # by the (20,0.5) point in the right lobe
22
23 my @pts =
24 (
25 [ 0.5, -9 ],
26 [ 10, -9 ],
27 [ 10, 11 ],
28 [ 15, 11 ],
29 [ 15, -9 ],
30 [ 17, -9 ],
31 [ 20, 0.5 ],
32 [ 17, 11 ],
33 [ 0.5, 11 ],
34 );
35 my $im = Imager->new(xsize => 10, ysize => 2);
36 ok($im->polygon(points => \@pts,
37 color => $white),
38 "draw with inside point");
39 ok($im->write(file => "testout/t75inside.ppm"), "save to file");
40 # both scanlines should be the same
41 my $line0 = $im->crop(top => 0, height => 1);
42 my $line1 = $im->crop(top => 1, height => 1);
43 is_image($line0, $line1, "both scanlines should be the same");
44}
02d1d628 45
1c5252ed
TC
46{ # check vertical edges are consistent
47 my $im = Imager->new(xsize => 10, ysize => 10);
48 ok($im->polygon(points => [ [ 0.5, 0 ], [ 9.25, 0 ],
49 [ 9.25, 10 ], [ 0.5, 10 ] ],
50 color => $white,
51 aa => 1),
52 "draw polygon with mid pixel vertical edges")
53 or diag $im->errstr;
54 my @line0 = $im->getscanline(y => 0);
55 my $im2 = Imager->new(xsize => 10, ysize => 10);
56 for my $y (0..9) {
57 $im2->setscanline(y => $y, pixels => \@line0);
58 }
59 is_image($im, $im2, "all scan lines should be the same");
60 is_color3($line0[0], 128, 128, 128, "(0,0) should be 50% coverage");
61 is_color3($line0[9], 64, 64, 64, "(9,0) should be 25% coverage");
9982a307
AMH
62}
63
1c5252ed
TC
64{ # check horizontal edges are consistent
65 my $im = Imager->new(xsize => 10, ysize => 10);
66 ok($im->polygon(points => [ [ 0, 0.5 ], [ 0, 9.25 ],
67 [ 10, 9.25 ], [ 10, 0.5 ] ],
68 color => $white,
69 aa => 1),
70 "draw polygon with mid-pixel horizontal edges");
71 is_deeply([ $im->getsamples(y => 0, channels => [ 0 ]) ],
72 [ (128) x 10 ],
73 "all of line 0 should be 50% coverage");
74 is_deeply([ $im->getsamples(y => 9, channels => [ 0 ]) ],
75 [ (64) x 10 ],
76 "all of line 9 should be 25% coverage");
77}
9982a307 78
1c5252ed
TC
79{
80 my $img = Imager->new(xsize=>20, ysize=>10);
81 my @data = translate(5.5,5,
82 rotate(0,
83 scale(5, 5,
84 get_polygon(n_gon => 5)
85 )
86 )
87 );
88
89
90 my ($x, $y) = array_to_refpair(@data);
91 ok(Imager::i_poly_aa($img->{IMG}, $x, $y, $white), "primitive poly");
9982a307 92
1c5252ed
TC
93 ok($img->write(file=>"testout/t75.ppm"), "write to file")
94 or diag $img->errstr;
d0e7bfee 95
1c5252ed
TC
96 my $zoom = make_zoom($img, 8, \@data, $red);
97 ok($zoom, "make zoom of primitive");
98 $zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr;
99}
d0e7bfee 100
1c5252ed
TC
101{
102 my $img = Imager->new(xsize=>300, ysize=>100);
103
104 my $good = 1;
105 for my $n (0..55) {
106 my @data = translate(20+20*($n%14),18+20*int($n/14),
107 rotate(15*$n/PI,
108 scale(15, 15,
109 get_polygon('box')
110 )
111 )
112 );
113 my ($x, $y) = array_to_refpair(@data);
114 Imager::i_poly_aa($img->{IMG}, $x, $y, NC(rand(255), rand(255), rand(255)))
115 or $good = 0;
116 }
117
118 $img->write(file=>"testout/t75big.ppm") or die $img->errstr;
d0e7bfee 119
1c5252ed
TC
120 ok($good, "primitive squares");
121}
fe24d684 122
1c5252ed
TC
123{
124 my $img = Imager->new(xsize => 300, ysize => 300);
125 ok($img -> polygon(color=>$white,
126 points => [
127 translate(150,150,
128 rotate(45*PI/180,
129 scale(70,70,
130 get_polygon('wavycircle', 32*8, sub { 1.2+1*cos(4*$_) }))))
131 ],
132 ), "method call")
133 or diag $img->errstr();
134
135 $img->write(file=>"testout/t75wave.ppm") or die $img->errstr;
136}
fe24d684 137
1c5252ed
TC
138{
139 my $img = Imager->new(xsize=>10,ysize=>6);
140 my @data = translate(165,5,
141 scale(80,80,
142 get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })));
143
144 ok($img -> polygon(color=>$white,
fe24d684
AMH
145 points => [
146 translate(165,5,
147 scale(80,80,
148 get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })))
149 ],
1c5252ed
TC
150 ), "bug check")
151 or diag $img->errstr();
fe24d684 152
1c5252ed 153 make_zoom($img,20,\@data, $blue)->write(file=>"testout/t75wavebug.ppm") or die $img->errstr;
fe24d684 154
1c5252ed 155}
fe24d684 156
1c5252ed
TC
157{
158 my $img = Imager->new(xsize=>300, ysize=>300);
159 ok($img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF', dx=>3 },
43c5dacb
TC
160 points => [
161 translate(150,150,
162 scale(70,70,
163 get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })))
164 ],
1c5252ed
TC
165 ), "poly filled with hatch")
166 or diag $img->errstr();
167 $img->write(file=>"testout/t75wave_fill.ppm") or die $img->errstr;
168}
43c5dacb 169
1c5252ed
TC
170{
171 my $img = Imager->new(xsize=>300, ysize=>300, bits=>16);
172 ok($img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF' },
43c5dacb
TC
173 points => [
174 translate(150,150,
175 scale(70,70,
176 get_polygon('wavycircle', 32*8, sub { 1+1*cos(5*$_) })))
177 ],
1c5252ed
TC
178 ), "hatched to 16-bit image")
179 or diag $img->errstr();
180 $img->write(file=>"testout/t75wave_fill16.ppm") or die $img->errstr;
181}
9982a307 182
1c5252ed 183Imager::malloc_state();
9982a307
AMH
184
185
1c5252ed
TC
186#initialized in a BEGIN, later
187my %primitives;
188my %polygens;
9982a307
AMH
189
190sub get_polygon {
191 my $name = shift;
192 if (exists $primitives{$name}) {
193 return @{$primitives{$name}};
194 }
195
196 if (exists $polygens{$name}) {
197 return $polygens{$name}->(@_);
198 }
199
200 die "polygon spec: $name unknown\n";
201}
202
203
204sub make_zoom {
205 my ($img, $sc, $polydata, $linecolor) = @_;
206
207 # scale with nearest neighboor sampling
208 my $timg = $img->scale(scalefactor=>$sc, qtype=>'preview');
209
210 # draw the grid
1c5252ed 211 for(my $lx=0; $lx<$timg->getwidth(); $lx+=$sc) {
9982a307
AMH
212 $timg->line(color=>$green, x1=>$lx, x2=>$lx, y1=>0, y2=>$timg->getheight(), antialias=>0);
213 }
214
1c5252ed 215 for(my $ly=0; $ly<$timg->getheight(); $ly+=$sc) {
9982a307
AMH
216 $timg->line(color=>$green, y1=>$ly, y2=>$ly, x1=>0, x2=>$timg->getwidth(), antialias=>0);
217 }
218 my @data = scale($sc, $sc, @$polydata);
219 push(@data, $data[0]);
220 my ($x, $y) = array_to_refpair(@data);
221
222 $timg->polyline(color=>$linecolor, 'x'=>$x, 'y'=>$y, antialias=>0);
223 return $timg;
224}
225
226# utility functions to manipulate point data
227
228sub scale {
229 my ($x, $y, @data) = @_;
230 return map { [ $_->[0]*$x , $_->[1]*$y ] } @data;
231}
232
233sub translate {
234 my ($x, $y, @data) = @_;
235 map { [ $_->[0]+$x , $_->[1]+$y ] } @data;
236}
237
238sub rotate {
239 my ($rad, @data) = @_;
240 map { [ $_->[0]*cos($rad)+$_->[1]*sin($rad) , $_->[1]*cos($rad)-$_->[0]*sin($rad) ] } @data;
241}
242
243sub array_to_refpair {
244 my (@x, @y);
245 for (@_) {
246 push(@x, $_->[0]);
247 push(@y, $_->[1]);
248 }
249 return \@x, \@y;
250}
251
252
253
254BEGIN {
255%primitives = (
256 box => [ [-0.5,-0.5], [0.5,-0.5], [0.5,0.5], [-0.5,0.5] ],
257 triangle => [ [0,0], [1,0], [1,1] ],
258 );
02d1d628 259
9982a307
AMH
260%polygens = (
261 wavycircle => sub {
262 my $numv = shift;
263 my $radfunc = shift;
264 my @radians = map { $_*2*PI/$numv } 0..$numv-1;
265 my @radius = map { $radfunc->($_) } @radians;
266 map {
d0e7bfee 267 [ $radius[$_] * cos($radians[$_]), $radius[$_] * sin($radians[$_]) ]
9982a307
AMH
268 } 0..$#radians;
269 },
270 n_gon => sub {
271 my $N = shift;
272 map {
273 [ cos($_*2*PI/$N), sin($_*2*PI/$N) ]
274 } 0..$N-1;
275 },
276);
277}