]>
Commit | Line | Data |
---|---|---|
1611d101 TC |
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 |