Skip to content
Newer
Older
100644 114 lines (78 sloc) 2.32 KB
1611d10 - add samples/replace_color.pl
Tony Cook authored Oct 10, 2005
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
Something went wrong with that request. Please try again.