make color values smarter for the drawing functions

make the aa vs antialias naming more consistent
update the docs

diff --git a/Changes b/Changes
index a6017ab1cd7675b8feae6a9dea993a1a5adf8131..2792229b3eda97a3d3925b6a9a2d227baa831970 100644 (file)
--- a/Changes
+++ b/Changes
@@ -549,6 +549,7 @@ Revision history for Perl extension Imager.
 0.40  pre1
         - anti-aliased polygon fill
         - add general fill to polygon fill
 0.40  pre1
         - anti-aliased polygon fill
         - add general fill to polygon fill

+        - make color values smarter for the drawing functions

 
 =================================================================
 
 
 =================================================================
 

diff --git a/Imager.pm b/Imager.pm
index 461e33881ffb769423587b36d0525fa44cb539f3..d96f53f93a51c73bd5cc4e675f69700a7b77111c 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -445,6 +445,49 @@ sub _error_as_msg {
   return join(": ", map $_->[0], i_errors());
 }
 
   return join(": ", map $_->[0], i_errors());
 }
 

+# this function tries to DWIM for color parameters
+#  color objects are used as is
+#  simple scalars are simply treated as single parameters to Imager::Color->new
+#  hashrefs are treated as named argument lists to Imager::Color->new
+#  arrayrefs are treated as list arguments to Imager::Color->new iff any
+#    parameter is > 1
+#  other arrayrefs are treated as list arguments to Imager::Color::Float
+
+sub _color {
+  my $arg = shift;
+  my $result;
+
+  if (ref $arg) {
+    if (UNIVERSAL::isa($arg, "Imager::Color")
+        || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
+      $result = $arg;
+    }
+    else {
+      if ($arg =~ /^HASH\(/) {
+        $result = Imager::Color->new(%$arg);
+      }
+      elsif ($arg =~ /^ARRAY\(/) {
+        if (grep $_ > 1, @$arg) {
+          $result = Imager::Color->new(@$arg);
+        }
+        else {
+          $result = Imager::Color::Float->new(@$arg);
+        }
+      }
+      else {
+        $Imager::ERRSTR = "Not a color";
+      }
+    }
+  }
+  else {
+    # assume Imager::Color::new knows how to handle it
+    $result = Imager::Color->new($arg);
+  }
+
+  return $result;
+}
+
+

 #
 # Methods to be called on objects.
 #
 #
 # Methods to be called on objects.
 #


@@ -1681,8 +1724,13 @@ sub box {
   }
 
   if ($opts{filled}) { 
   }
 
   if ($opts{filled}) { 

+    my $color = _color($opts{'color'});
+    unless ($color) { 
+      $self->{ERRSTR} = $Imager::ERRSTR; 
+      return; 
+    }

     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},

-                 $opts{ymax},$opts{color}); 
+                 $opts{ymax}, $color); 

   }
   elsif ($opts{fill}) {
     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
   }
   elsif ($opts{fill}) {
     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {


@@ -1697,7 +1745,13 @@ sub box {
                 $opts{ymax},$opts{fill}{fill});
   }
   else { 
                 $opts{ymax},$opts{fill}{fill});
   }
   else { 

-    i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color});
+    my $color = _color($opts{'color'});
+    unless ($color) { 
+      $self->{ERRSTR} = $Imager::ERRSTR; 
+      return; 
+    }
+    i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
+          $color);

   }
   return $self;
 }
   }
   return $self;
 }


