package Prima::Image::Animate;
use strict;
use warnings;
use Carp;
use Prima;
sub new
{
my $class = shift;
my $self = bless {
images => [],
model => 'gif',
@_,
current => -1,
}, $class;
$self-> reset;
return $self;
}
sub detect_animation
{
my (undef, $extras) = @_;
return undef unless # more than 1 frame?
$extras &&
defined($extras->{codecID}) &&
$extras->{frames} &&
$extras->{frames} > 1;
my $c = Prima::Image->codecs($extras-> {codecID}) or return 0;
return undef unless $c;
if ( $c->{name} eq 'GIFLIB') {
return 'GIF';
} elsif ($c->{name} =~ /^(WebP|PNG)$/) {
return $c->{name};
} else {
return undef;
}
}
sub load
{
my $class = shift;
my ( $where, %opt) = @_;
# have any custom notifications?
my ( %events, %args);
while ( my ( $k, $v) = each %opt) {
my $hash = ($k =~ /^on[A-Z]/ ? \%events : \%args);
$hash-> {$k} = $v;
}
my $i = Prima::Icon-> new(%events); # dummy object
my @i = grep { defined } $i-> load(
$where,
loadExtras => 1,
loadAll => 1,
iconUnmask => 1,
blending => 1,
%args,
);
warn $@ if @i && !$i[-1];
return unless @i;
my $model = $class->detect_animation($i[0]->{extras}) or return;
$model = 'Prima::Image::Animate::' . $model;
return $model-> new( images => \@i);
}
sub add
{
my ( $self, $image) = @_;
push @{$self-> {images}}, $image;
}
sub fixup_rect
{
my ( $self, $info, $image) = @_;
return if defined $info-> {rect};
$info-> {rect} = {
bottom => $self-> {screenHeight} - $info-> {top} - $image-> height,
top => $self-> {screenHeight} - $info-> {top} - 1,
right => $info-> {left} + $image-> width - 1,
left => $info-> {left},
};
}
sub union_rect
{
my ( $self, $r1, $r2) = @_;
return { %$r2 } unless grep { $r1-> {$_} } qw(left bottom right top);
return { %$r1 } unless grep { $r2-> {$_} } qw(left bottom right top);
my %ret = %$r1;
for ( qw(left bottom)) {
$ret{$_} = $r2-> {$_}
if $ret{$_} > $r2-> {$_};
}
for ( qw(right top)) {
$ret{$_} = $r2-> {$_}
if $ret{$_} < $r2-> {$_};
}
return \%ret;
}
sub reset
{
my $self = shift;
$self-> {current} = -1;
delete @{$self}{qw(canvas bgColor saveCanvas
saveMask image info
screenWidth screenHeight
loopCount changedRect cache
)};
my $i = $self-> {images};
return unless @$i;
my $ix = $i-> [0];
return unless $ix;
my $e = $self-> get_extras(0);
return unless $e;
$self-> {image} = $self-> {images}-> [0];
$self-> {info} = $e;
$self-> {$_} = $e-> {$_} for qw(screenWidth screenHeight);
$self-> {changedRect} = {};
$self-> fixup_rect( $e, $ix);
}
sub advance_frame
{
my $self = shift;
delete @{$self}{qw(image info)};
if ( ++$self-> {current} >= @{$self-> {images}}) {
# go back to first frame, or stop
if ( defined $self-> {loopCount}) {
return 0 if --$self-> {loopCount} <= 0;
}
$self-> {current} = 0;
}
$self-> {image} = $self-> {images}-> [$self-> {current}];
my $info = $self-> {info} = $self-> get_extras( $self-> {current} );
$self-> fixup_rect( $info, $self-> {image});
# load global extension data
if ( $self-> {current} == 0) {
unless ( defined $info-> {loopCount}) {
$self-> {loopCount} = 1;
} elsif ( $info-> {loopCount} == 0) {
# loop forever
$self-> {loopCount} = undef;
} elsif ( !defined $self->{loopCount}) {
$self-> {loopCount} = $info-> {loopCount};
}
}
return 1;
}
sub next { die }
sub icon { die }
sub image { die }
sub draw { die }
sub get_extras { die }
sub draw_background
{
my ( $self, $canvas, $x, $y) = @_;
return 0 unless $self-> {canvas};
my $a = $self->bgAlpha // 0xff;
return 0 if $a == 0 || !defined $self->bgColor;
if ( $a == 0xff ) {
my $c = $canvas->color;
$canvas->color($self->bgColor);
$canvas->bar($x, $y, $x + $self->{screenWidth}, $y + $self->{screenHeight});
$canvas->color($c);
} else {
my $px = $self->{cache}->{bgpixel} //= Prima::Icon->new(
size => [1,1],
type => im::RGB,
maskType => im::bpp8,
data => join('', map { chr } cl::to_bgr($self->bgColor)),
mask => chr($a),
);
$canvas->stretch_image( $x, $y, $self->{screenWidth}, $self->{screenHeight}, $px, rop::SrcOver);
}
return 1;
}
sub is_stopped
{
my $self = shift;
return $self-> {current} >= @{$self-> {images}};
}
sub width { $_[0]-> {canvas} ? $_[0]-> {canvas}-> width : 0 }
sub height { $_[0]-> {canvas} ? $_[0]-> {canvas}-> height : 0 }
sub size { $_[0]-> {canvas} ? $_[0]-> {canvas}-> size : (0,0) }
sub bgColor { $_[0]-> {bgColor} }
sub bgAlpha { $_[0]-> {bgAlpha} }
sub current { $_[0]-> {current} }
sub total { scalar @{$_[0]-> {images}} }
sub length
{
my $length = 0;
$length += $_-> {delayTime} || 0 for
map { $_-> {extras} || {} }
@{$_[0]-> {images}};
return $length / 1000;
}
sub loopCount
{
return $_[0]-> {loopCount} unless $#_;
$_[0]-> {loopCount} = $_[1];
}
package Prima::Image::Animate::GIF;
use base 'Prima::Image::Animate';
use constant DISPOSE_NOT_SPECIFIED => 0; # Leave frame, let new frame draw on top
use constant DISPOSE_KEEP => 1; # Leave frame, let new frame draw on top
use constant DISPOSE_CLEAR => 2; # Clear the frame's area, revealing bg
use constant DISPOSE_RESTORE_PREVIOUS => 3; # Restore the previous (composited) frame
sub get_extras
{
my ( $self, $ix) = @_;
$ix = $self-> {images}-> [$ix];
return unless $ix;
my $e = $ix-> {extras} || {};
$e-> {screenHeight} ||= $ix-> height;
$e-> {screenWidth} ||= $ix-> width;
$e-> {$_} ||= 0 for qw(disposalMethod useScreenPalette delayTime left top);
# gif doesn't support explicit masks, therefore
# when image actually has a mask, autoMaskign is set to am::Index
$e-> {iconic} = $ix-> isa('Prima::Icon') && $ix-> autoMasking != am::None;
return $e;
}
sub next
{
my $self = shift;
my %ret;
# dispose from the previous frame and calculate the changed rect
my $info = $self->{info};
my @sz = ( $self-> {screenWidth}, $self-> {screenHeight});
# dispose from the previous frame and calculate the changed rect
if ( $info-> {disposalMethod} == DISPOSE_CLEAR) {
$self-> {canvas}-> backColor( 0);
$self-> {canvas}-> clear;
$self-> {mask}-> backColor(cl::Set);
$self-> {mask}-> clear;
%ret = %{ $self-> {changedRect} };
$self-> {changedRect} = {};
} elsif ( $info-> {disposalMethod} == DISPOSE_RESTORE_PREVIOUS) {
# cut to the previous frame, that we expect to be saved for us
if ( $self-> {saveCanvas} && $self-> {saveMask}) {
$self-> {canvas} = $self-> {saveCanvas};
$self-> {mask} = $self-> {saveMask};
}
$self-> {changedRect} = $self-> {saveRect};
delete $self-> {saveCanvas};
delete $self-> {saveMask};
delete $self-> {saveRect};
%ret = %{ $info-> {rect} };
}
return unless $self->advance_frame;
$info = $self->{info};
if ( $info-> {disposalMethod} == DISPOSE_RESTORE_PREVIOUS) {
my $c = Prima::DeviceBitmap-> new(
width => $sz[0],
height => $sz[1],
type => dbt::Pixmap,
);
$c-> put_image( 0, 0, $self-> {canvas});
$self-> {saveCanvas} = $self-> {canvas};
$self-> {canvas} = $c;
$c = Prima::DeviceBitmap-> new(
width => $sz[0],
height => $sz[1],
type => dbt::Bitmap,
);
$c-> put_image( 0, 0, $self-> {mask});
$self-> {saveMask} = $self-> {mask};
$self-> {mask} = $c;
$self-> {saveRect} = $self-> {changedRect};
}
$self-> {changedRect} = $self->union_rect( $self-> {changedRect}, $info-> {rect});
%ret = %{ $self->union_rect( \%ret, $info-> {rect}) };
# draw the current frame
if ( $info-> {iconic}) {
my ( $xor, $and) = $self-> {image}-> split;
# combine masks
$self-> {mask}-> set(
color => cl::Clear,
backColor => cl::Set,
);
$self-> {mask}-> put_image(
$info-> {rect}-> {left},
$info-> {rect}-> {bottom},
$and,
rop::AndPut,
);
} else {
my @is = $self->{image}->size;
$self-> {mask}-> color(cl::Clear);
$self-> {mask}-> bar(
$info-> {rect}-> {left},
$info-> {rect}-> {bottom},
$info-> {rect}-> {left} + $is[0],
$info-> {rect}-> {bottom} + $is[1],
);
}
# put non-transparent image pixels
$self-> {canvas}-> put_image(
$info-> {rect}-> {left},
$info-> {rect}-> {bottom},
$self-> {image},
);
$ret{$_} ||= 0 for qw(left bottom right top);
$ret{delay} = $info-> {delayTime} / 100;
return \%ret;
}
sub reset
{
my $self = shift;
$self-> SUPER::reset;
my $e = $self-> get_extras(0);
return unless $e;
$self-> {$_} = $e-> {$_} for qw(screenWidth screenHeight);
# create canvas and mask
$self-> {canvas} = Prima::DeviceBitmap-> new(
width => $e-> {screenWidth},
height => $e-> {screenHeight},
type => dbt::Pixmap,
backColor => 0,
);
$self-> {canvas}-> clear; # canvas is all-0 initially
$self-> {mask} = Prima::DeviceBitmap-> new(
width => $e-> {screenWidth},
height => $e-> {screenHeight},
type => dbt::Bitmap,
backColor => 0xFFFFFF,
color => 0x000000,
);
$self-> {mask}-> clear; # mask is all-1 initially
if ( defined $e-> {screenBackGroundColor}) {
my $cm =
$e-> {useScreenPalette} ?
$e-> {screenPalette} :
$self-> {images}-> [0]-> palette;
my $i = $e-> {screenBackGroundColor} * 3;
$self-> {bgColor} = cl::from_rgb(map { $_ || 0 } @$cm[$i..$i+2]);
$self-> {bgAlpha} = 0xff;
}
}
sub icon
{
my $self = shift;
my $i = Prima::Icon-> new;
$i-> combine( $self-> {canvas}-> image, $self-> {mask}-> image);
return $i;
}
sub image
{
my $self = shift;
my $i = Prima::Image-> new(
width => $self-> {canvas}-> width,
height => $self-> {canvas}-> height,
type => im::RGB,
backColor => $self-> {bgColor} || 0,
);
$i-> begin_paint;
$i-> clear;
$i-> set(
color => cl::Clear,
backColor => cl::Set,
);
$i-> put_image( 0, 0,$self-> {mask}, rop::AndPut);
$i-> put_image( 0, 0,$self-> {canvas}, rop::XorPut);
$i-> end_paint;
return $i;
}
sub draw
{
my ( $self, $canvas, $x, $y) = @_;
return unless $self-> {canvas};
my %save = map { $_ => $canvas-> $_() } qw(color backColor);
$canvas-> set(
color => cl::Clear,
backColor => cl::Set,
);
$canvas-> put_image( $x, $y, $self-> {mask}, rop::AndPut);
$canvas-> put_image( $x, $y, $self-> {canvas}, rop::XorPut);
$canvas-> set( %save);
}
package Prima::Image::Animate::WebPNG;
use base 'Prima::Image::Animate';
sub new
{
my ( $class, %opt ) = @_;
# rop::SrcCopy works only with 8-bit alpha
for (@{ $opt{images} // [] }) {
$_->maskType(im::bpp8) if $_->isa('Prima::Icon');
}
return $class->SUPER::new(%opt);
}
sub get_extras
{
my ( $self, $ix) = @_;
$ix = $self-> {images}-> [$ix];
return unless $ix;
my $e = $ix-> {extras} || {};
$e-> {screenHeight} ||= $ix-> height;
$e-> {screenWidth} ||= $ix-> width;
$e-> {$_} ||= 0 for qw(disposalMethod blendMethod delayTime left top);
return $e;
}
sub next
{
my $self = shift;
my $info = $self->{info};
my %ret;
if ( $info-> {disposalMethod} eq 'restore') {
# cut to the previous frame, that we expect to be saved for us
if ( $self-> {saveCanvas} ) {
$self-> {canvas} = $self-> {saveCanvas};
}
delete $self-> {saveCanvas};
%ret = %{ $info-> {rect} };
} elsif ( $info-> {disposalMethod} eq 'background') {
# dispose from the previous frame and calculate the changed rect
$self-> {canvas}-> color(cl::Clear);
$self-> {canvas}-> bar(
$info-> {rect}-> {left},
$info-> {rect}-> {bottom},
$self->{image}->width + $info-> {rect}-> {left} - 1,
$self->{image}->height + $info-> {rect}-> {bottom} - 1
);
%ret = %{ $info-> {rect} };
}
return unless $self->advance_frame;
$info = $self->{info};
@{$self}{qw(saveCanvas canvas)} = ($self->{canvas}, $self->{canvas}->dup)
if $info-> {disposalMethod} eq 'restore';
%ret = %{ $self->union_rect( \%ret, $info-> {rect}) };
# draw the current frame
$self-> {canvas}-> put_image(
$info-> {rect}-> {left},
$info-> {rect}-> {bottom},
$self-> {image},
(( $info-> {blendMethod} eq 'blend') ? rop::SrcOver : rop::SrcCopy)
);
$ret{$_} ||= 0 for qw(left bottom right top);
$ret{delay} = $info-> {delayTime} / 1000;
return \%ret;
}
sub reset
{
my $self = shift;
$self-> SUPER::reset;
my $e = $self-> get_extras(0);
return unless $e;
$self-> {canvas} = Prima::DeviceBitmap-> new(
width => $e-> {screenWidth},
height => $e-> {screenHeight},
type => dbt::Layered,
backColor => 0,
);
$self-> {canvas}-> clear; # canvas is black and transparent
if ( defined $e-> {background}) {
$self-> {bgColor} = cl::from_rgb(cl::to_bgr($e->{background} & 0xffffff));
$self-> {bgAlpha} = ($e->{background} >> 24) & 0xff;
}
}
sub icon { shift->{canvas}->icon }
sub image { shift->{canvas}->image }
sub draw
{
my ( $self, $canvas, $x, $y) = @_;
$canvas-> put_image( $x, $y, $self-> {canvas}, rop::SrcOver) if $self->{canvas};
}
package Prima::Image::Animate::WebP;
use base 'Prima::Image::Animate::WebPNG';
package Prima::Image::Animate::PNG;
use base 'Prima::Image::Animate::WebPNG';
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
my $i = $self->{images} // [];
shift @$i if @$i > 1 && $i->[0]->{extras}->{default_frame};
return $self;
}
1;
__END__
=pod
=head1 NAME
Prima::Image::Animate - animate gif,webp,png files
=head1 DESCRIPTION
The module provides high-level access to GIF, APNG, and WebP animation sequences.
=head1 SYNOPSIS
use Prima qw(Application Image::Animate);
my $x = Prima::Image::Animate->load($ARGV[0]);
die $@ unless $x;
my ( $X, $Y) = ( 0, 100);
my $want_background = 1; # 0 for eventual transparency
my $background = $::application-> get_image( $X, $Y, $x-> size);
$::application-> begin_paint;
while ( my $info = $x-> next) {
my $frame = $background-> dup;
$frame-> begin_paint;
$x-> draw_background( $frame, 0, 0) if $want_background;
$x-> draw( $frame, 0, 0);
$::application-> put_image( $X, $Y, $frame);
$::application-> sync;
select(undef, undef, undef, $info-> {delay});
}
$::application-> put_image( $X, $Y, $g);
=head2 new $CLASS, %OPTIONS
Creates an empty animation container. If C<$OPTIONS{images}> is given, it is
expected to be an array of images, best if loaded from gif files with
C<loadExtras> and C<iconUnmask> parameters set ( see L<Prima::image-load> for
details).
=head2 detect_animation $HASH
Checks C<{extras} hash> obtained from a image loaded with C<loadExtras> flag set,
to detect whether the image is an animation, and if loading all of its frame is
supported by the module. Returns file format name on success, undef otherwise.
=head2 load $SOURCE, %OPTIONS
Loads GIF or WebP animation sequence from file or stream C<$SOURCE>. Options
are the same as understood by C<Prima::Image::load>, and are passed
down to it.
=head2 add $IMAGE
Appends an image frame to the container.
=head2 bgColor
Return the background color specified by the sequence as the preferred
background color to use when there is no specific background to superimpose the
animation to.
=head2 current
Return index of the current frame
=head2 draw $CANVAS, $X, $Y
Draws the current composite frame on C<$CANVAS> at the given coordinates.
=head2 draw_background $CANVAS, $X, $Y
Fills the background on C<$CANVAS> at the given coordinates if file provides that.
Returns whether the canvas was tainted or not.
=head2 height
Returns height of the composite frame.
=head2 icon
Creates and returns an icon object off the current composite frame.
=head2 image
Creates and returns an image object off the current composite frame. The
transparent pixels on the image are replaced with the preferred background
color.
=head2 is_stopped
Returns true if the animation sequence was stopped, false otherwise.
If the sequence was stopped, the only way to restart it is to
call C<reset>.
=head2 length
Returns total animation length (without repeats) in seconds.
=head2 loopCount [ INTEGER ]
Sets and returns number of loops left, undef for indefinite.
=head2 next
Advances one animation frame. The step triggers changes to the internally kept
icon image that create effect of transparency, if needed. The method returns a
hash, where the following fields are initialized:
=over
=item left, bottom, right, top
Coordinates of the changed area since the last frame was updated.
=item delay
Time in seconds how long the frame is expected to be displayed.
=back
=head2 reset
Resets the animation sequence. This call is necessary either when image sequence was altered,
or when sequence display restart is needed.
=head2 size
Returns width and height of the composite frame.
=head2 total
Return number fo frames
=head2 width
Returns width of the composite frame.
=head1 SEE ALSO
L<Prima::image-load>
=head1 AUTHOR
Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
=cut