samples/replace_color.pl

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4
   5 =head1 NAME
   6
   7 replace_color - replace one color with another in an image
   8
   9 =head1 SYNOPSIS
  10
  11   perl replace_color fromcolor tocolor inimage outimage
  12
  13 =head1 DESCRIPTION
  14
  15 This is a simple demonstration of Imager::transform2 that replaces one
  16 color with another in an image.
  17
  18 Note: this works with full color images, and always produces a 3
  19 channel output image - the alpha channel (if any) is not preserved.
  20
  21 Most of the work is done in the replace_color() function.
  22
  23 =over
  24
  25 =cut
  26
  27 # extract parameters
  28 my $from = shift;
  29
  30 my $to = shift;
  31
  32 my $in = shift;
  33
  34 my $out = shift
  35   or die "Usage: $0 fromcolor tocolor inimage outimage\n";
  36
  37 # convert the colors into objects
  38 my $from_color = Imager::Color->new($from)
  39   or die "Cannot convert fromcolor $from into a color: ", Imager->errstr, "\n";
  40
  41 my $to_color = Imager::Color->new($to)
  42   or die "Cannot convert tocolor $to into a color: ", Imager->errstr, "\n";
  43
  44 # do the work
  45 my $img = Imager->new;
  46 $img->read(file=>$in)
  47   or die "Cannot read image $in: ", $img->errstr, "\n";
  48
  49 my $result = replace_color($img, $from_color, $to_color)
  50   or die "Cannot replace colors: ", Imager->errstr, "\n";
  51
  52 $result->write(file=>$out)
  53   or die "Cannot write image $out: ", $result->errstr, "\n";
  54
  55 =item replace_color
  56
  57 Called:
  58
  59   my $result = replace_color($in_image, $from_color, $to_color);
  60
  61 Returns a new image object with colors replaced.
  62
  63 =cut
  64
  65 sub replace_color {
  66   my ($img, $from_color, $to_color) = @_;
  67
  68   my ($from_red, $from_green, $from_blue) = $from_color->rgba;
  69   my ($to_red, $to_green, $to_blue) = $to_color->rgba;
  70   my $rpnexpr = <<'EOS';
  71 # get the pixel
  72 x y getp1 !pix
  73 # check against the from_color
  74 @pix red from_red eq
  75 @pix green from_green eq
  76 @pix blue from_blue eq
  77 and and
  78 # pick a result
  79 to_red to_green to_blue rgb @pix ifp
  80 EOS
  81   # rpnexpr doesn't really support comments - remove them
  82   $rpnexpr =~ s/^#.*\n//mg;
  83   my %constants =
  84     (
  85      from_red => $from_red,
  86      from_green => $from_green,
  87      from_blue => $from_blue,
  88      to_red => $to_red,
  89      to_green => $to_green,
  90      to_blue => $to_blue,
  91     );
  92   return Imager::transform2({ rpnexpr => $rpnexpr,
  93                               constants => \%constants },
  94                             $img);
  95 }
  96
  97 __END__
  98
  99 =back
 100
 101 =head1 REVISION
 102
 103 $Revision$
 104
 105 =head1 AUTHOR
 106
 107 Tony Cook <tony@develop-help.com>
 108
 109 =head1 SEE ALSO
 110
 111 Imager, Imager::Engines, Imager::Color, Imager::Files
 112
 113 =cut