]> git.imager.perl.org - imager.git/blame - samples/replace_color.pl
eliminate use vars
[imager.git] / samples / replace_color.pl
CommitLineData
1611d101
TC
1#!perl -w
2use strict;
3use Imager;
4
5=head1 NAME
6
7replace_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
15This is a simple demonstration of Imager::transform2 that replaces one
16color with another in an image.
17
18Note: this works with full color images, and always produces a 3
19channel output image - the alpha channel (if any) is not preserved.
20
21Most of the work is done in the replace_color() function.
22
23=over
24
25=cut
26
27# extract parameters
28my $from = shift;
29
30my $to = shift;
31
32my $in = shift;
33
34my $out = shift
35 or die "Usage: $0 fromcolor tocolor inimage outimage\n";
36
37# convert the colors into objects
38my $from_color = Imager::Color->new($from)
39 or die "Cannot convert fromcolor $from into a color: ", Imager->errstr, "\n";
40
41my $to_color = Imager::Color->new($to)
42 or die "Cannot convert tocolor $to into a color: ", Imager->errstr, "\n";
43
44# do the work
45my $img = Imager->new;
46$img->read(file=>$in)
47 or die "Cannot read image $in: ", $img->errstr, "\n";
48
49my $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
57Called:
58
59 my $result = replace_color($in_image, $from_color, $to_color);
60
61Returns a new image object with colors replaced.
62
63=cut
64
65sub 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
72x 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
77and and
78# pick a result
79to_red to_green to_blue rgb @pix ifp
80EOS
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
107Tony Cook <tony@develop-help.com>
108
109=head1 SEE ALSO
110
111Imager, Imager::Engines, Imager::Color, Imager::Files
112
113=cut