@@ -1726,15 +1780,26 @@ sub arc {
                 $opts{'d2'}, $opts{fill}{fill});
   }
   else {
                 $opts{'d2'}, $opts{fill}{fill});
   }
   else {

+    my $color = _color($opts{'color'});
+    unless ($color) { 
+      $self->{ERRSTR} = $Imager::ERRSTR; 
+      return; 
+    }

     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 

-                  $opts{'color'});
+                  $color);

     }
     else {
     }
     else {

-      #      i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'},$opts{'color'});
-      if ($opts{'d1'} <= $opts{'d2'}) { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'}); }
-      else                            { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},        361,$opts{'color'});
-                                       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},          0,$opts{'d2'},$opts{'color'}); }
+      if ($opts{'d1'} <= $opts{'d2'}) { 
+        i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+              $opts{'d1'}, $opts{'d2'}, $color); 
+      }
+      else {
+        i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+              $opts{'d1'}, 361,         $color);
+        i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+              0,           $opts{'d2'}, $color); 
+      }

     }
   }
 
     }
   }
 


@@ -1752,10 +1817,18 @@ sub line {
   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
 
   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
 

+  my $color = _color($opts{'color'});
+  unless ($color) { 
+    $self->{ERRSTR} = $Imager::ERRSTR; 
+    return; 
+  }
+  $opts{antialias} = $opts{aa} if defined $opts{aa};

   if ($opts{antialias}) {
   if ($opts{antialias}) {

-    i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+    i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, 
+              $color);

   } else {
   } else {

-    i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+    i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, 
+           $color);

   }
   return $self;
 }
   }
   return $self;
 }


@@ -1778,14 +1851,24 @@ sub polyline {
 
 #  print Dumper(\@points);
 
 
 #  print Dumper(\@points);
 

+  my $color = _color($opts{'color'});
+  unless ($color) { 
+    $self->{ERRSTR} = $Imager::ERRSTR; 
+    return; 
+  }
+  $opts{antialias} = $opts{aa} if defined $opts{aa};

   if ($opts{antialias}) {
     for $pt(@points) {
   if ($opts{antialias}) {
     for $pt(@points) {

-      if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+      if (defined($ls)) { 
+        i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+      }

       $ls=$pt;
     }
   } else {
     for $pt(@points) {
       $ls=$pt;
     }
   } else {
     for $pt(@points) {

-      if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+      if (defined($ls)) { 
+        i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+      }

       $ls=$pt;
     }
   }
       $ls=$pt;
     }
   }


@@ -1822,7 +1905,12 @@ sub polygon {
                     $opts{'fill'}{'fill'});
   }
   else {
                     $opts{'fill'}{'fill'});
   }
   else {

-    i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'color'});
+    my $color = _color($opts{'color'});
+    unless ($color) { 
+      $self->{ERRSTR} = $Imager::ERRSTR; 
+      return; 
+    }
+    i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);

   }
 
   return $self;
   }
 
   return $self;


@@ -1852,7 +1940,12 @@ sub polybezier {
     return;
   }
 
     return;
   }
 

-  i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
+  my $color = _color($opts{'color'});
+  unless ($color) { 
+    $self->{ERRSTR} = $Imager::ERRSTR; 
+    return; 
+  }
+  i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);

   return $self;
 }
 
   return $self;
 }
 


@@ -1877,7 +1970,12 @@ sub flood_fill {
     i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
   }
   else {
     i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
   }
   else {

-    i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{color});
+    my $color = _color($opts{'color'});
+    unless ($color) { 
+      $self->{ERRSTR} = $Imager::ERRSTR; 
+      return; 
+    }
+    i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);

   }
 
   $self;
   }
 
   $self;


@@ -2949,19 +3047,23 @@ radius of 20.
 
 Line:
   $img->line(color=>$green, x1=>10, x2=>100,
 
 Line:
   $img->line(color=>$green, x1=>10, x2=>100,

-                            y1=>20, y2=>50, antialias=>1 );
+                            y1=>20, y2=>50, aa=>1 );

 
 That draws an antialiased line from (10,100) to (20,50).
 
 
 That draws an antialiased line from (10,100) to (20,50).
 

+The I<antialias> parameter is still available for backwards compatibility.
+

 Polyline:
   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
 Polyline:
   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);

