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
 108 =head1 NAME
 109
 110 =for stopwords anaglyph anaglyph.pl
 111
 112 anaglyph.pl - create a anaglyph from the source images
 113
 114 =head1 SYNOPSIS
 115
 116   # color anaglyph
 117   perl anaglyph.pl left_input right_input output
 118
 119   # grey anaglyph
 120   perl anaglyph.pl -g left_input right_input output
 121   perl anaglyph.pl --grey left_input right_input output
 122   perl anaglyph.pl --gray left_input right_input output
 123
 124   # pure anaglyph (blue)
 125   perl anaglyph.pl -p left_input right_input output
 126   perl anaglyph.pl --pure left_input right_input output
 127
 128   # pure anaglyph (green)
 129   perl anaglyph.pl -p --green left_input right_input output
 130   perl anaglyph.pl --pure --green left_input right_input output
 131
 132 =head1 DESCRIPTION
 133
 134
 135 See http://www.3dexpo.com/anaglyph.htm for an example where this might
 136 be useful.
 137
 138 Implementation based on the description at
 139 http://www.recordedlight.com/stereo/tutorials/ps/anaglyph/pstut04.htm
 140 though obviously the interactive component is missing.
 141
 142 =head1 CAVEAT
 143
 144 Using JPEG as the output format is not recommended.
 145
 146 =head1 AUTHOR
 147
 148 Tony Cook <tonyc@cpan.org>
 149
 150 =for stopwords Oppenheim
 151
 152 Thanks to Dan Oppenheim, who provided the impetus for this sample.
 153
 154 =head1 REVISION
 155
 156 $Revision$
 157
 158 =cut