t/250-draw/010-draw.t

   1 #!perl -w
   2 use strict;
   3 use Test::More;
   4 use Imager ':all';
   5 use Imager::Test qw(is_color3 is_image);
   6 use constant PI => 3.14159265358979;
   7
   8 -d "testout" or mkdir "testout";
   9
  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
  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   # RT #128208
 142   my $im = Imager->new(xsize => 200, ysize => 200);
 143   ok($im->circle(aa => 1, color => "#FFF", r => 400, x => 1_000_000, y => 100, filled => 1),
 144      "draw a very large circle");
 145 }
 146
 147 {
 148   my $im = Imager->new(xsize => 400, ysize => 400);
 149   ok($im->arc(x => 200, y => 202, r => 10, filled => 0),
 150      "draw circle outline");
 151   is_color3($im->getpixel(x => 200, y => 202), 0, 0, 0,
 152             "check center not filled");
 153   ok($im->arc(x => 198, y => 200, r => 13, filled => 0, color => "#f88"),
 154      "draw circle outline");
 155   is_color3($im->getpixel(x => 198, y => 200), 0, 0, 0,
 156             "check center not filled");
 157   ok($im->arc(x => 200, y => 200, r => 24, filled => 0, color => "#0ff"),
 158      "draw circle outline");
 159   my $r = 40;
 160   while ($r < 180) {
 161     ok($im->arc(x => 200, y => 200, r => $r, filled => 0, color => "#ff0"),
 162        "draw circle outline r $r");
 163     $r += 15;
 164   }
 165   ok($im->write(file => "testout/t21circout.ppm"),
 166      "save arc outline");
 167 }
 168
 169 {
 170   my $im = Imager->new(xsize => 400, ysize => 400);
 171   {
 172     my $lc = Imager::Color->new(32, 32, 32);
 173     my $an = 0;
 174     while ($an < 360) {
 175       my $an_r = $an * PI / 180;
 176       my $ca = cos($an_r);
 177       my $sa = sin($an_r);
 178       $im->line(aa => 1, color => $lc,
 179                 x1 => 198 + 5 * $ca, y1 => 202 + 5 * $sa,
 180                 x2 => 198 + 190 * $ca, y2 => 202 + 190 * $sa);
 181       $an += 5;
 182     }
 183   }
 184   my $d1 = 0;
 185   my $r = 20;
 186   while ($d1 < 350) {
 187     ok($im->arc(x => 198, y => 202, r => $r, d1 => $d1, d2 => $d1+300, filled => 0),
 188        "draw arc outline r$r d1$d1 len 300");
 189     ok($im->arc(x => 198, y => 202, r => $r+3, d1 => $d1, d2 => $d1+40, filled => 0, color => '#FFFF00'),
 190        "draw arc outline r$r d1$d1 len 40");
 191     $d1 += 15;
 192     $r += 6;
 193   }
 194   is_color3($im->getpixel(x => 198, y => 202), 0, 0, 0,
 195             "check center not filled");
 196   ok($im->write(file => "testout/t21arcout.ppm"),
 197      "save arc outline")
 198     or diag "failed writing testout/t21arcout.ppm: ".$im->errstr;
 199 }
 200
 201 {
 202   my $im = Imager->new(xsize => 400, ysize => 400);
 203   ok($im->arc(x => 197, y => 201, r => 10, filled => 0, aa => 1, color => 'white'),
 204      "draw circle outline");
 205   is_color3($im->getpixel(x => 197, y => 201), 0, 0, 0,
 206             "check center not filled");
 207   ok($im->arc(x => 197, y => 205, r => 13, filled => 0, color => "#f88", aa => 1),
 208      "draw circle outline");
 209   is_color3($im->getpixel(x => 197, y => 205), 0, 0, 0,
 210             "check center not filled");
 211   ok($im->arc(x => 190, y => 215, r => 24, filled => 0, color => [0,0, 255, 128], aa => 1),
 212      "draw circle outline");
 213   my $r = 40;
 214   while ($r < 190) {
 215     ok($im->arc(x => 197, y => 201, r => $r, filled => 0, aa => 1, color => '#ff0'), "draw aa circle rad $r");
 216     $r += 7;
 217   }
 218   ok($im->write(file => "testout/t21aacircout.ppm"),
 219      "save arc outline");
 220 }
 221
 222 {
 223   my $im = Imager->new(xsize => 400, ysize => 400);
 224   {
 225     my $lc = Imager::Color->new(32, 32, 32);
 226     my $an = 0;
 227     while ($an < 360) {
 228       my $an_r = $an * PI / 180;
 229       my $ca = cos($an_r);
 230       my $sa = sin($an_r);
 231       $im->line(aa => 1, color => $lc,
 232                 x1 => 198 + 5 * $ca, y1 => 202 + 5 * $sa,
 233                 x2 => 198 + 190 * $ca, y2 => 202 + 190 * $sa);
 234       $an += 5;
 235     }
 236   }
 237   my $d1 = 0;
 238   my $r = 20;
 239   while ($d1 < 350) {
 240     ok($im->arc(x => 198, y => 202, r => $r, d1 => $d1, d2 => $d1+300, filled => 0, aa => 1),
 241        "draw aa arc outline r$r d1$d1 len 300");
 242     ok($im->arc(x => 198, y => 202, r => $r+3, d1 => $d1, d2 => $d1+40, filled => 0, color => '#FFFF00', aa => 1),
 243        "draw aa arc outline r$r d1$d1 len 40");
 244     $d1 += 15;
 245     $r += 6;
 246   }
 247   is_color3($im->getpixel(x => 198, y => 202), 0, 0, 0,
 248             "check center not filled");
 249   ok($im->write(file => "testout/t21aaarcout.ppm"),
 250      "save arc outline")
 251     or diag "Failed writing testout/t21aaarcout.ppm: " . $im->errstr;
 252 }
 253
 254 {
 255   my $im = Imager->new(xsize => 400, ysize => 400);
 256
 257   my $an = 0;
 258   my $step = 15;
 259   while ($an <= 360-$step) {
 260     my $cx = int(200 + 20 * cos(($an+$step/2) * PI / 180));
 261     my $cy = int(200 + 20 * sin(($an+$step/2) * PI / 180));
 262
 263     ok($im->arc(x => $cx, y => $cy, aa => 1, color => "#fff",
 264                 d1 => $an, d2 => $an+$step, filled => 0, r => 170),
 265       "angle starting from $an");
 266     ok($im->arc(x => $cx+0.5, y => $cy+0.5, aa => 1, color => "#ff0",
 267                 d1 => $an, d2 => $an+$step, r => 168),
 268       "filled angle starting from $an");
 269
 270     $an += $step;
 271   }
 272   ok($im->write(file => "testout/t21aaarcs.ppm"),
 273      "save arc outline")
 274     or diag "failed writing testout/t21aaarcs.ppm: ".$im->errstr;
 275 }
 276
 277 {
 278   # we document that drawing from d1 to d2 where d2 > d1 will draw an
 279   # arc going through 360 degrees, test that
 280   my $im = Imager->new(xsize => 200, ysize => 200);
 281   ok($im->arc(x => 100, y => 100, aa => 0, filled => 0, color => '#fff',
 282               d1 => 270, d2 => 90, r => 90), "draw non-aa arc through 0");
 283   ok($im->arc(x => 100, y => 100, aa => 1, filled => 0, color => '#fff',
 284               d1 => 270, d2 => 90, r => 80), "draw aa arc through 0");
 285   ok($im->write(file => "testout/t21arc0.ppm"),
 286      "save arc through 0")
 287     or diag "Failed writing testout/t21arc0.ppm: ".$im->errstr;
 288 }
 289
 290 {
 291   # test drawing color defaults
 292   {
 293     my $im = Imager->new(xsize => 10, ysize => 10);
 294     ok($im->box(), "default outline the image"); # should outline the image
 295     is_color3($im->getpixel(x => 0, y => 0), 255, 255, 255,
 296               "check outline default color TL");
 297     is_color3($im->getpixel(x => 9, y => 5), 255, 255, 255,
 298               "check outline default color MR");
 299   }
 300
 301   {
 302     my $im = Imager->new(xsize => 10, ysize => 10);
 303     ok($im->box(filled => 1), "default fill the image"); # should fill the image
 304     is_color3($im->getpixel(x => 0, y => 0), 255, 255, 255,
 305               "check fill default color TL");
 306     is_color3($im->getpixel(x => 5, y => 5), 255, 255, 255,
 307               "check fill default color MM");
 308   }
 309 }
 310
 311 {
 312   my $empty = Imager->new;
 313   ok(!$empty->box(), "can't draw box to empty image");
 314   is($empty->errstr, "box: empty input image", "check error message");
 315   ok(!$empty->arc(), "can't draw arc to empty image");
 316   is($empty->errstr, "arc: empty input image", "check error message");
 317   ok(!$empty->line(x1 => 0, y1 => 0, x2 => 10, y2 => 0),
 318      "can't draw line to empty image");
 319   is($empty->errstr, "line: empty input image", "check error message");
 320   ok(!$empty->polyline(points => [ [ 0, 0 ], [ 10, 0 ] ]),
 321      "can't draw polyline to empty image");
 322   is($empty->errstr, "polyline: empty input image", "check error message");
 323   ok(!$empty->polygon(points => [ [ 0, 0 ], [ 10, 0 ], [ 0, 10 ] ]),
 324      "can't draw polygon to empty image");
 325   is($empty->errstr, "polygon: empty input image", "check error message");
 326   ok(!$empty->flood_fill(x => 0, y => 0), "can't flood fill to empty image");
 327   is($empty->errstr, "flood_fill: empty input image", "check error message");
 328 }
 329
 330 done_testing();
 331
 332 malloc_state();
 333
 334 unless ($ENV{IMAGER_KEEP_FILES}) {
 335   unlink "testout/t21draw.ppm";
 336   unlink "testout/t21circout.ppm";
 337   unlink "testout/t21aacircout.ppm";
 338   unlink "testout/t21arcout.ppm";
 339   unlink "testout/t21aaarcout.ppm";
 340   unlink "testout/t21aaarcs.ppm";
 341   unlink "testout/t21arc0.ppm";
 342 }
 343
 344 sub color_cmp {
 345   my ($l, $r) = @_;
 346   my @l = $l->rgba;
 347   my @r = $r->rgba;
 348   # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
 349   return $l[0] <=> $r[0]
 350     || $l[1] <=> $r[1]
 351       || $l[2] <=> $r[2];
 352 }
 353
 354 sub angle_marker {
 355   my ($img, $x, $y, $radius, @angles) = @_;
 356
 357   for my $angle (@angles) {
 358     my $x1 = int($x + $radius * cos($angle * PI / 180) + 0.5);
 359     my $y1 = int($y + $radius * sin($angle * PI / 180) + 0.5);
 360     my $x2 = int($x + (5+$radius) * cos($angle * PI / 180) + 0.5);
 361     my $y2 = int($y + (5+$radius) * sin($angle * PI / 180) + 0.5);
 362
 363     $img->line(x1=>$x1, y1=>$y1, x2=>$x2, y2=>$y2, color=>'#FFF');
 364   }
 365 }