-  $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
+  $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], aa=>1);

 
 Polyline is used to draw multilple lines between a series of points.
 The point set can either be specified as an arrayref to an array of
 array references (where each such array represents a point).  The
 other way is to specify two array references.
 
 
 Polyline is used to draw multilple lines between a series of points.
 The point set can either be specified as an arrayref to an array of
 array references (where each such array represents a point).  The
 other way is to specify two array references.
 

+The I<antialias> parameter is still available for backwards compatibility.
+

 Polygon:
   $img->polygon(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
   $img->polygon(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2]);
 Polygon:
   $img->polygon(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
   $img->polygon(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2]);


@@ -2994,6 +3096,11 @@ Currently you can create opaque or transparent plain color fills,
 hatched fills, image based fills and fountain fills.  See
 L<Imager::Fill> for more information.
 
 hatched fills, image based fills and fountain fills.  See
 L<Imager::Fill> for more information.
 

+The C<color> parameter for any of the drawing methods can be an
+L<Imager::Color> object, a simple scalar that Imager::Color can
+understand, a hashref of parameters that Imager::Color->new
+understands, or an arrayref of red, green, blue values.
+

 =head2 Text rendering
 
 Text rendering is described in the Imager::Font manpage.
 =head2 Text rendering
 
 Text rendering is described in the Imager::Font manpage.

diff --git a/MANIFEST b/MANIFEST
index 3173b16caafece579b132d46037163fe7d92dad7..00d5343654f7607220cb3845f7d871acc64e8a5e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -89,6 +89,7 @@ t/t108tga.t
 t/t15color.t
 t/t16matrix.t           Tests Imager::Matrix2d
 t/t20fill.t             Tests fills
 t/t15color.t
 t/t16matrix.t           Tests Imager::Matrix2d
 t/t20fill.t             Tests fills

+t/t21draw.t             Basic drawing tests

 t/t30t1font.t
 t/t35ttfont.t
 t/t36oofont.t
 t/t30t1font.t
 t/t35ttfont.t
 t/t36oofont.t

diff --git a/lib/Imager/Fill.pm b/lib/Imager/Fill.pm
index dc50c590bad7f2059069d43ba3326309b8203585..f13e32ad947e3be1273112f7aee58d8d6c3af3c0 100644 (file)
--- a/lib/Imager/Fill.pm
+++ b/lib/Imager/Fill.pm
@@ -19,47 +19,7 @@ $combine_types{mult} = $combine_types{multiply};
 $combine_types{'sub'}  = $combine_types{subtract};
 $combine_types{sat}  = $combine_types{saturation};
 
 $combine_types{'sub'}  = $combine_types{subtract};
 $combine_types{sat}  = $combine_types{saturation};
 

