From: Tony Cook <tony@develop-help.com>
Date: Sat, 18 Feb 2012 08:53:13 +0000 (+1100)
Subject: [rt #73697] re-work getpixel() and setpixel()
X-Git-Tag: v0.88~1
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/2a27eeffe848ccc741afab725dc8ee893527b7eb

[rt #73697] re-work getpixel() and setpixel()
---

diff --git a/Changes b/Changes
index 00d8a853..52081088 100644
--- a/Changes
+++ b/Changes
@@ -23,6 +23,11 @@ Imager release history.  Older releases can be found in Changes.old
    the perl level API anyway.  There were no changes to the C level
    interfaces to these functions.
 
+ - getpixel() and setpixel() now accept a mix of scalar and array
+   references for the x and y parameters, and unequal array lengths is
+   no longer an error.
+   https://rt.cpan.org/Ticket/Display.html?id=73697
+
 Bug fixes:
 
  - correctly calculate the size of a rotated image
@@ -43,6 +48,11 @@ Bug fixes:
    when it's meant to be an array reference.
    https://rt.cpan.org/Ticket/Display.html?id=74882
 
+ - getpixel() and setpixel() now returns an empty list when invalid
+   parameters are supplied.
+   Invalid values for type now result in an error for getpixel().
+   https://rt.cpan.org/Ticket/Display.html?id=73697
+
 Imager 0.87 - 03 Jan 2012
 ===========
 
diff --git a/Imager.pm b/Imager.pm
index 4b10bc0e..bbdfd48a 100644
--- a/Imager.pm
+++ b/Imager.pm
@@ -629,11 +629,13 @@ sub _combine {
 }
 
 sub _valid_image {
-  my ($self) = @_;
+  my ($self, $method) = @_;
 
   $self->{IMG} and return 1;
 
-  $self->_set_error('empty input image');
+  my $msg = 'empty input image';
+  $msg = "$method: $msg" if $method;
+  $self->_set_error($msg);
 
   return;
 }
@@ -3117,6 +3119,9 @@ sub flood_fill {
 sub setpixel {
   my ($self, %opts) = @_;
 
+  $self->_valid_image("setpixel")
+    or return;
+
   my $color = $opts{color};
   unless (defined $color) {
     $color = $self->{fg};
@@ -3124,36 +3129,53 @@ sub setpixel {
   }
 
   unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
-    $color = _color($color)
-      or return undef;
+    unless ($color = _color($color, 'setpixel')) {
+      $self->_set_error("setpixel: " . Imager->errstr);
+      return;
+    }
   }
 
   unless (exists $opts{'x'} && exists $opts{'y'}) {
-    $self->{ERRSTR} = 'missing x and y parameters';
-    return undef;
+    $self->_set_error('setpixel: missing x or y parameter');
+    return;
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
-  if (ref $x && ref $y) {
-    unless (@$x == @$y) {
-      $self->{ERRSTR} = 'length of x and y mismatch';
+  if (ref $x || ref $y) {
+    $x = ref $x ? $x : [ $x ];
+    $y = ref $y ? $y : [ $y ];
+    unless (@$x) {
+      $self->_set_error("setpixel: x is a reference to an empty array");
+      return;
+    }
+    unless (@$y) {
+      $self->_set_error("setpixel: y is a reference to an empty array");
       return;
     }
+
+    # make both the same length, replicating the last element
+    if (@$x < @$y) {
+      $x = [ @$x, ($x->[-1]) x (@$y - @$x) ];
+    }
+    elsif (@$y < @$x) {
+      $y = [ @$y, ($y->[-1]) x (@$x - @$y) ];
+    }
+
     my $set = 0;
     if ($color->isa('Imager::Color')) {
-      for my $i (0..$#{$opts{'x'}}) {
+      for my $i (0..$#$x) {
         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
 	  or ++$set;
       }
     }
     else {
-      for my $i (0..$#{$opts{'x'}}) {
+      for my $i (0..$#$x) {
         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
 	  or ++$set;
       }
     }
-    $set or return;
+
     return $set;
   }
   else {
@@ -3167,7 +3189,7 @@ sub setpixel {
     }
   }
 
-  $self;
+  return $self;
 }
 
 sub getpixel {
@@ -3175,41 +3197,66 @@ sub getpixel {
 
   my %opts = ( "type"=>'8bit', @_);
 
+  $self->_valid_image("getpixel")
+    or return;
+
   unless (exists $opts{'x'} && exists $opts{'y'}) {
-    $self->{ERRSTR} = 'missing x and y parameters';
-    return undef;
+    $self->_set_error('getpixel: missing x or y parameter');
+    return;
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
-  if (ref $x && ref $y) {
-    unless (@$x == @$y) {
-      $self->{ERRSTR} = 'length of x and y mismatch';
-      return undef;
+  my $type = $opts{'type'};
+  if (ref $x || ref $y) {
+    $x = ref $x ? $x : [ $x ];
+    $y = ref $y ? $y : [ $y ];
+    unless (@$x) {
+      $self->_set_error("getpixel: x is a reference to an empty array");
+      return;
+    }
+    unless (@$y) {
+      $self->_set_error("getpixel: y is a reference to an empty array");
+      return;
+    }
+
+    # make both the same length, replicating the last element
+    if (@$x < @$y) {
+      $x = [ @$x, ($x->[-1]) x (@$y - @$x) ];
     }
+    elsif (@$y < @$x) {
+      $y = [ @$y, ($y->[-1]) x (@$x - @$y) ];
+    }
+
     my @result;
-    if ($opts{"type"} eq '8bit') {
-      for my $i (0..$#{$opts{'x'}}) {
+    if ($type eq '8bit') {
+      for my $i (0..$#$x) {
         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
-    else {
-      for my $i (0..$#{$opts{'x'}}) {
+    elsif ($type eq 'float' || $type eq 'double') {
+      for my $i (0..$#$x) {
         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
+    else {
+      $self->_set_error("getpixel: type must be '8bit' or 'float'");
+      return;
+    }
     return wantarray ? @result : \@result;
   }
   else {
-    if ($opts{"type"} eq '8bit') {
+    if ($type eq '8bit') {
       return i_get_pixel($self->{IMG}, $x, $y);
     }
-    else {
+    elsif ($type eq 'float' || $type eq 'double') {
       return i_gpixf($self->{IMG}, $x, $y);
     }
+    else {
+      $self->_set_error("getpixel: type must be '8bit' or 'float'");
+      return;
+    }
   }
-
-  $self;
 }
 
 sub getscanline {
diff --git a/lib/Imager/Draw.pod b/lib/Imager/Draw.pod
index 5fbe72e6..4bf67734 100644
--- a/lib/Imager/Draw.pod
+++ b/lib/Imager/Draw.pod
@@ -487,6 +487,30 @@ supplied as a L</"Color Parameters">.
 
 setpixel() is used to set one or more individual pixels.
 
+You can supply a single set of co-ordinates as scalar C<x> and C<y>
+parameters, or set either to an arrayref of ordinates.
+
+If one array is shorter than another the final value in the shorter
+will be duplicated until they match in length.
+
+If only one of C<x> or C<y> is an array reference then setpixel() will
+behave as if the non-reference value were an array reference
+containing only that value.
+
+eg.
+
+  my $count = $img->setpixel(x => 1, y => [ 0 .. 3 ], color => $color);
+
+behaves like:
+
+  my $count = $img->setpixel(x => [ 1 ], y => [ 0 .. 3 ], color => $color);
+
+and since the final element in the shorter array is duplicated, this
+behaves like:
+
+  my $count = $img->setpixel(x => [ 1, 1, 1, 1 ], y => [ 0 .. 3 ],
+                             color => $color);
+
 Parameters:
 
 =over
@@ -503,25 +527,60 @@ Default: white.
 
 =back
 
-When called with array parameters, returns the number of pixels
-successfully set, or false if none.
+When called with an array reference in either C<x> or C<y>, returns
+the number of pixels successfully set, or false if none.
 
 When called with scalars for x and y, return $img on success, false on
 failure.
 
+Possible errors conditions include:
+
+=over
+
+=item * the image supplied is empty
+
+=item * a reference to an empty array was supplied for C<x> or C<y>
+
+=item * C<x> or C<y> wasn't supplied
+
+=item * C<color> isn't a valid color, and can't be converted to a
+color.
+
+=back
+
+On any of these errors, setpixel() returns an empty list and sets
+errstr().
+
 =item getpixel()
 
-  my $color = $img->getpixel(x=>50, y=>70);
-  my @colors = $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]);
-  my $colors_ref = $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]);
+  my $color = $img->getpixel(x=>50, y=>70); my @colors =
+  $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]); my $colors_ref =
+  $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]);
 
 getpixel() is used to retrieve one or more individual pixels.
 
-For either method you can supply a single set of co-ordinates as
-scalar x and y parameters, or set each to an arrayref of ordinates.
+You can supply a single set of co-ordinates as scalar C<x> and C<y>
+parameters, or set each to an arrayref of ordinates.
+
+If one array is shorter than another the final value in the shorter
+will be duplicated until they match in length.
+
+If only one of C<x> or C<y> is an array reference then getpixel() will
+behave as if the non-reference value were an array reference
+containing only that value.
+
+eg.
+
+  my @colors = $img->getpixel(x => 0, y => [ 0 .. 3 ]);
 
-When called with arrays, getpixel() will return a list of colors in
-list context, and an arrayref in scalar context.
+behaves like:
+
+  my @colors = $img->getpixel(x => [ 0 ], y => [ 0 .. 3 ]);
+
+and since the final element in the shorter array is duplicated, this
+behaves like:
+
+  my @colors = $img->getpixel(x => [ 0, 0, 0, 0 ], y => [ 0 .. 3 ]);
 
 To receive floating point colors from getpixel(), set the C<type>
 parameter to 'float'.
@@ -543,6 +602,29 @@ Default: C<'8bit'>.
 
 =back
 
+When called with an array reference for either or C<x> or C<y>,
+getpixel() will return a list of colors in list context, and an
+arrayref in scalar context.
+
+If a supplied co-ordinate is outside the image then C<undef> is
+returned for the pixel.
+
+Possible errors conditions include:
+
+=over
+
+=item * the image supplied is empty
+
+=item * a reference to an empty array was supplied for C<x> or C<y>
+
+=item * C<x> or C<y> wasn't supplied
+
+=item * C<type> isn't a valid value.
+
+=back
+
+For any of these errors getpixel() returns an empty list.
+
 =item string()
 
   my $font = Imager::Font->new(file=>"foo.ttf");
diff --git a/t/t01introvert.t b/t/t01introvert.t
index 2ba3d0d5..d63eb5db 100644
--- a/t/t01introvert.t
+++ b/t/t01introvert.t
@@ -3,11 +3,11 @@
 # to make sure we get expected values
 
 use strict;
-use Test::More tests => 345;
+use Test::More tests => 431;
 
 BEGIN { use_ok(Imager => qw(:handy :all)) }
 
-use Imager::Test qw(image_bounds_checks is_color3 is_color4 is_fcolor4 color_cmp mask_tests);
+use Imager::Test qw(image_bounds_checks is_color3 is_color4 is_fcolor4 color_cmp mask_tests is_fcolor3);
 
 -d "testout" or mkdir "testout";
 
@@ -855,6 +855,210 @@ my $psamp_outside_error = "Image position outside of image";
      "check error message");
 }
 
+{ # getpixel parameters
+  my $im = Imager->new(xsize => 10, ysize => 10);
+  $im->box(filled => 1, xmax => 4, color => NC(255, 0, 0));
+  $im->box(filled => 1, xmin => 5, ymax => 4, color => NC(0, 255, 255));
+  $im->box(filled => 1, xmin => 5, ymin => 5, color => NC(255, 0, 255));
+  { # error handling
+    my $empty = Imager->new;
+    ok(!$empty->getpixel(x => 0, y => 0), "getpixel empty image");
+    is($empty->errstr, "getpixel: empty input image", "check message");
+
+    ok(!$im->getpixel(y => 0), "missing x");
+    is($im->errstr, "getpixel: missing x or y parameter", "check message");
+
+    $im->_set_error("something different");
+    ok(!$im->getpixel(x => 0), "missing y");
+    is($im->errstr, "getpixel: missing x or y parameter", "check message");
+
+    ok(!$im->getpixel(x => [], y => 0), "empty x array ref");
+    is($im->errstr, "getpixel: x is a reference to an empty array",
+       "check message");
+
+    ok(!$im->getpixel(x => 0, y => []), "empty y array ref");
+    is($im->errstr, "getpixel: y is a reference to an empty array",
+       "check message");
+
+    ok(!$im->getpixel(x => 0, y => 0, type => "bad"), "bad type (scalar path)");
+    is($im->errstr, "getpixel: type must be '8bit' or 'float'",
+      "check message");
+
+    $im->_set_error("something different");
+    ok(!$im->getpixel(x => [ 0 ], y => [ 0 ], type => "bad"),
+       "bad type (array path)");
+    is($im->errstr, "getpixel: type must be '8bit' or 'float'",
+      "check message");
+  }
+
+  # simple calls
+  is_color3($im->getpixel(x => 1, y => 0), 255, 0, 0,
+	    "getpixel(1, 0)");
+  is_color3($im->getpixel(x => 8, y => 1), 0, 255, 255,
+	    "getpixel(8, 1)");
+  is_color3($im->getpixel(x => 8, y => 7), 255, 0, 255,
+	    "getpixel(8, 7)");
+
+  {
+    # simple arrayrefs
+    my @colors = $im->getpixel(x => [ 0, 8, 7 ], y => [ 0, 7, 3 ]);
+    is(@colors, 3, "getpixel 2 3 element array refs");
+    is_color3($colors[0], 255, 0, 0, "check first color");
+    is_color3($colors[1], 255, 0, 255, "check second color");
+    is_color3($colors[2], 0, 255, 255, "check third color");
+  }
+  
+  # array and scalar
+  {
+    my @colors = $im->getpixel(x => 5, y => [ 4, 5, 9 ]);
+    is(@colors, 3, "getpixel x scalar, y arrayref of 3");
+    is_color3($colors[0], 0, 255, 255, "check first color");
+    is_color3($colors[1], 255, 0, 255, "check second color");
+    is_color3($colors[2], 255, 0, 255, "check third color");
+  }
+
+  {
+    my @colors = $im->getpixel(x => [ 0, 4, 5 ], y => 2);
+    is(@colors, 3, "getpixel y scalar, x arrayref of 3");
+    is_color3($colors[0], 255, 0, 0, "check first color");
+    is_color3($colors[1], 255, 0, 0, "check second color");
+    is_color3($colors[2], 0, 255, 255, "check third color");
+  }
+
+  { # float
+    is_fcolor3($im->getpixel(x => 1, y => 0, type => 'float'),
+	       1.0, 0, 0, "getpixel(1,0) float");
+    is_fcolor3($im->getpixel(x => 8, y => 1, type => 'float'),
+	       0, 1.0, 1.0, "getpixel(8,1) float");
+    is_fcolor3($im->getpixel(x => 8, y => 7, type => 'float'),
+	       1.0, 0, 1.0, "getpixel(8,7) float");
+
+    my @colors = $im->getpixel(x => [ 0, 8, 7 ], y => [ 0, 7, 3 ], type => 'float');
+    is(@colors, 3, "getpixel 2 3 element array refs (float)");
+    is_fcolor3($colors[0], 1, 0, 0, "check first color");
+    is_fcolor3($colors[1], 1, 0, 1, "check second color");
+    is_fcolor3($colors[2], 0, 1, 1, "check third color");
+  }
+
+  { # out of bounds
+    my @colors = $im->getpixel(x => [ 0, -1, 5, 10 ], y => 0);
+    is(@colors, 4, "should be 4 entries")
+      or diag $im->errstr;
+    is_color3($colors[0], 255, 0, 0, "first red");
+    is($colors[1], undef, "second undef");
+    is_color3($colors[2], 0, 255, 255, "third cyan");
+    is($colors[3], undef, "fourth undef");
+  }
+
+  { # out of bounds
+    my @colors = $im->getpixel(x => [ 0, -1, 5, 10 ], y => 0, type => "float");
+    is(@colors, 4, "should be 4 entries")
+      or diag $im->errstr;
+    is_fcolor3($colors[0], 1.0, 0, 0, "first red");
+    is($colors[1], undef, "second undef");
+    is_fcolor3($colors[2], 0, 1.0, 1.0, "third cyan");
+    is($colors[3], undef, "fourth undef");
+  }
+}
+
+{ # setpixel
+  my $im = Imager->new(xsize => 10, ysize => 10);
+  { # errors
+    my $empty = Imager->new;
+    ok(!$empty->setpixel(x => 0, y => 0, color => $red),
+       "setpixel on empty image");
+    is($empty->errstr, "setpixel: empty input image", "check message");
+
+    ok(!$im->setpixel(y => 0, color => $red), "missing x");
+    is($im->errstr, "setpixel: missing x or y parameter", "check message");
+
+    $im->_set_error("something different");
+    ok(!$im->setpixel(x => 0, color => $red), "missing y");
+    is($im->errstr, "setpixel: missing x or y parameter", "check message");
+
+    ok(!$im->setpixel(x => [], y => 0, color => $red), "empty x array ref");
+    is($im->errstr, "setpixel: x is a reference to an empty array",
+       "check message");
+
+    ok(!$im->setpixel(x => 0, y => [], color => $red), "empty y array ref");
+    is($im->errstr, "setpixel: y is a reference to an empty array",
+       "check message");
+
+    ok(!$im->setpixel(x => 0, y => 0, color => "not really a color"),
+       "color not a color");
+    is($im->errstr, "setpixel: No color named not really a color found",
+       "check message");
+  }
+
+  # simple set
+  is($im->setpixel(x => 0, y => 0, color => $red), $im,
+     "simple setpixel")
+    or diag "simple set float: ", $im->errstr;
+  is_color3($im->getpixel(x => 0, y => 0), 255, 0, 0, "check stored pixel");
+
+  is($im->setpixel(x => 1, y => 2, color => $f_red), $im,
+     "simple setpixel (float)")
+    or diag "simple set float: ", $im->errstr;
+  is_color3($im->getpixel(x => 1, y => 2), 255, 0, 0, "check stored pixel");
+
+  is($im->setpixel(x => -1, y => 0, color => $red), undef,
+     "simple setpixel outside of image");
+  is($im->setpixel(x => 0, y => -1, color => $f_red), undef,
+     "simple setpixel (float) outside of image");
+
+  # simple arrayrefs
+  is($im->setpixel( x => [ 0, 8, 7 ], y => [ 0, 7, 3 ], color => $blue),
+     3, "setpixel with 3 element array refs");
+  my @colors = $im->getpixel(x => [ 8, 7, 0 ], y => [ 7, 3, 0 ]);
+  is_color3($colors[0], 0, 0, 255, "check first color");
+  is_color3($colors[1], 0, 0, 255, "check second color");
+  is_color3($colors[2], 0, 0, 255, "check third color");
+
+  # array and scalar
+  {
+    is($im->setpixel(x => 5, y => [ 4, 5, 9 ], color => $green), 3,
+       "setpixel with x scalar, y arrayref of 3");
+    my @colors = $im->getpixel(x => [ 5, 5, 5 ], y => [ 4, 5, 9 ]);
+    is_color3($colors[0], 0, 255, 0, "check first color");
+    is_color3($colors[1], 0, 255, 0, "check second color");
+    is_color3($colors[2], 0, 255, 0, "check third color");
+  }
+
+  {
+    is($im->setpixel(x => [ 0, 4, 5 ], y => 2, color => $blue), 3,
+       "setpixel with y scalar, x arrayref of 3");
+    my @colors = $im->getpixel(x => [ 0, 4, 5 ], y => [ 2, 2, 2 ]);
+    is_color3($colors[0], 0, 0, 255, "check first color");
+    is_color3($colors[1], 0, 0, 255, "check second color");
+    is_color3($colors[2], 0, 0, 255, "check third color");
+  }
+
+  {
+    is($im->setpixel(x => [ 0, -1, 10, 5, 0 ], y => [ 0, 1, 2, 3, 1 ], color => $blue), 3,
+       "set array with two bad locations")
+      or diag "set array bad locations: ", $im->errstr;
+    my @colors = $im->getpixel(x => [ 0, 5, 0 ], y => [ 0, 3, 1 ]);
+    is_color3($colors[0], 0, 0, 255, "check first color");
+    is_color3($colors[1], 0, 0, 255, "check second color");
+    is_color3($colors[2], 0, 0, 255, "check third color");
+  }
+  {
+    is($im->setpixel(x => [ 0, -1, 10, 5, 0 ], y => [ 0, 1, 2, 3, 1 ], color => $f_green), 3,
+       "set array with two bad locations (float)")
+      or diag "set array bad locations (float): ", $im->errstr;
+    my @colors = $im->getpixel(x => [ 0, 5, 0 ], y => [ 0, 3, 1 ]);
+    is_color3($colors[0], 0, 255, 0, "check first color");
+    is_color3($colors[1], 0, 255, 0, "check second color");
+    is_color3($colors[2], 0, 255, 0, "check third color");
+  }
+  { # default color
+    is($im->setpixel(x => 0, y => 9), $im, "setpixel() default color")
+      or diag "setpixel default color: ", $im->errstr;
+    is_color3($im->getpixel(x => 0, y => 9), 255, 255, 255,
+	      "check color set");
+  }
+}
+
 Imager->close_log();
 
 unless ($ENV{IMAGER_KEEP_FILES}) {