<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!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' =&gt; \$verbose);

my $back_color = Imager::Color-&gt;new($back)
  or die "Cannot convert $back to a color: ", Imager-&gt;errstr, "\n";

$low_pct &gt;= 0 &amp;&amp; $low_pct &lt; 100
  or die "lowpct must be &gt;=0 and &lt; 100\n";

$delay &gt; 0 and $delay &lt; 255
  or die "delay must be between 1 and 255\n";

$frames &gt; 1 
  or die "frames must be &gt; 1\n";

my $in_name = shift
  or usage();

my $out_name = shift
  or usage();

my $base = Imager-&gt;new;
$base-&gt;read(file =&gt; $in_name)
  or die "Cannot read image file $in_name: ", $base-&gt;errstr, "\n";

# convert to RGBA to simplify the convert() matrix
$base = $base-&gt;convert(preset =&gt; 'rgb') unless $base-&gt;getchannels &gt;=3;
$base = $base-&gt;convert(preset =&gt; 'addalpha') unless $base-&gt;getchannels == 4;

my $width = $base-&gt;getwidth;
my $height = $base-&gt;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-&gt;new(xsize =&gt; $width, ysize =&gt; $height);
  $canvas-&gt;box(filled =&gt; 1, color =&gt; $back_color);

  # make a version of our original with the alpha scaled
  my $scale = $percent / 100.0;
  my $draw = $base-&gt;convert(matrix =&gt; [ [ 1, 0, 0, 0 ],
					[ 0, 1, 0, 0 ],
					[ 0, 0, 1, 0 ],
					[ 0, 0, 0, $scale ] ]);

  # draw it on the canvas
  $canvas-&gt;rubthrough(src =&gt; $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-&gt;write_multi({ file =&gt; $out_name, 
		      type =&gt; 'gif',
		      gif_loop =&gt; 0, # loop forever
		      gif_delay =&gt; $delay,
		      translate =&gt; 'errdiff',
		      make_colors =&gt; 'mediancut',
		    },
		    @frames)
  or die "Cannot write $out_name: ", Imager-&gt;errstr, "\n";

sub usage {
  die &lt;&lt;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 &lt;delay&gt; | --delay &lt;delay&gt;
    Delay between frames in 1/100 sec.  Default 10.
  -p &lt;percent&gt; | --percent &lt;percent&gt;
    Low percentage coverage.  Default: 30
  -b &lt;color&gt; | --back &lt;color&gt;
    Color to fade towards, in some format Imager understands.
    Default: #FFFFFF
  -f &lt;frames&gt; | --frames &lt;frames&gt;
    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 C&lt;lowpct&gt;%
coverage on a blank image of color C&lt;back&gt;.

=head1 OPTIONS

=over

=item *

C&lt;-f&gt; I&lt;frames&gt;, C&lt;--frames&gt; I&lt;frames&gt; - the total number of frames.
This is always rounded up to the next even number.  Default: 20

=item *

C&lt;-d&gt; I&lt;delay&gt;, C&lt;--delay&gt; I&lt;delay&gt; - the delay in 1/100 second between
frames.  Default: 10.

=item *

C&lt;-p&gt; I&lt;percent&gt;, C&lt;--lowpct&gt; I&lt;percent&gt; - the lowest coverage of the image.
Default: 30

=item *

C&lt;-b&gt; I&lt;color&gt;, C&lt;--back&gt; I&lt;color&gt; - the background color to fade to.  
Default: #FFFFFF.

=item *

C&lt;-v&gt;, C&lt;--verbose&gt; - produce progress information.

=back

=head1 AUTHOR

Tony Cook &lt;tonyc@cpan.org&gt;

=cut

</pre></body></html>