add a new sample flasher.pl
authorTony Cook <tony@develop=help.com>
Thu, 29 Mar 2007 13:55:53 +0000 (13:55 +0000)
committerTony Cook <tony@develop=help.com>
Thu, 29 Mar 2007 13:55:53 +0000 (13:55 +0000)
MANIFEST
lib/Imager/Files.pod
samples/README
samples/flasher.pl [new file with mode: 0644]

index 95f8f1a..da6c5e0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -183,6 +183,7 @@ samples/README
 samples/align-string.pl Demonstrate align_string method.
 samples/anaglyph.pl
 samples/border.pl       Demonstrate adding a border
+samples/flasher.gif    Animate an source image fading to a color and back
 samples/inline_capture2image.pl         convert captured BGR data to an image
 samples/inline_replace_color.pl  replace colors using Inline::C
 samples/interleave.pl
index 6089b38..a3e7b56 100644 (file)
@@ -610,7 +610,8 @@ how the next frame is displayed ("Disposal Method")
 
 =item gif_loop
 
-the number of loops from the Netscape Loop extension.  This may be zero.
+the number of loops from the Netscape Loop extension.  This may be
+zero to loop forever.
 
 =item gif_comment
 
index b4edfe9..039fb17 100644 (file)
@@ -97,3 +97,10 @@ inline_capture2image.pl
 
   Demonstrates using Inline and Imager's API to convert captured BGR
   image data into an Imager image.
+
+flasher.pl
+
+  Animate an image fading down to a background color and back again.
+
+  Demonstrates setting an alpha channel with convert(), rubthrough(), 
+  and writing animated GIFs.
diff --git a/samples/flasher.pl b/samples/flasher.pl
new file mode 100644 (file)
index 0000000..d5af422
--- /dev/null
@@ -0,0 +1,165 @@
+#!perl
+use strict;
+use Imager;
+use Getopt::Long;
+
+my $delay = 10;
+my $frames = 20;
+my $low_pct = 30;
+my $back = '#FFFFFF';
+my $verbose = 0;
+GetOptions('delay|d=i', \$delay,
+          'frames|f=i', \$frames,
+          'lowpct|p=i', \$low_pct,
+          'back|b=s', \$back,
+          'verbose|v' => \$verbose);
+
+my $back_color = Imager::Color->new($back)
+  or die "Cannot convert $back to a color: ", Imager->errstr, "\n";
+
+$low_pct >= 0 && $low_pct < 100
+  or die "lowpct must be >=0 and < 100\n";
+
+$delay > 0 and $delay < 255
+  or die "delay must be between 1 and 255\n";
+
+$frames > 1 
+  or die "frames must be > 1\n";
+
+my $in_name = shift
+  or usage();
+
+my $out_name = shift
+  or usage();
+
+my $base = Imager->new;
+$base->read(file => $in_name)
+  or die "Cannot read image file $in_name: ", $base->errstr, "\n";
+
+# convert to RGBA to simplify the convert() matrix
+$base = $base->convert(preset => 'rgb') unless $base->getchannels >=3;
+$base = $base->convert(preset => 'addalpha') unless $base->getchannels == 4;
+
+my $width = $base->getwidth;
+my $height = $base->getheight;
+
+my @down;
+my $down_frames = $frames / 2;
+my $step = (100 - $low_pct) / $down_frames;
+my $percent = 100 - $step;
+++$|;
+print "Generating frames\n" if $verbose;
+for my $frame_no (1 .. $down_frames) {
+  print "\rFrame $frame_no/$down_frames";
+
+  # canvas with our background color
+  my $canvas = Imager->new(xsize => $width, ysize => $height);
+  $canvas->box(filled => 1, color => $back_color);
+
+  # make a version of our original with the alpha scaled
+  my $scale = $percent / 100.0;
+  my $draw = $base->convert(matrix => [ [ 1, 0, 0, 0 ],
+                                       [ 0, 1, 0, 0 ],
+                                       [ 0, 0, 1, 0 ],
+                                       [ 0, 0, 0, $scale ] ]);
+
+  # draw it on the canvas
+  $canvas->rubthrough(src => $draw);
+
+  push @down, $canvas;
+  $percent -= $step;
+}
+print "\n" if $verbose;
+
+# generate a sequence going from the original down to the most faded
+my @frames = $base;
+push @frames, @down;
+# remove the most faded frame so it isn't repeated
+pop @down; 
+# and back up again
+push @frames, reverse @down;
+
+print "Writing frames\n" if $verbose;
+Imager->write_multi({ file => $out_name, 
+                     type => 'gif',
+                     gif_loop => 0, # loop forever
+                     gif_delay => $delay,
+                     translate => 'errdiff',
+                     make_colors => 'mediancut',
+                   },
+                   @frames)
+  or die "Cannot write $out_name: ", Imager->errstr, "\n";
+
+sub usage {
+  die <<EOS;
+Produce an animated gif that cycles an image fading into a background and
+unfading back to the original image.
+Usage: $0 [options] input output
+Input can be any image supported by Imager.
+Output should be a .gif file.
+Options include:
+  -v | --verbose
+    Progress reports
+  -d <delay> | --delay <delay>
+    Delay between frames in 1/100 sec.  Default 10.
+  -p <percent> | --percent <percent>
+    Low percentage coverage.  Default: 30
+  -b <color> | --back <color>
+    Color to fade towards, in some format Imager understands.
+    Default: #FFFFFF
+  -f <frames> | --frames <frames>
+    Rough total number of frames to produce.  Default: 20.
+EOS
+}
+
+=head1 NAME
+
+flasher.pl - produces a slowly flashing GIF based on an input image
+
+=head1 SYNOPSIS
+
+  perl flasher.pl [options] input output.gif
+
+=head1 DESCRIPTION
+
+flasher.pl generates an animation from the given image to I<lowpct>%
+coverage on a blank image of color I<back>.
+
+=head1 OPTIONS
+
+=over
+
+=item *
+
+-f I<frames>, --frames I<frames> - the total number of frames.  This is
+ always rounded up to the next even number.  Default: 20
+
+=item *
+
+-d I<delay>, --delay I<delay> - the delay in 1/100 second between
+ frames.  Default: 10.
+
+=item *
+
+-p I<percent>, --lowpct I<percent> - the lowest coverage of the image.
+ Default: 30
+
+=item *
+
+-b I<color>, --back I<color> - the background color to fade to.  
+Default: #FFFFFF.
+
+=item *
+
+-v, --verbose - produce progress information.
+
+=item 
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tonyc@cpan.org>
+
+=cut
+