The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/app/bin/perl

eval 'exec /usr/app/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# A plug-in for GIMP which animates a series of layers as if
# they were animation cells (different from the normal gimp animation,
# in that each cell REPLACES the previous, instead of adding. The
# background cell (bottom most layer) is always kept.
#
# Written in 1999 (c) by Aaron Sherman <ajs@ajs.com>.
# This plugin may be distributed under the same terms as The Gimp itself.
# See http://www.gimp.org/ for more information on The Gimp.
#

require 5.004;

use Gimp qw(:auto __ N_);
use Gimp::Fu;
use Gimp::Util;

$animate_cells_version = "1.2";
$animate_cells_released = "3/12/1999";

# use strict;

sub perl_fu_animate_cells {
  my $image = shift;
  my $drawable = shift; # Unused
  my $makecopy = shift;
  $image = gimp_channel_ops_duplicate($image) if $makecopy;
  gimp_image_undo_disable($image);
  gimp_progress_init("Animating cell layers...",MESSAGE_BOX);

  my @ids = reverse gimp_image_get_layers($image);
  my $back = shift @ids;

  if (@ids < 2) {
    gimp_image_delete($image) if $makecopy;
    die "animate_cells: too few cells (layers) in image\n";
    return;
  }

  gimp_selection_layer_alpha($ids[0]);
  for($i=1;$i<@ids;$i++) {
    gimp_progress_update(1/(@ids-1)/2*$i);
    $lnum = $#ids+1-$i;
    fix_cell_layer($image, $ids[$i], $ids[$i-1], $back, $lnum);
  }

  for($i=$#ids;$i>=0;$i--) {
    gimp_progress_update(0.5+1/@ids*(@ids-$i));
    gimp_image_merge_down($image, $ids[$i], EXPAND_AS_NECESSARY);
  }

  gimp_progress_update(1.0);

  gimp_display_new($image) if $makecopy;
  gimp_selection_none($image);
  gimp_image_undo_enable($image);
  gimp_displays_flush();
}

sub fix_cell_layer {
  my $img = shift; # The image
  my $target = shift; # The target layer
  my $prev = shift; # The layer before it
  my $back = shift; # The background layer
  my $lnum = shift; # The new layer's number
  my $dup = gimp_layer_copy($prev,0);
  # Tried to do a gimp_layer_get_position($target), here, but it failed...
  gimp_image_add_layer($img, $dup, $lnum);
  gimp_selection_sharpen($img); # No feathered or fuzzy selection areas
  gimp_selection_grow($img,1); # XXX - Gets around gimp 1-pixel bug
  gimp_edit_copy($back);
  my $float = gimp_edit_paste($dup,0);
  gimp_floating_sel_anchor($float);
  gimp_selection_layer_alpha($target);
}

# Gimp::Fu registration routine for placing this function into gimp's PDB
register
  "animate_cells",
  "Perform cell animation from a single, layered image",
  "Use this plugin to animate a series of layers in the same way that\
	a physical animation process would use cells.",
  "Aaron Sherman", "Aaron Sherman (c)", "1999-03-15",
  N_"<Image>/Filters/Animation/Animate Cells...",
  "*",
  [
   [PF_TOGGLE, "work_on_copy", "", 1]
  ],
  \&perl_fu_animate_cells;

exit main;

__END__

=head1 NAME

animate_cells - Animate an image

=head1 SYNOPSIS

Called from the Gimp. Use Gimp's user interface to call this function.
By default "C<E<lt>ImageE<gt>/Perl Fu/Animate Cells>".

=head1 DESCRIPTION

This Gimp plugin makes animation of images much simpler. The idea is that
(as was the case with physical "cell" animation) you simply create a
background and as many cell layers as you like. Each layer represents a
frame to be animated on top of the background, but unlike normal Gimp
animation, you don't have to worry about covering up previous frames.

The effect is like taking the bottom layer, and flipping through
the rest of the layers on top of it, one at a time. This greatly reduces
the time involved in creating new animations, especially where a single
object is moving over a static background (more complex animation may
still require just as much work as before).

=head1 PARAMETERS

The script only asks if you want to work on a copy of the image. Otherwise,
you just need an image with a background layer and two or more layers
on top of it which represent your "cells".

=head1 AUTHOR

Written in 1999 (c) by Aaron Sherman E<lt>ajs@ajs.comE<gt>

=head1 BUGS

TBD

=head1 SEE ALSO

L<gimp>, L<perl>, L<Gimp>: the Gimp module for perl.

=cut