added getpixel()/setpixel() methods

diff --git a/Changes b/Changes
index 59668511d2c0904fe41898fcb071a448633bba47..5451e8df2b583f498804759ebf3ec18e0d52675e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -597,6 +597,7 @@ Revision history for Perl extension Imager.
        - Added lib/Imager/ImageTypes.pod, draft of ImageType pod.
        - Added lib/Imager/Filters.pod, draft of Filters pod.
        - Added lib/Imager/Engines.pod, draft of Engines pod.
+        - added getpixel() and setpixel() methods
 
 
 =================================================================

diff --git a/Imager.pm b/Imager.pm
index 2f7028b3e815be2ba392bf734e8a097029a2415c..843dff77beff88d298f84f21cb4fe2a8cc04f7d3 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -2029,6 +2029,90 @@ sub flood_fill {
   $self;
 }
 
+sub setpixel {
+  my $self = shift;
+
+  my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
+
+  unless (exists $opts{'x'} && exists $opts{'y'}) {
+    $self->{ERRSTR} = 'missing x and y parameters';
+    return undef;
+  }
+
+  my $x = $opts{'x'};
+  my $y = $opts{'y'};
+  my $color = _color($opts{color})
+    or return undef;
+  if (ref $x && ref $y) {
+    unless (@$x == @$y) {
+      $self->{ERRSTR} = 'length of x and y mistmatch';
+      return undef;
+    }
+    if ($color->isa('Imager::Color')) {
+      for my $i (0..$#{$opts{'x'}}) {
+        i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
+      }
+    }
+    else {
+      for my $i (0..$#{$opts{'x'}}) {
+        i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
+      }
+    }
+  }
+  else {
+    if ($color->isa('Imager::Color')) {
+      i_ppix($self->{IMG}, $x, $y, $color);
+    }
+    else {
+      i_ppixf($self->{IMG}, $x, $y, $color);
+    }
+  }
+
+  $self;
+}
+
+sub getpixel {
+  my $self = shift;
+
+  my %opts = ( type=>'8bit', @_);
+
+  unless (exists $opts{'x'} && exists $opts{'y'}) {
+    $self->{ERRSTR} = 'missing x and y parameters';
+    return undef;
+  }
+
+  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 @result;
+    if ($opts{type} eq '8bit') {
+      for my $i (0..$#{$opts{'x'}}) {
+        push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
+      }
+    }
+    else {
+      for my $i (0..$#{$opts{'x'}}) {
+        push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
+      }
+    }
+    return wantarray ? @result : \@result;
+  }
+  else {
+    if ($opts{type} eq '8bit') {
+      return i_get_pixel($self->{IMG}, $x, $y);
+    }
+    else {
+      return i_gpixf($self->{IMG}, $x, $y);
+    }
+  }
+
+  $self;
+}
+
 # make an identity matrix of the given size
 sub _identity {
   my ($size) = @_;

diff --git a/lib/Imager/Draw.pod b/lib/Imager/Draw.pod
index 60afb6240013a94de88ac5f936b57f2c47464f65..ec0d8d5cc8ef3d6e83696dfb8c1df8764646519c 100644 (file)
--- a/lib/Imager/Draw.pod
+++ b/lib/Imager/Draw.pod
@@ -34,6 +34,14 @@ Imager::Draw - Draw primitives to images
   
   $img->flood_fill(x=>50, y=>50, color=>$color);
 
+  $img->setpixel(x=>50, y=>70, color=>$color);
+
+  $img->setpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40], color=>$color);
+
+  my $color = $img->getpixel(x=>50, y=>70);
+
+  my @colors = $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]);
+
 =head1 DESCRIPTION
 
 It is possible to draw with graphics primitives onto images.  Such
@@ -153,6 +161,24 @@ flood_fill() method, for example:
 
 will fill all regions the same color connected to the point (50, 50).
 
+=item setpixel and getpixel
+
+  $img->setpixel(x=>50, y=>70, color=>$color);
+  $img->setpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40], color=>$color);
+  my $color = $img->getpixel(x=>50, y=>70);
+  my @colors = $img->getpixel(x=>[ 50, 60, 70 ], y=>[20, 30, 40]);
+
+setpixel() is used to set one or more individual pixels, and
+getpixel() to retrieve the same.
+
+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.
+
+When called with arrays, getpixel() will return a list of colors in
+list context, and an arrayref in scalar context.
+
+To receive floating point colors from getpixel, set the C<type>
+parameter to 'float'.
 
 =head1 BUGS
 

diff --git a/t/t21draw.t b/t/t21draw.t
index 7483f93880d27fb84edde40c0e915e5e4f23e1f6..46db0c8c1b200759f0fa2a1d9fbf2aab37724ac9 100644 (file)
--- a/t/t21draw.t
+++ b/t/t21draw.t
@@ -8,7 +8,7 @@
 use strict;
 my $loaded;
 
-BEGIN { $| = 1; print "1..17\n"; }
+BEGIN { $| = 1; print "1..29\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Imager qw/:all/;
 $loaded = 1;
@@ -71,6 +71,33 @@ ok($img->polyline(x=>[ 55, 80, 85 ], 'y'=>[65, 70, 95], color=>$green,
                   antialias=>1),
    "polyline xy with color antialias");
 
+ok($img->setpixel(x=>[35, 37, 39], 'y'=>[55, 57, 59], color=>$red),
+   "set array of pixels");
+ok($img->setpixel(x=>39, 'y'=>55, color=>$green),
+   "set single pixel");
+use Imager::Color::Float;
+my $flred = Imager::Color::Float->new(1, 0, 0, 0);
+my $flgreen = Imager::Color::Float->new(0, 1, 0, 0);
+ok($img->setpixel(x=>[41, 43, 45], 'y'=>[55, 57, 59], color=>$flred),
+   "set array of float pixels");
+ok($img->setpixel(x=>45, 'y'=>55, color=>$flgreen),
+   "set single float pixel");
+my @gp = $img->getpixel(x=>[41, 43, 45], 'y'=>[55, 57, 59]);
+ok(grep($_->isa('Imager::Color'), @gp) == 3, "check getpixel result type");
+ok(grep(color_cmp($_, NC(255, 0, 0)) == 0, @gp) == 3, 
+   "check getpixel result colors");
+my $gp = $img->getpixel(x=>45, 'y'=>55);
+ok($gp->isa('Imager::Color'), "check scalar getpixel type");
+ok(color_cmp($gp, NC(0, 255, 0)) == 0, "check scalar getpixel color");
+@gp = $img->getpixel(x=>[35, 37, 39], 'y'=>[55, 57, 59], type=>'float');
+ok(grep($_->isa('Imager::Color::Float'), @gp) == 3, 
+   "check getpixel float result type");
+ok(grep(color_cmp($_, $flred) == 0, @gp) == 3,
+   "check getpixel float result type");
+$gp = $img->getpixel(x=>39, 'y'=>55, type=>'float');
+ok($gp->isa('Imager::Color::Float'), "check scalar float getpixel type");
+ok(color_cmp($gp, $flgreen) == 0, "check scalar float getpixel color");
+
 ok($img->write(file=>'testout/t21draw.ppm'),
    "saving output");