samples/flasher.pl

   1 #!perl
   2 use strict;
   3 use Imager;
   4 use Getopt::Long;
   5
   6 my $delay = 10;
   7 my $frames = 20;
   8 my $low_pct = 30;
   9 my $back = '#FFFFFF';
  10 my $verbose = 0;
  11 GetOptions('delay|d=i', \$delay,
  12            'frames|f=i', \$frames,
  13            'lowpct|p=i', \$low_pct,
  14            'back|b=s', \$back,
  15            'verbose|v' => \$verbose);
  16
  17 my $back_color = Imager::Color->new($back)
  18   or die "Cannot convert $back to a color: ", Imager->errstr, "\n";
  19
  20 $low_pct >= 0 && $low_pct < 100
  21   or die "lowpct must be >=0 and < 100\n";
  22
  23 $delay > 0 and $delay < 255
  24   or die "delay must be between 1 and 255\n";
  25
  26 $frames > 1
  27   or die "frames must be > 1\n";
  28
  29 my $in_name = shift
  30   or usage();
  31
  32 my $out_name = shift
  33   or usage();
  34
  35 my $base = Imager->new;
  36 $base->read(file => $in_name)
  37   or die "Cannot read image file $in_name: ", $base->errstr, "\n";
  38
  39 # convert to RGBA to simplify the convert() matrix
  40 $base = $base->convert(preset => 'rgb') unless $base->getchannels >=3;
  41 $base = $base->convert(preset => 'addalpha') unless $base->getchannels == 4;
  42
  43 my $width = $base->getwidth;
  44 my $height = $base->getheight;
  45
  46 my @down;
  47 my $down_frames = $frames / 2;
  48 my $step = (100 - $low_pct) / $down_frames;
  49 my $percent = 100 - $step;
  50 ++$|;
  51 print "Generating frames\n" if $verbose;
  52 for my $frame_no (1 .. $down_frames) {
  53   print "\rFrame $frame_no/$down_frames";
  54
  55   # canvas with our background color
  56   my $canvas = Imager->new(xsize => $width, ysize => $height);
  57   $canvas->box(filled => 1, color => $back_color);
  58
  59   # make a version of our original with the alpha scaled
  60   my $scale = $percent / 100.0;
  61   my $draw = $base->convert(matrix => [ [ 1, 0, 0, 0 ],
  62                                         [ 0, 1, 0, 0 ],
  63                                         [ 0, 0, 1, 0 ],
  64                                         [ 0, 0, 0, $scale ] ]);
  65
  66   # draw it on the canvas
  67   $canvas->rubthrough(src => $draw);
  68
  69   push @down, $canvas;
  70   $percent -= $step;
  71 }
  72 print "\n" if $verbose;
  73
  74 # generate a sequence going from the original down to the most faded
  75 my @frames = $base;
  76 push @frames, @down;
  77 # remove the most faded frame so it isn't repeated
  78 pop @down;
  79 # and back up again
  80 push @frames, reverse @down;
  81
  82 print "Writing frames\n" if $verbose;
  83 Imager->write_multi({ file => $out_name,
  84                       type => 'gif',
  85                       gif_loop => 0, # loop forever
  86                       gif_delay => $delay,
  87                       translate => 'errdiff',
  88                       make_colors => 'mediancut',
  89                     },
  90                     @frames)
  91   or die "Cannot write $out_name: ", Imager->errstr, "\n";
  92
  93 sub usage {
  94   die <<EOS;
  95 Produce an animated gif that cycles an image fading into a background and
  96 unfading back to the original image.
  97 Usage: $0 [options] input output
  98 Input can be any image supported by Imager.
  99 Output should be a .gif file.
 100 Options include:
 101   -v | --verbose
 102     Progress reports
 103   -d <delay> | --delay <delay>
 104     Delay between frames in 1/100 sec.  Default 10.
 105   -p <percent> | --percent <percent>
 106     Low percentage coverage.  Default: 30
 107   -b <color> | --back <color>
 108     Color to fade towards, in some format Imager understands.
 109     Default: #FFFFFF
 110   -f <frames> | --frames <frames>
 111     Rough total number of frames to produce.  Default: 20.
 112 EOS
 113 }
 114
 115 =head1 NAME
 116
 117 flasher.pl - produces a slowly flashing GIF based on an input image
 118
 119 =head1 SYNOPSIS
 120
 121   perl flasher.pl [options] input output.gif
 122
 123 =head1 DESCRIPTION
 124
 125 flasher.pl generates an animation from the given image to I<lowpct>%
 126 coverage on a blank image of color I<back>.
 127
 128 =head1 OPTIONS
 129
 130 =over
 131
 132 =item *
 133
 134 -f I<frames>, --frames I<frames> - the total number of frames.  This is
 135  always rounded up to the next even number.  Default: 20
 136
 137 =item *
 138
 139 -d I<delay>, --delay I<delay> - the delay in 1/100 second between
 140  frames.  Default: 10.
 141
 142 =item *
 143
 144 -p I<percent>, --lowpct I<percent> - the lowest coverage of the image.
 145  Default: 30
 146
 147 =item *
 148
 149 -b I<color>, --back I<color> - the background color to fade to.
 150 Default: #FFFFFF.
 151
 152 =item *
 153
 154 -v, --verbose - produce progress information.
 155
 156 =item
 157
 158 =back
 159
 160 =head1 AUTHOR
 161
 162 Tony Cook <tonyc@cpan.org>
 163
 164 =cut
 165