]>
Commit | Line | Data |
---|---|---|
02d1d628 AMH |
1 | # Before `make install' is performed this script should be runnable with |
2 | # `make test'. After `make install' it should work as `perl test.pl' | |
3 | ||
4 | ######################### We start with some black magic to print on failure. | |
5 | ||
6 | # Change 1..1 below to 1..last_test_to_print . | |
7 | # (It may become useful if the test is moved to ./t subdirectory.) | |
8 | ||
43c5dacb | 9 | BEGIN { $| = 1; print "1..9\n"; } |
02d1d628 AMH |
10 | END {print "not ok 1\n" unless $loaded;} |
11 | use Imager qw(:all); | |
12 | ||
9982a307 | 13 | sub PI () { 3.14159265358979323846 } |
02d1d628 | 14 | |
02d1d628 AMH |
15 | $loaded = 1; |
16 | print "ok 1\n"; | |
17 | ||
18 | init_log("testout/t75aapolyaa.log",1); | |
19 | ||
9982a307 AMH |
20 | $red = Imager::Color->new(255,0,0); |
21 | $green = Imager::Color->new(0,255,0); | |
22 | $blue = Imager::Color->new(0,0,255); | |
23 | $white = Imager::Color->new(255,255,255); | |
02d1d628 AMH |
24 | |
25 | ||
9982a307 AMH |
26 | $img = Imager->new(xsize=>20, ysize=>10); |
27 | @data = translate(5.5,5, | |
28 | rotate(0, | |
29 | scale(5, 5, | |
30 | get_polygon(n_gon => 5) | |
31 | ) | |
32 | ) | |
33 | ); | |
02d1d628 | 34 | |
02d1d628 | 35 | |
9982a307 AMH |
36 | my ($x, $y) = array_to_refpair(@data); |
37 | i_poly_aa($img->{IMG}, $x, $y, $white); | |
02d1d628 | 38 | |
02d1d628 | 39 | |
02d1d628 | 40 | |
02d1d628 | 41 | |
9982a307 | 42 | print "ok 2\n"; |
02d1d628 | 43 | |
9982a307 AMH |
44 | $img->write(file=>"testout/t75.ppm") or die $img->errstr; |
45 | print "ok 3\n"; | |
02d1d628 | 46 | |
02d1d628 | 47 | |
9982a307 AMH |
48 | $zoom = make_zoom($img, 8, \@data, $red); |
49 | $zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr; | |
02d1d628 | 50 | |
9982a307 | 51 | print "ok 4\n"; |
02d1d628 | 52 | |
9982a307 | 53 | $img = Imager->new(xsize=>300, ysize=>100); |
02d1d628 | 54 | |
9982a307 AMH |
55 | for $n (0..55) { |
56 | @data = translate(20+20*($n%14),18+20*int($n/14), | |
57 | rotate(15*$n/PI, | |
58 | scale(15, 15, | |
59 | get_polygon('box') | |
60 | ) | |
61 | ) | |
62 | ); | |
63 | my ($x, $y) = array_to_refpair(@data); | |
64 | i_poly_aa($img->{IMG}, $x, $y, NC(rand(255), rand(255), rand(255))); | |
65 | } | |
66 | ||
d0e7bfee | 67 | $img->write(file=>"testout/t75big.ppm") or die $img->errstr; |
9982a307 AMH |
68 | |
69 | print "ok 5\n"; | |
70 | ||
fe24d684 AMH |
71 | $img = Imager->new(xsize => 300, ysize => 300); |
72 | $img -> polygon(color=>$white, | |
d0e7bfee | 73 | points => [ |
fe24d684 AMH |
74 | translate(150,150, |
75 | rotate(45*PI/180, | |
76 | scale(70,70, | |
77 | get_polygon('wavycircle', 32*8, sub { 1.2+1*cos(4*$_) })))) | |
d0e7bfee AMH |
78 | ], |
79 | ) or die $img->errstr(); | |
80 | ||
81 | $img->write(file=>"testout/t75wave.ppm") or die $img->errstr; | |
82 | ||
83 | print "ok 6\n"; | |
84 | ||
fe24d684 AMH |
85 | |
86 | $img = Imager->new(xsize=>10,ysize=>6); | |
87 | @data = translate(165,5, | |
88 | scale(80,80, | |
89 | get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) }))); | |
90 | ||
91 | print "XXX\n"; | |
92 | $img -> polygon(color=>$white, | |
93 | points => [ | |
94 | translate(165,5, | |
95 | scale(80,80, | |
96 | get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) }))) | |
97 | ], | |
98 | ) or die $img->errstr(); | |
99 | ||
100 | make_zoom($img,20,\@data, $blue)->write(file=>"testout/t75wavebug.ppm") or die $img->errstr; | |
101 | ||
102 | ||
103 | print "ok 7\n"; | |
104 | ||
43c5dacb TC |
105 | $img = Imager->new(xsize=>300, ysize=>300); |
106 | $img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF', dx=>3 }, | |
107 | points => [ | |
108 | translate(150,150, | |
109 | scale(70,70, | |
110 | get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) }))) | |
111 | ], | |
112 | ) or die $img->errstr(); | |
113 | $img->write(file=>"testout/t75wave_fill.ppm") or die $img->errstr; | |
114 | ||
115 | print "ok 8\n"; | |
116 | ||
117 | $img = Imager->new(xsize=>300, ysize=>300, bits=>16); | |
118 | $img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF' }, | |
119 | points => [ | |
120 | translate(150,150, | |
121 | scale(70,70, | |
122 | get_polygon('wavycircle', 32*8, sub { 1+1*cos(5*$_) }))) | |
123 | ], | |
124 | ) or die $img->errstr(); | |
125 | $img->write(file=>"testout/t75wave_fill16.ppm") or die $img->errstr; | |
126 | ||
127 | print "ok 9\n"; | |
9982a307 | 128 | |
43c5dacb | 129 | malloc_state(); |
9982a307 AMH |
130 | |
131 | ||
132 | ||
133 | sub get_polygon { | |
134 | my $name = shift; | |
135 | if (exists $primitives{$name}) { | |
136 | return @{$primitives{$name}}; | |
137 | } | |
138 | ||
139 | if (exists $polygens{$name}) { | |
140 | return $polygens{$name}->(@_); | |
141 | } | |
142 | ||
143 | die "polygon spec: $name unknown\n"; | |
144 | } | |
145 | ||
146 | ||
147 | sub make_zoom { | |
148 | my ($img, $sc, $polydata, $linecolor) = @_; | |
149 | ||
150 | # scale with nearest neighboor sampling | |
151 | my $timg = $img->scale(scalefactor=>$sc, qtype=>'preview'); | |
152 | ||
153 | # draw the grid | |
154 | for($lx=0; $lx<$timg->getwidth(); $lx+=$sc) { | |
155 | $timg->line(color=>$green, x1=>$lx, x2=>$lx, y1=>0, y2=>$timg->getheight(), antialias=>0); | |
156 | } | |
157 | ||
158 | for($ly=0; $ly<$timg->getheight(); $ly+=$sc) { | |
159 | $timg->line(color=>$green, y1=>$ly, y2=>$ly, x1=>0, x2=>$timg->getwidth(), antialias=>0); | |
160 | } | |
161 | my @data = scale($sc, $sc, @$polydata); | |
162 | push(@data, $data[0]); | |
163 | my ($x, $y) = array_to_refpair(@data); | |
164 | ||
165 | $timg->polyline(color=>$linecolor, 'x'=>$x, 'y'=>$y, antialias=>0); | |
166 | return $timg; | |
167 | } | |
168 | ||
169 | # utility functions to manipulate point data | |
170 | ||
171 | sub scale { | |
172 | my ($x, $y, @data) = @_; | |
173 | return map { [ $_->[0]*$x , $_->[1]*$y ] } @data; | |
174 | } | |
175 | ||
176 | sub translate { | |
177 | my ($x, $y, @data) = @_; | |
178 | map { [ $_->[0]+$x , $_->[1]+$y ] } @data; | |
179 | } | |
180 | ||
181 | sub rotate { | |
182 | my ($rad, @data) = @_; | |
183 | map { [ $_->[0]*cos($rad)+$_->[1]*sin($rad) , $_->[1]*cos($rad)-$_->[0]*sin($rad) ] } @data; | |
184 | } | |
185 | ||
186 | sub array_to_refpair { | |
187 | my (@x, @y); | |
188 | for (@_) { | |
189 | push(@x, $_->[0]); | |
190 | push(@y, $_->[1]); | |
191 | } | |
192 | return \@x, \@y; | |
193 | } | |
194 | ||
195 | ||
196 | ||
197 | BEGIN { | |
198 | %primitives = ( | |
199 | box => [ [-0.5,-0.5], [0.5,-0.5], [0.5,0.5], [-0.5,0.5] ], | |
200 | triangle => [ [0,0], [1,0], [1,1] ], | |
201 | ); | |
02d1d628 | 202 | |
9982a307 AMH |
203 | %polygens = ( |
204 | wavycircle => sub { | |
205 | my $numv = shift; | |
206 | my $radfunc = shift; | |
207 | my @radians = map { $_*2*PI/$numv } 0..$numv-1; | |
208 | my @radius = map { $radfunc->($_) } @radians; | |
209 | map { | |
d0e7bfee | 210 | [ $radius[$_] * cos($radians[$_]), $radius[$_] * sin($radians[$_]) ] |
9982a307 AMH |
211 | } 0..$#radians; |
212 | }, | |
213 | n_gon => sub { | |
214 | my $N = shift; | |
215 | map { | |
216 | [ cos($_*2*PI/$N), sin($_*2*PI/$N) ] | |
217 | } 0..$N-1; | |
218 | }, | |
219 | ); | |
220 | } |