samples/anaglyph.pl

   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
  49 $out->write(file=>$out_name, jpegquality => 100)
  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
 107 =head1 NAME
 108
 109 =for stopwords anaglyph anaglyph.pl
 110
 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
 134 See L<http://www.3dexpo.com/anaglyph.htm> for an example where this might
 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
 141 =head1 CAVEAT
 142
 143 Using JPEG as the output format is not recommended.
 144
 145 =head1 AUTHOR
 146
 147 Tony Cook <tonyc@cpan.org>
 148
 149 =for stopwords Oppenheim
 150
 151 Thanks to Dan Oppenheim, who provided the impetus for this sample.
 152
 153 =head1 REVISION
 154
 155 $Revision$
 156
 157 =cut