view release on metacpan or  search on metacpan

lib/Image/APNG.pm  view on Meta::CPAN

package Image::APNG ;

use strict ;
use warnings ;
use Image::Magick ;

our $VERSION = '1.0.0' ;

=head1 NAME

Image::APNG - Generate Animated PNG (APNG) files from individual PNG images

=head1 SYNOPSIS

	use Image::APNG;
	
	my $frames =
		[
			['frame1.png', 100],
			['frame2.png', 150],
			['frame3.png', 100]
		] ;
	
	my $options = 
		{
		loop_count           => 0,
		normalize_resolution => 1,
		background_color     => [255, 255, 255, 0]
		} ;
	
	my $result = Image::APNG::generate($frames, $options) ;
	
	if ($result->{status} == 0)
		{
		open my $fh, '>', 'output.png' ;
		binmode $fh ;
		print $fh $result->{data} ;
		close $fh ;
		}
	else
		{
		print "Errors: " . join("\n", @{$result->{errors}}) ;
		}

=head1 DESCRIPTION

Generates APNG files from a list of PNG images with individual frame delays.

=cut

#----------------------------------------------------------------------------------------------

sub generate
{
my ($frames, $options) = @_ ;

$options //= {} ;
my $errors = [] ;

my $default_options = 
	{
	optimize_palette     => 0,
	normalize_resolution => 0,
	target_resolution    => undef,
	background_color     => [0, 0, 0, 0],
	loop_count           => 0,
	disposal_method      => 1,
	blend_operation      => 1
	} ;

$options = {%$default_options, %$options} ;
return {status => 1, errors => ['No frames provided'], data => undef} unless $frames && @$frames ;

my $loaded_frames = load_frames($frames, $errors, $options) ;
return {status => 1, errors => $errors, data => undef} unless @$loaded_frames ;

$loaded_frames = normalize_frames($loaded_frames, $options, $errors)  if $options->{normalize_resolution} ;
$loaded_frames = optimize_palettes($loaded_frames, $errors)  if $options->{optimize_palette} ;

return
	{
	status => @$errors ? 1 : 0,
	errors => $errors,
	data => assemble_apng($loaded_frames, $options, $errors),
	} ;
}

#----------------------------------------------------------------------------------------------

sub load_frames
{
my ($frames, $errors, $options) = @_ ;

my ($loaded, $previous_valid) = ([]) ;

for my $frame_data (@$frames)
	{
	my ($filename, $delay_ms) = @$frame_data ;
	
	my $image  = Image::Magick->new() ;
	my $status = $image->Read($filename) ;
	
	if ($status)
		{
		push @$errors, "Failed to load $filename: $status" ;
		
		if ($previous_valid)
			{
			my $blank = $previous_valid->Clone() ;
			$blank->Quantize(colorspace => 'Transparent') ;
			
			push @$loaded, 
				{
				image  => $blank,
				delay  => $delay_ms,
				width  => $previous_valid->Get('width'),
				height => $previous_valid->Get('height')
				} ;
			}
		else
			{
			push @$errors, "Cannot create blank frame: no previous valid frame" ;
			}
		
		next ;
		}
	
	my $width  = $image->Get('width') ;
	my $height = $image->Get('height') ;
	
	push @$loaded,
		{
		image  => $image,
		delay  => $delay_ms,
		width  => $width,
		height => $height
		} ;
	
	$previous_valid = $image ;
	}

return $loaded ;
}

#----------------------------------------------------------------------------------------------

sub normalize_frames
{
my ($frames, $options, $errors) = @_ ;

my ($max_width, $max_height) ;

if ($options->{target_resolution})
	{
	($max_width, $max_height) = @{$options->{target_resolution}} ;
	}
else
	{
	$max_width  = 0 ;
	$max_height = 0 ;
	
	for my $frame (@$frames)
		{
		$max_width  = $frame->{width}  if $frame->{width}  > $max_width ;
		$max_height = $frame->{height} if $frame->{height} > $max_height ;
		}
	}

my $bg_color  = $options->{background_color} ;
my $bg_string = sprintf
		(
		'rgba(%d,%d,%d,%f)',
		$bg_color->[0],
		$bg_color->[1],
		$bg_color->[2],
		$bg_color->[3] / 255.0
		) ;

for my $frame (@$frames)
	{
	next if $frame->{width} == $max_width && $frame->{height} == $max_height ;
	
	my $canvas = Image::Magick->new(size => "${max_width}x${max_height}") ;
	$canvas->Read("xc:$bg_string") ;
	
	my $x_offset = int(($max_width - $frame->{width}) / 2) ;
	my $y_offset = int(($max_height - $frame->{height}) / 2) ;
	
	$canvas->Composite
			(
			image   => $frame->{image},
			x       => $x_offset,
			y       => $y_offset,
			compose => 'Over'
			) ;
	
	$frame->{image}  = $canvas ;
	$frame->{width}  = $max_width ;
	$frame->{height} = $max_height ;
	}

return $frames ;
}

#----------------------------------------------------------------------------------------------

sub optimize_palettes
{
my ($frames, $errors) = @_ ;

for my $frame (@$frames)
	{
	my $img = $frame->{image} ;
	
	my $status = $img->Quantize
				(
				colors     => 256,
				colorspace => 'RGB',
				dither     => 'True',
				treedepth  => 8,
				) ;
	
	push @$errors, "Palette optimization failed: $status" if $status ;
	
	$img->Set(type => 'Palette') ;
	}

return $frames ;
}

#----------------------------------------------------------------------------------------------

sub assemble_apng
{
my ($frames, $options, $errors) = @_ ;

my $first_frame = $frames->[0] ;
my $width       = $first_frame->{width} ;
my $height      = $first_frame->{height} ;

my $png_signature = pack('C8', 137, 80, 78, 71, 13, 10, 26, 10) ;

my $ihdr = create_ihdr($width, $height, $first_frame->{image}) ;