add wiggle.pl sample

diff --git a/Changes b/Changes
index c63250ca9b6b8b6abbecbdf0de65adf35e2139ec..a1adfa984aa6a79859ea70c137aac96b6eba4962 100644 (file)
--- a/Changes
+++ b/Changes
@@ -11,6 +11,8 @@ Imager 0.79 - unreleased
    This significantly speeds up presets like "addalpha", "green".
    https://rt.cpan.org/Ticket/Display.html?id=51254
 
+ - add wiggle.pl sample, as suggested by Dan Oppenheim.
+
 Bug fixes:
 
  - treat the co-efficients for convert() as doubles instead of floats.

diff --git a/samples/README b/samples/README
index a45f37af5f69e2c3b6c12c9c419d78256a3ae76f..77f3886c0b96cb642bd885edb7d3103a23754fe4 100644 (file)
--- a/samples/README
+++ b/samples/README
@@ -116,3 +116,9 @@ quad_to_square.pl
   Sample from Richard Fairhurst demonstrating the use of the transform2()
   det() function.  Transforms an arbitrary quadrilateral in the input into
   a square on the output.
+
+wiggle.pl
+
+  Produce an animated GIF that blends back and forth between the two
+  supplied images.  If the input images form a stereo pair the GIF can
+  be used for wiggle stereoscopy.

diff --git a/samples/wiggle.pl b/samples/wiggle.pl
new file mode 100644 (file)
index 0000000..1b7d014
--- /dev/null
+++ b/samples/wiggle.pl
@@ -0,0 +1,68 @@
+#!perl -w
+use strict;
+use Imager;
+
+my $left_name = shift;
+my $right_name = shift;
+my $out_name = shift
+  or die "Usage: $0 left right out\n";
+
+my $left = Imager->new(file => $left_name)
+  or die "Cannot read $left_name: ", Imager->errstr, "\n";
+
+my $right = Imager->new(file => $right_name)
+  or die "Cannot read $right_name: ", Imager->errstr, "\n";
+
+$left = $left->scale;
+$right = $right->scale;
+
+my $steps = 5;
+
+my @cycle;
+
+push @cycle, $left;
+my @down;
+my @delays = ( 50, ( 10 ) x ($steps-1), 50, ( 10 ) x ($steps-1) );
+
+for my $pos (1 .. $steps-1) {
+  my $work = $left->copy;
+  $work->compose(src => $right, opacity => $pos/$steps);
+  push @cycle, $work;
+  unshift @down, $work;
+}
+push @cycle, $right, @down;
+
+
+Imager->write_multi({ file => $out_name, gif_delay => \@delays, gif_loop => 0, make_colors => "mediancut", translate => "errdiff" }, @cycle)
+  or die "Cannot write $out_name: ", Imager->errstr, "\n";
+
+=head1 NAME
+
+wiggle.pl - wiggle stereoscopy
+
+=head1 SYNOPSIS
+
+  perl wiggle.pl left.jpg right.jpg out.gif
+
+=head1 DESCRIPTION
+
+Produces an animated GIF that displays left, then a blend of four
+images leading to right then back again.  The left and right images
+are displayed a little longer.
+
+If the left and right images form a stereo pair (and the order doesn't
+really matter) the output animated GIF is useful for wiggle
+stereoscopy.
+
+=head1 CREDITS
+
+Dan Oppenheim <droppenheim@yahoo.com> described the effect and asked
+how to implement it.
+
+=head1 AUTHOR
+
+Tony Cook <tonyc@cpan.org>
+
+=cut
+
+