t/t75polyaa.t

   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
   9 BEGIN { $| = 1; print "1..9\n"; }
  10 END {print "not ok 1\n" unless $loaded;}
  11 use Imager qw(:all);
  12
  13 sub PI () { 3.14159265358979323846 }
  14
  15 $loaded = 1;
  16 print "ok 1\n";
  17
  18 init_log("testout/t75aapolyaa.log",1);
  19
  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);
  24
  25
  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                  );
  34
  35
  36 my ($x, $y) = array_to_refpair(@data);
  37 i_poly_aa($img->{IMG}, $x, $y, $white);
  38
  39
  40
  41
  42 print "ok 2\n";
  43
  44 $img->write(file=>"testout/t75.ppm") or die $img->errstr;
  45 print "ok 3\n";
  46
  47
  48 $zoom = make_zoom($img, 8, \@data, $red);
  49 $zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr;
  50
  51 print "ok 4\n";
  52
  53 $img = Imager->new(xsize=>300, ysize=>100);
  54
  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
  67 $img->write(file=>"testout/t75big.ppm") or die $img->errstr;
  68
  69 print "ok 5\n";
  70
  71 $img = Imager->new(xsize => 300, ysize => 300);
  72 $img -> polygon(color=>$white,
  73                 points => [
  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*$_) }))))
  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
  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
 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";
 128
 129 malloc_state();
 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               );
 202
 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 {
 210                  [ $radius[$_] * cos($radians[$_]), $radius[$_] * sin($radians[$_]) ]
 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 }