samples/wiggle.pl

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4
   5 my $left_name = shift;
   6 my $right_name = shift;
   7 my $out_name = shift
   8   or die "Usage: $0 left right out\n";
   9
  10 my $left = Imager->new(file => $left_name)
  11   or die "Cannot read $left_name: ", Imager->errstr, "\n";
  12
  13 my $right = Imager->new(file => $right_name)
  14   or die "Cannot read $right_name: ", Imager->errstr, "\n";
  15
  16 $left = $left->scale;
  17 $right = $right->scale;
  18
  19 my $steps = 5;
  20
  21 my @cycle;
  22
  23 push @cycle, $left;
  24 my @down;
  25 my @delays = ( 50, ( 10 ) x ($steps-1), 50, ( 10 ) x ($steps-1) );
  26
  27 for my $pos (1 .. $steps-1) {
  28   my $work = $left->copy;
  29   $work->compose(src => $right, opacity => $pos/$steps);
  30   push @cycle, $work;
  31   unshift @down, $work;
  32 }
  33 push @cycle, $right, @down;
  34
  35
  36 Imager->write_multi({ file => $out_name, gif_delay => \@delays, gif_loop => 0, make_colors => "mediancut", translate => "errdiff" }, @cycle)
  37   or die "Cannot write $out_name: ", Imager->errstr, "\n";
  38
  39 =head1 NAME
  40
  41 wiggle.pl - wiggle stereoscopy
  42
  43 =head1 SYNOPSIS
  44
  45   perl wiggle.pl left.jpg right.jpg out.gif
  46
  47 =head1 DESCRIPTION
  48
  49 Produces an animated GIF that displays left, then a blend of four
  50 images leading to right then back again.  The left and right images
  51 are displayed a little longer.
  52
  53 If the left and right images form a stereo pair (and the order doesn't
  54 really matter) the output animated GIF is useful for wiggle
  55 stereoscopy.
  56
  57 =head1 CREDITS
  58
  59 =for stopwords
  60 Oppenheim
  61
  62 Dan Oppenheim <droppenheim@yahoo.com> described the effect and asked
  63 how to implement it.
  64
  65 =head1 AUTHOR
  66
  67 Tony Cook <tonyc@cpan.org>
  68
  69 =cut
  70
  71