From: Tony Cook Date: Thu, 29 Mar 2007 13:55:53 +0000 (+0000) Subject: add a new sample flasher.pl X-Git-Tag: Imager-0.56~6 X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/e9016eb787ca8c4161983c64dd75ce1e427299b8 add a new sample flasher.pl --- diff --git a/MANIFEST b/MANIFEST index 95f8f1ab..da6c5e0f 100644 --- 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 diff --git a/lib/Imager/Files.pod b/lib/Imager/Files.pod index 6089b384..a3e7b56a 100644 --- a/lib/Imager/Files.pod +++ b/lib/Imager/Files.pod @@ -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 diff --git a/samples/README b/samples/README index b4edfe95..039fb172 100644 --- a/samples/README +++ b/samples/README @@ -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 index 00000000..d5af4222 --- /dev/null +++ b/samples/flasher.pl @@ -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 < | --delay + Delay between frames in 1/100 sec. Default 10. + -p | --percent + Low percentage coverage. Default: 30 + -b | --back + Color to fade towards, in some format Imager understands. + Default: #FFFFFF + -f | --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% +coverage on a blank image of color I. + +=head1 OPTIONS + +=over + +=item * + +-f I, --frames I - the total number of frames. This is + always rounded up to the next even number. Default: 20 + +=item * + +-d I, --delay I - the delay in 1/100 second between + frames. Default: 10. + +=item * + +-p I, --lowpct I - the lowest coverage of the image. + Default: 30 + +=item * + +-b I, --back I - the background color to fade to. +Default: #FFFFFF. + +=item * + +-v, --verbose - produce progress information. + +=item + +=back + +=head1 AUTHOR + +Tony Cook + +=cut +