Initial version

diff --git a/samples/anaglyph.pl b/samples/anaglyph.pl
new file mode 100644 (file)
index 0000000..778fa9a
--- /dev/null
+++ b/samples/anaglyph.pl
@@ -0,0 +1,150 @@
+#!perl -w
+use strict;
+use Imager;
+use Getopt::Long;
+
+my $grey;
+my $pure;
+my $green;
+
+GetOptions('grey|gray|g'=>\$grey,
+          'pure|p' => \$pure,
+          'green' => \$green);
+
+if ($grey && $pure) {
+  die "Only one of --grey or --pure can be used at a time\n";
+}
+
+my $left_name = shift;
+my $right_name = shift;
+my $out_name = shift
+  or usage();
+
+my $left = Imager->new;
+$left->read(file=>$left_name)
+  or die "Cannot load $left_name: ", $left->errstr, "\n";
+
+my $right = Imager->new;
+$right->read(file=>$right_name)
+  or die "Cannot load $right_name: ", $right->errstr, "\n";
+
+$left->getwidth == $right->getwidth
+  && $left->getheight == $right->getheight
+  or die "Images must be the same width and height\n";
+
+$left->getwidth == $right->getwidth
+  or die "Images must have the same number of channels\n";
+
+my $out;
+if ($grey) {
+  $out = grey_anaglyph($left, $right);
+}
+elsif ($pure) {
+  $out = pure_anaglyph($left, $right, $green);
+}
+else {
+  $out = anaglyph_images($left, $right);
+}
+
+$out->write(file=>$out_name)
+  or die "Cannot write $out_name: ", $out->errstr, "\n";
+
+sub usage {
+  print <<EOS;
+Usage: $0 left_image right_image out_image
+EOS
+  exit;
+}
+
+sub anaglyph_images {
+  my ($left, $right) = @_;
+
+  my $expr = <<'EXPR'; # get red from $left, green, blue from $right
+x y getp1 red x y getp2 !pix @pix green @pix blue rgb
+EXPR
+  my $out = Imager::transform2 ({ rpnexpr=>$expr, }, $left, $right) 
+    or die Imager->errstr;
+
+  $out;
+}
+
+sub grey_anaglyph {
+  my ($left, $right) = @_;
+
+  $left = $left->convert(preset=>'grey');
+  $right = $right->convert(preset=>'grey');
+
+  my $expr = <<'EXPR';
+x y getp1 red x y getp2 red !right @right @right rgb
+EXPR
+
+  return Imager::transform2({ rpnexpr=>$expr }, $left, $right);
+}
+
+sub pure_anaglyph {
+  my ($left, $right, $green) = @_;
+
+  $left = $left->convert(preset=>'grey');
+  $right = $right->convert(preset=>'grey');
+
+  my $expr;
+  if ($green) {
+    # output is rgb(first channel of left, first channel of right, 0)
+    $expr = <<'EXPR'
+x y getp1 red x y getp2 red 0 rgb
+EXPR
+  }
+  else {
+    # output is rgb(first channel of left, 0, first channel of right)
+    $expr = <<'EXPR';
+x y getp1 red 0 x y getp2 red rgb
+EXPR
+}
+
+  return Imager::transform2({ rpnexpr=>$expr }, $left, $right);
+}
+
+
+=head1 NAME
+
+anaglyph.pl - create a anaglyph from the source images
+
+=head1 SYNOPSIS
+
+  # color anaglyph
+  perl anaglyph.pl left_input right_input output
+
+  # grey anaglyph
+  perl anaglyph.pl -g left_input right_input output
+  perl anaglyph.pl --grey left_input right_input output
+  perl anaglyph.pl --gray left_input right_input output
+
+  # pure anaglyph (blue)
+  perl anaglyph.pl -p left_input right_input output
+  perl anaglyph.pl --pure left_input right_input output
+
+  # pure anaglyph (green)
+  perl anaglyph.pl -p --green left_input right_input output
+  perl anaglyph.pl --pure --green left_input right_input output
+
+=head1 DESCRIPTION
+
+
+See http://www.3dexpo.com/anaglyph.htm for an example where this might
+be useful.
+
+Implementation based on the description at
+http://www.recordedlight.com/stereo/tutorials/ps/anaglyph/pstut04.htm
+though obviously the interactive component is missing.
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+Thanks to Dan Oppenheim, who provided the impetus for this sample.
+
+=head1 REVISION
+
+$Revision$
+
+=cut