]>
Commit | Line | Data |
---|---|---|
cd6db727 TC |
1 | #!perl -w |
2 | use strict; | |
3 | use Imager; | |
4 | use Getopt::Long; | |
5 | ||
6 | my $grey; | |
7 | my $pure; | |
8 | my $green; | |
9 | ||
10 | GetOptions('grey|gray|g'=>\$grey, | |
11 | 'pure|p' => \$pure, | |
12 | 'green' => \$green); | |
13 | ||
14 | if ($grey && $pure) { | |
15 | die "Only one of --grey or --pure can be used at a time\n"; | |
16 | } | |
17 | ||
18 | my $left_name = shift; | |
19 | my $right_name = shift; | |
20 | my $out_name = shift | |
21 | or usage(); | |
22 | ||
23 | my $left = Imager->new; | |
24 | $left->read(file=>$left_name) | |
25 | or die "Cannot load $left_name: ", $left->errstr, "\n"; | |
26 | ||
27 | my $right = Imager->new; | |
28 | $right->read(file=>$right_name) | |
29 | or die "Cannot load $right_name: ", $right->errstr, "\n"; | |
30 | ||
31 | $left->getwidth == $right->getwidth | |
32 | && $left->getheight == $right->getheight | |
33 | or die "Images must be the same width and height\n"; | |
34 | ||
35 | $left->getwidth == $right->getwidth | |
36 | or die "Images must have the same number of channels\n"; | |
37 | ||
38 | my $out; | |
39 | if ($grey) { | |
40 | $out = grey_anaglyph($left, $right); | |
41 | } | |
42 | elsif ($pure) { | |
43 | $out = pure_anaglyph($left, $right, $green); | |
44 | } | |
45 | else { | |
46 | $out = anaglyph_images($left, $right); | |
47 | } | |
48 | ||
b2db9cd4 | 49 | $out->write(file=>$out_name, jpegquality => 100) |
cd6db727 TC |
50 | or die "Cannot write $out_name: ", $out->errstr, "\n"; |
51 | ||
52 | sub usage { | |
53 | print <<EOS; | |
54 | Usage: $0 left_image right_image out_image | |
55 | EOS | |
56 | exit; | |
57 | } | |
58 | ||
59 | sub anaglyph_images { | |
60 | my ($left, $right) = @_; | |
61 | ||
62 | my $expr = <<'EXPR'; # get red from $left, green, blue from $right | |
63 | x y getp1 red x y getp2 !pix @pix green @pix blue rgb | |
64 | EXPR | |
65 | my $out = Imager::transform2 ({ rpnexpr=>$expr, }, $left, $right) | |
66 | or die Imager->errstr; | |
67 | ||
68 | $out; | |
69 | } | |
70 | ||
71 | sub grey_anaglyph { | |
72 | my ($left, $right) = @_; | |
73 | ||
74 | $left = $left->convert(preset=>'grey'); | |
75 | $right = $right->convert(preset=>'grey'); | |
76 | ||
77 | my $expr = <<'EXPR'; | |
78 | x y getp1 red x y getp2 red !right @right @right rgb | |
79 | EXPR | |
80 | ||
81 | return Imager::transform2({ rpnexpr=>$expr }, $left, $right); | |
82 | } | |
83 | ||
84 | sub pure_anaglyph { | |
85 | my ($left, $right, $green) = @_; | |
86 | ||
87 | $left = $left->convert(preset=>'grey'); | |
88 | $right = $right->convert(preset=>'grey'); | |
89 | ||
90 | my $expr; | |
91 | if ($green) { | |
92 | # output is rgb(first channel of left, first channel of right, 0) | |
93 | $expr = <<'EXPR' | |
94 | x y getp1 red x y getp2 red 0 rgb | |
95 | EXPR | |
96 | } | |
97 | else { | |
98 | # output is rgb(first channel of left, 0, first channel of right) | |
99 | $expr = <<'EXPR'; | |
100 | x y getp1 red 0 x y getp2 red rgb | |
101 | EXPR | |
102 | } | |
103 | ||
104 | return Imager::transform2({ rpnexpr=>$expr }, $left, $right); | |
105 | } | |
106 | ||
cd6db727 TC |
107 | =head1 NAME |
108 | ||
5715f7c3 TC |
109 | =for stopwords anaglyph anaglyph.pl |
110 | ||
cd6db727 TC |
111 | anaglyph.pl - create a anaglyph from the source images |
112 | ||
113 | =head1 SYNOPSIS | |
114 | ||
115 | # color anaglyph | |
116 | perl anaglyph.pl left_input right_input output | |
117 | ||
118 | # grey anaglyph | |
119 | perl anaglyph.pl -g left_input right_input output | |
120 | perl anaglyph.pl --grey left_input right_input output | |
121 | perl anaglyph.pl --gray left_input right_input output | |
122 | ||
123 | # pure anaglyph (blue) | |
124 | perl anaglyph.pl -p left_input right_input output | |
125 | perl anaglyph.pl --pure left_input right_input output | |
126 | ||
127 | # pure anaglyph (green) | |
128 | perl anaglyph.pl -p --green left_input right_input output | |
129 | perl anaglyph.pl --pure --green left_input right_input output | |
130 | ||
131 | =head1 DESCRIPTION | |
132 | ||
133 | ||
3f6d1a9d | 134 | See L<http://www.3dexpo.com/anaglyph.htm> for an example where this might |
cd6db727 TC |
135 | be useful. |
136 | ||
137 | Implementation based on the description at | |
138 | http://www.recordedlight.com/stereo/tutorials/ps/anaglyph/pstut04.htm | |
139 | though obviously the interactive component is missing. | |
140 | ||
37d5681a TC |
141 | =head1 CAVEAT |
142 | ||
143 | Using JPEG as the output format is not recommended. | |
144 | ||
cd6db727 TC |
145 | =head1 AUTHOR |
146 | ||
5b480b14 | 147 | Tony Cook <tonyc@cpan.org> |
cd6db727 | 148 | |
5715f7c3 TC |
149 | =for stopwords Oppenheim |
150 | ||
cd6db727 TC |
151 | Thanks to Dan Oppenheim, who provided the impetus for this sample. |
152 | ||
153 | =head1 REVISION | |
154 | ||
155 | $Revision$ | |
156 | ||
157 | =cut |