-# this function tries to DWIM for color parameters
-#  color objects are used as is
-#  simple scalars are simply treated as single parameters to Imager::Color->new
-#  hashrefs are treated as named argument lists to Imager::Color->new
-#  arrayrefs are treated as list arguments to Imager::Color->new iff any
-#    parameter is > 1
-#  other arrayrefs are treated as list arguments to Imager::Color::Float
-
-sub _color {
-  my $arg = shift;
-  my $result;
-
-  if (ref $arg) {
-    if (UNIVERSAL::isa($arg, "Imager::Color")
-        || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
-      $result = $arg;
-    }
-    else {
-      if ($arg =~ /^HASH\(/) {
-        $result = Imager::Color->new(%$arg);
-      }
-      elsif ($arg =~ /^ARRAY\(/) {
-        if (grep $_ > 1, @$arg) {
-          $result = Imager::Color->new(@$arg);
-        }
-        else {
-          $result = Imager::Color::Float->new(@$arg);
-        }
-      }
-      else {
-        $Imager::ERRSTR = "Not a color";
-      }
-    }
-  }
-  else {
-    # assume Imager::Color::new knows how to handle it
-    $result = Imager::Color->new($arg);
-  }
-
-  return $result;
-}
+*_color = \&Imager::_color;

 
 sub new {
   my ($class, %hsh) = @_;
 
 sub new {
   my ($class, %hsh) = @_;

diff --git a/t/t21draw.t b/t/t21draw.t
new file mode 100644 (file)
index 0000000..7483f93
--- /dev/null
+++ b/t/t21draw.t
@@ -0,0 +1,98 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+use strict;
+my $loaded;
+
+BEGIN { $| = 1; print "1..17\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Imager qw/:all/;
+$loaded = 1;
+print "ok 1\n";
+
+init_log("testout/t21draw.log",1);
+
+my $redobj = NC(255, 0, 0);
+my $red = 'FF0000';
+my $greenobj = NC(0, 255, 0);
+my $green = [ 0, 255, 0 ];
+my $blueobj = NC(0, 0, 255);
+my $blue = { hue=>240, saturation=>1, value=>1 };
+my $white = '#FFFFFF';
+
+my $testnum = 2;
+
+my $img = Imager->new(xsize=>100, ysize=>100);
+
+ok($img->box(color=>$blueobj, xmin=>10, ymin=>10, xmax=>48, ymax=>18),
+   "box with color obj");
+ok($img->box(color=>$blue, xmin=>10, ymin=>20, xmax=>48, ymax=>28),
+   "box with color");
+ok($img->box(color=>$redobj, xmin=>10, ymin=>30, xmax=>28, ymax=>48, filled=>1),
+   "filled box with color obj");
+ok($img->box(color=>$red, xmin=>30, ymin=>30, xmax=>48, ymax=>48, filled=>1),
+   "filled box with color");
+
+ok($img->arc(x=>75, 'y'=>25, r=>24, color=>$redobj),
+   "filled arc with colorobj");
+
+ok($img->arc(x=>75, 'y'=>25, r=>20, color=>$green),
+   "filled arc with colorobj");
+ok($img->arc(x=>75, 'y'=>25, r=>18, color=>$white, d1=>325, d2=>225),
+   "filled arc with color");
+
+ok($img->arc(x=>75, 'y'=>25, r=>18, color=>$blue, d1=>225, d2=>325),
+   "filled arc with color");
+ok($img->arc(x=>75, 'y'=>25, r=>15, color=>$green, aa=>1),
+   "filled arc with color");
+
+ok($img->line(color=>$blueobj, x1=>5, y1=>55, x2=>35, y2=>95),
+   "line with colorobj");
+
+# FIXME - neither the start nor end-point is set for a non-aa line
+#my $c = Imager::i_get_pixel($img->{IMG}, 5, 55);
+#ok(color_cmp($c, $blueobj) == 0, "# TODO start point not set");
+
+ok($img->line(color=>$red, x1=>10, y1=>55, x2=>40, y2=>95, aa=>1),
+   "aa line with color");
+ok($img->line(color=>$green, x1=>15, y1=>55, x2=>45, y2=>95, antialias=>1),
+   "antialias line with color");
+
+ok($img->polyline(points=>[ [ 55, 55 ], [ 90, 60 ], [ 95, 95] ],
+                  color=>$redobj),
+   "polyline points with color obj");
+ok($img->polyline(x=>[ 55, 85, 90 ], 'y'=>[60, 65, 95], color=>$green, aa=>1),
+   "polyline xy with color aa");
+ok($img->polyline(x=>[ 55, 80, 85 ], 'y'=>[65, 70, 95], color=>$green, 
+                  antialias=>1),
+   "polyline xy with color antialias");
+
+ok($img->write(file=>'testout/t21draw.ppm'),
+   "saving output");
+
+malloc_state();
+
+sub ok {
+  my ($ok, $msg) = @_;
+
+  if ($ok) {
+    print "ok ",$testnum++,"\n";
+  }
+  else {
+    print "not ok ",$testnum++," # $msg\n";
+  }
+}
+
+sub color_cmp {
+  my ($l, $r) = @_;
+  my @l = $l->rgba;
+  my @r = $r->rgba;
+  # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
+  return $l[0] <=> $r[0]
+    || $l[1] <=> $r[1]
+      || $l[2] <=> $r[2];
+}