use strict;
use warnings;
use POSIX qw(ceil);
use Switch;
use Image::Magick;
use Term::ANSIScreen qw/:color :cursor :screen/;
use Win32::Console::ANSI qw/ Cursor /;
use XML::Simple;
	$XML::Simple::PREFERRED_PARSER  = 'XML::Parser';
use constant FATAL => colored ['white on red'], "\aFATAL ERROR: ";
#===== Copyright 2009, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# anim_reassemble.pl: Creates an animated GIF that re-assembles an image.
#===============================================================================================================================
#           Usage : perl anim_reassemble.pl XmlFile
#       Arguments : XmlFile = path of XML file for the animation specifications.
#     Input Files : See arguments.
#    Output Files : The animated GIF specified in the XML data file.
# Temporary Files : None.
#         Remarks : See http://www.webpraxis.ab.ca/transits/anim_reassemble.shtml for details.
#         History : v1.0.0 - September 17, 2009 - Original release.
#===============================================================================================================================
# 0) INITIALIZE:
$| = 1; 																				#set STDOUT buffer to auto-flush
cls();																					#clear screen
print colored ['black on white'], "$0\n\n\n",											#display program name
	  colored ['reset'], 'Initializing... ';											#report start of initialization
srand( time() ^ ($$ + ($$ << 15)) );                                					#seed the random number generator

my $XmlFile		= shift || die FATAL, 'No XML file specified';							#get path of XML data file
my $Anim		= XMLin( $XmlFile );													#read the XML data file

my $ImageFile	= $$Anim{image}{file};													#parameterize path of source image file
my $AnimFile	= $$Anim{output};														#parameterize path of target image file
my $TileWidth	= $$Anim{tile}{width};													#parameterize pixel width of a tile
my $TileHeight 	= $$Anim{tile}{height};													#parameterize pixel height of a tile
my @Spinners	= ( '-', '\\', '|', '/' );												#define symbols for spinner
die FATAL, "Cannot locate image file\n" unless -e $ImageFile;
print colored ['bold green'], "XML data read\n\n";										#report end of initialization
#-------------------------------------------------------------------------------------------------------------------------------
# 1) ADJUST IMAGE DIMENSIONS FOR AN INTEGRAL NUMBER OF TILES:
my $Image			= Image::Magick->new( magick => 'GIF' );							#instantiate an image object for the image
	$Image->Read( "$ImageFile" );														#init with source image file
my ( $ImageWidth,																		#get width & height of source image
	 $ImageHeight )	= $Image->Get( 'width', 'height' );

my $NoTileCols		= POSIX::ceil( $$Anim{image}{scale} * $ImageWidth  / $TileWidth  );	#compute integral number of tile columns
my $NoTileRows		= POSIX::ceil( $$Anim{image}{scale} * $ImageHeight / $TileHeight );	#compute integral number of tile rows
my $TileCount		= $NoTileCols * $NoTileRows;										#compute total number of tiles

my $CanvasWidth		= $NoTileCols * $TileWidth;											#set canvas width
my $CanvasHeight	= $NoTileRows * $TileHeight;                            			#set canvas height

$Image->Scale( geometry=>"${CanvasWidth}x${CanvasHeight}!" );							#scale image

print	"\r", clline,							  										#echo initialization results
		colored ['reset'], 'Source Image:    ', colored ['bold white'], $ImageFile, "\n",
		colored ['reset'], '  Width:         ', colored ['bold white'], $ImageWidth, " px\n",
		colored ['reset'], '  Height:        ', colored ['bold white'], $ImageHeight, " px\n",
		colored ['reset'], 'Target Image:    ', colored ['bold white'], $AnimFile, "\n",
		colored ['reset'], '  Width:         ', colored ['bold white'], $CanvasWidth, " px\n",
		colored ['reset'], '  Height:        ', colored ['bold white'], $CanvasHeight, " px\n",
		colored ['reset'], 'Tile Details:    ', colored ['bold white'], $TileCount, " tiles\n",
		colored ['reset'], '  No. of rows:   ', colored ['bold white'], $NoTileRows, "\n",
		colored ['reset'], '  No. of cols:   ', colored ['bold white'], $NoTileCols, "\n",
		colored ['reset'], '  Tile width:    ', colored ['bold white'], $TileWidth, " px\n",
		colored ['reset'], '  Tile height:   ', colored ['bold white'], $TileHeight, " px\n\n",
		colored ['reset'], '-' x 80, "\n\n";
