- add samples/replace_color.pl

diff --git a/Changes b/Changes
index d0f17259ab339ad8bb3ade38bfd027593afa1484..8f29408638fb2ae400b7ae6044b7d2c9b08c4861 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1147,6 +1147,7 @@ Revision history for Perl extension Imager.
   generated by i_tt_new().
 - renamed lib/Imager/Cookbook.pm to lib/Imager/Cookbook.pod - CPANTS
   complains about it not having 'use strict;'
   generated by i_tt_new().
 - renamed lib/Imager/Cookbook.pm to lib/Imager/Cookbook.pod - CPANTS
   complains about it not having 'use strict;'

+- add samples/replace_color.pl

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

diff --git a/MANIFEST b/MANIFEST
index bbc6d08c8fd99ebc37675130f1feaf689b2c2bbd..ab3a70cacf02cd75a4f694d40b0250e3c60302cb 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -87,6 +87,7 @@ lib/Imager/Transformations.pod
 lib/Imager/Tutorial.pod
 lib/Imager/interface.pod
 lib/Imager/regmach.pod
 lib/Imager/Tutorial.pod
 lib/Imager/interface.pod
 lib/Imager/regmach.pod

+limits.c

 log.c
 log.h
 map.c
 log.c
 log.h
 map.c


@@ -107,6 +108,7 @@ rotate.c
 samples/README
 samples/anaglyph.pl
 samples/interleave.pl
 samples/README
 samples/anaglyph.pl
 samples/interleave.pl

+samples/replace_color.pl

 samples/samp-form.cgi
 samples/samp-image.cgi
 samples/samp-scale.cgi  Demonstrate image upload via a HTML form
 samples/samp-form.cgi
 samples/samp-image.cgi
 samples/samp-scale.cgi  Demonstrate image upload via a HTML form

diff --git a/TODO b/TODO
index 351b179a91eebd2419486c99570acf66585adad8..d440d1c4c53d17ef84b04db9eccfaa1f3849cc24 100644 (file)
--- a/TODO
+++ b/TODO
@@ -35,6 +35,8 @@ not commitments.
   it doesn't need to cover everything - read/write/create/simple drawing
   and simple text - other stuff belongs in the cookbook or in sample code
 
   it doesn't need to cover everything - read/write/create/simple drawing
   and simple text - other stuff belongs in the cookbook or in sample code
 

+- rename lib/Imager/Cookbook.pm to lib/Imager/Cookbook.pod (done)
+

 - add 5 more recipes to Imager::Cookbook
 
 - implement i_incomplete for png and gif files.
 - add 5 more recipes to Imager::Cookbook
 
 - implement i_incomplete for png and gif files.

diff --git a/samples/README b/samples/README
index e2a27e8d7c44399b1106384ee5b37eca8abee190..df4eb097462d79d3e935d5ad4e6d1606bf4d2f4a 100644 (file)
--- a/samples/README
+++ b/samples/README
@@ -12,6 +12,13 @@ anaglyph.pl
 
   Uses transform2() and convert().
 
 
   Uses transform2() and convert().
 

+replace_color.pl
+
+  Example using Imager::transform2() to replace one color with another
+  in an image.
+
+  http://www.perlmonks.org/?node_id=497355
+

 interleave.pl
 
   Produce an interleaved image given the left and right images of a
 interleave.pl
 
   Produce an interleaved image given the left and right images of a


@@ -50,3 +57,4 @@ samp-tags.cgi
 
   See the section "Parsing an image posted via CGI" in Imager::Cookbook
   for cautions and details on reading uploaded images.
 
   See the section "Parsing an image posted via CGI" in Imager::Cookbook
   for cautions and details on reading uploaded images.

+

diff --git a/samples/replace_color.pl b/samples/replace_color.pl
new file mode 100644 (file)
index 0000000..e993a70
--- /dev/null
+++ b/samples/replace_color.pl
@@ -0,0 +1,113 @@
+#!perl -w
+use strict;
+use Imager;
+
+=head1 NAME
+
+replace_color - replace one color with another in an image
+
+=head1 SYNOPSIS
+
+  perl replace_color fromcolor tocolor inimage outimage
+
+=head1 DESCRIPTION
+
+This is a simple demonstration of Imager::transform2 that replaces one
+color with another in an image.
+
+Note: this works with full color images, and always produces a 3
+channel output image - the alpha channel (if any) is not preserved.
+
+Most of the work is done in the replace_color() function.
+
+=over
+
+=cut
+
+# extract parameters
+my $from = shift;
+
+my $to = shift;
+
+my $in = shift;
+
+my $out = shift
+  or die "Usage: $0 fromcolor tocolor inimage outimage\n";
+
+# convert the colors into objects
+my $from_color = Imager::Color->new($from)
+  or die "Cannot convert fromcolor $from into a color: ", Imager->errstr, "\n";
+
+my $to_color = Imager::Color->new($to)
+  or die "Cannot convert tocolor $to into a color: ", Imager->errstr, "\n";
+
+# do the work
+my $img = Imager->new;
+$img->read(file=>$in)
+  or die "Cannot read image $in: ", $img->errstr, "\n";
+
+my $result = replace_color($img, $from_color, $to_color)
+  or die "Cannot replace colors: ", Imager->errstr, "\n";
+
+$result->write(file=>$out)
+  or die "Cannot write image $out: ", $result->errstr, "\n";
+
+=item replace_color
+
+Called:
+
+  my $result = replace_color($in_image, $from_color, $to_color);
+
+Returns a new image object with colors replaced.
+
+=cut
+
+sub replace_color {
+  my ($img, $from_color, $to_color) = @_;
+
+  my ($from_red, $from_green, $from_blue) = $from_color->rgba;
+  my ($to_red, $to_green, $to_blue) = $to_color->rgba;
+  my $rpnexpr = <<'EOS';
+# get the pixel
+x y getp1 !pix
+# check against the from_color
+@pix red from_red eq
+@pix green from_green eq
+@pix blue from_blue eq
+and and
+# pick a result
+to_red to_green to_blue rgb @pix ifp
+EOS
+  # rpnexpr doesn't really support comments - remove them
+  $rpnexpr =~ s/^#.*\n//mg; 
+  my %constants =
+    (
+     from_red => $from_red,
+     from_green => $from_green,
+     from_blue => $from_blue,
+     to_red => $to_red,
+     to_green => $to_green,
+     to_blue => $to_blue,
+    );
+  return Imager::transform2({ rpnexpr => $rpnexpr,
+                             constants => \%constants },
+                           $img);
+}
+
+__END__
+
+=back
+
+=head1 REVISION
+
+$Revision$
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 SEE ALSO
+
+Imager, Imager::Engines, Imager::Color, Imager::Files
+
+=cut