--- /dev/null
+#!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
+
projects / imager.git / blobdiff