#-------------------------------------------------------------------------------------------------------------------------------
# 2) CREATE TILE IMAGES AND RECORD THEIR PROVENANCE:
print 'Creating tile images... ';														#report start of tile processing
my ( $CursorX, $CursorY ) = Cursor(); 													#record cursor position

my $Tiles		= Image::Magick->new( magick => 'GIF' );								#instantiate an image object for the tiles
my @Tile_X_end;																			#array for tile top-left end x-coordinates
my @Tile_Y_end;																			#array for tile top-left end y-coordinates
{																						#start naked block as firewall
	my $tile	= Image::Magick->new( magick => 'GIF' );								# instantiate an image object for a tile

	for (	my $y_topLeft	= 0;														# for each tile row: start at top and work down
			$y_topLeft		<= $CanvasHeight - $TileHeight;
			$y_topLeft		+= $TileHeight
		) {
		for (	my $x_topLeft	= 0;													#  for each tile column: work left to right
				$x_topLeft		<= $CanvasWidth - $TileWidth;
				$x_topLeft		+= $TileWidth
			) {
			my $geometry	= "${TileWidth}x${TileHeight}+$x_topLeft+$y_topLeft";		#   define tile geometry
			$tile 			= $Image->Clone();											#   init tile with image
			$tile->Crop( geometry => $geometry );										#   crop tile area
			$tile->Set( page => '0x0+0+0' );											#   shrink canvas
			push @$Tiles, @$tile;														#   store the tile image
			push @Tile_X_end, $x_topLeft;												#   store the tile end coords
			push @Tile_Y_end, $y_topLeft;
			print	locate( $CursorY, $CursorX ), clline,								#   report tile processing
					colored ['bold yellow'], '(', $Spinners[$#$Tiles % 4], ')';
		}																				#  until all tile columns processed
	}																					# until all tile rows processed
	undef $tile;																		# destroy the tile image object
}																						#end naked block
print	locate( $CursorY, $CursorX ), clline,											#report end of tile processing
		colored ['bold green'], scalar @Tile_X_end, " tiles\n\n";
#-------------------------------------------------------------------------------------------------------------------------------
# 3) ASSIGN STARTING COORDINATES FOR THE TILES:
my @Tile_X_start;																		#array for top-left start x-coordinates
my @Tile_Y_start;																		#array for top-left start y-coordinates

print 'Setting start coordinates... ';													#report start of coordinate processing
{																						#start naked block
	my $maxX = $CanvasWidth  - $TileWidth;												# largest top-left x-coordinate
	my $maxY = $CanvasHeight - $TileHeight;												# largest top-left y-coordinate
	my $supX = $maxX + 1;																# supremum of the random x-coordinates
	my $supY = $maxY + 1;																# supremum of the random y-coordinates

	switch ( $$Anim{startLocation} ) {
		case 'top'			{	push @Tile_X_start, int( rand $supX ) for ( 1..$TileCount );
								@Tile_Y_start = ( 0 ) x $TileCount;
							}
		case 'bottom'		{	push @Tile_X_start, int( rand $supX ) for ( 1..$TileCount );
								@Tile_Y_start = ( $maxY ) x $TileCount;
							}
		case 'left'			{	@Tile_X_start = ( 0 ) x scalar @Tile_X_end;
								push @Tile_Y_start, int( rand $supY ) for ( 1..$TileCount );
							}
		case 'right'		{	@Tile_X_start = ( $maxX ) x $TileCount;
								push @Tile_Y_start, int( rand $supY ) for ( 1..$TileCount );
							}
		case 'topAndBottom'	{	for ( 1..$TileCount ) {
									push @Tile_X_start, int rand $supX;
									push @Tile_Y_start, ( int rand 2 ) ? 0 : $maxY;
								}
							}
		case 'leftAndRight'	{	for ( 1..$TileCount ) {
									push @Tile_X_start, ( int rand 2 ) ? 0 : $maxX;
									push @Tile_Y_start, int rand $supY;
								}
							}
		case 'allSides'		{	for ( 1..$TileCount ) {
									switch ( int rand 4 ) {
										case 0	{	push @Tile_X_start, 0;
													push @Tile_Y_start, int rand $supY;
												}
										case 1	{	push @Tile_X_start, $maxX;
													push @Tile_Y_start, int rand $supY;
												}
										case 2	{	push @Tile_X_start, int rand $supX;
													push @Tile_Y_start, 0;
												}
										case 3	{	push @Tile_X_start, int rand $supX;
													push @Tile_Y_start, $maxY;
												}
									}
								}
							}
		case 'topLeft'		{	@Tile_X_start = ( 0 ) x $TileCount;
								@Tile_Y_start = ( 0 ) x $TileCount;
							}
		case 'bottomLeft'	{	@Tile_X_start = ( 0 ) x $TileCount;
								@Tile_Y_start = ( $maxY ) x $TileCount;
							}
		case 'topRight'		{	@Tile_X_start = ( $maxX ) x $TileCount;
								@Tile_Y_start = ( 0 ) x $TileCount;
							}
		case 'bottomRight'	{	@Tile_X_start = ( $maxX ) x $TileCount;
								@Tile_Y_start = ( $maxY ) x $TileCount;
							}
		case 'center'		{	@Tile_X_start = ( int $maxX / 2 ) x $TileCount;
								@Tile_Y_start = ( int $maxY / 2 ) x $TileCount;
							}
		case 'random'		{	for( 1..$TileCount ) {
									push @Tile_X_start, int rand $supX;
									push @Tile_Y_start, int rand $supY;
								}
							}
		else				{	die FATAL, "Unrecognised/unspecified start location\n";
							}
	}
}																						#end naked block
print colored ['bold green'], $$Anim{startLocation}, "\n\n";							#report end of coordinate processing
#-------------------------------------------------------------------------------------------------------------------------------
# 4) CREATE ANIMATION FRAMES:
print 'Creating animation frames... ';													#report start of frame processing
( $CursorX, $CursorY )	= Cursor();														#record cursor position

my $Canvas				= Image::Magick->new( magick => 'GIF' );						#instantiate an image object for the canvas
my $Frames				= Image::Magick->new( magick => 'GIF' );						#instantiate an image object for animation frames
my $FrameNo				= 0;															#init no of animation frames
my $Interpolate			= sub	{	my ( $lambda, $start, $end ) = @_;					#anonymous sub for interpolating x,y-coordinates
									int( $lambda * $end + ( 1. - $lambda ) * $start );
								};
my $DeltaLambda			= 1. / ( $$Anim{frames} + 1. );									#set transit step-size

for( my $lambda = 0.; $lambda < 1. - $DeltaLambda/2.; $lambda += $DeltaLambda ) {		#repeat for each transit step, except last
	@$Canvas = ();																		# clear canvas
	$Canvas->Set( size => "${CanvasWidth}x${CanvasHeight}" );							# set canvas size
	$Canvas->ReadImage( 'xc:transparent' );												# set canvas background to transparent
	for( 0..$TileCount-1 ) {															# repeat for each tile
		my $x_topLeft	= &$Interpolate( $lambda, $Tile_X_start[$_], $Tile_X_end[$_] );	#  compute top-left x-coordinate
		my $y_topLeft	= &$Interpolate( $lambda, $Tile_Y_start[$_], $Tile_Y_end[$_] );	#  compute top-left y-coordinate
		$Canvas->Composite																#  add tile to canvas
					(	image		=> $Tiles->[$_],
						compose		=> 'Over',
						geometry	=> "${TileWidth}x${TileHeight}+$x_topLeft+$y_topLeft"
					);
	}																					# until all tiles processed
	push @$Frames, @$Canvas;															# add canvas to image sequence
	print	locate( $CursorY, $CursorX ), clline,										# report frame processing
			colored ['bold yellow'], '(', $Spinners[++$FrameNo % 4], ')';
}																						#until all but last transit steps done
push @$Frames, @$Image;																	#add full image as last frame
print	locate( $CursorY, $CursorX ), clline,											#report end of frame processing
		colored ['bold green'], ++$FrameNo, " frames\n\n";
undef $Canvas;																			#destroy the canvas object
undef $Image;																			#destroy the source image object
undef $Tiles;																			#destroy the image object for the tiles
#-------------------------------------------------------------------------------------------------------------------------------
# 5) CREATE ANIMATED GIF IMAGE:
print 'Creating animated GIF image... ';												#report start of animation processing
@$Frames = reverse @$Frames if $$Anim{inverse};											#process any inverse request
$Frames->Write																			#output the animation
			(	delay		=> $$Anim{delay},
				loop		=> $$Anim{loops},
				dispose		=> 'background',
				filename	=> $AnimFile
			);
print colored ['bold green'], $AnimFile, "\n";											#report end of animation processing
exit;
#===== Copyright 2009, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# end of anim_reassemble.pl
