/usr/share/doc/libimager-perl/examples/replace_color.pl is in libimager-perl 1.005+dfsg-2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #!/usr/bin/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
|