use strict;
use warnings;
use POSIX qw(ceil);
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_blinds.pl: Creates an animated GIF that rotates horizontal/vertical 3D "blinds" but with multiple images.
#===============================================================================================================================
#           Usage : perl anim_blinds.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/flips/anim_blinds.shtml for details.
#         History : v1.0.0 - September 28, 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

my $XmlFile		= shift || die FATAL, 'No XML file specified';							#get path of XML data file
my $Anim		= XMLin( $XmlFile, ForceArray => [qw(image)] );							#read the XML data file
my $ImgWidth	= $$Anim{imageDims}{width};												#parameterize the width of the images
my $ImgHeight	= $$Anim{imageDims}{height};											#parameterize the height of the images
my $SlatWidth	= $$Anim{slats}{width};													#parameterize the width of a slat
my $SlatStretch	= $$Anim{slats}{stretch};												#parameterize the slat distortion
my $Simulation	= $$Anim{simulation};													#parameterize the simulation request
my $NoImages	= @{ $$Anim{image} };													#get the number of source images
my @Spinners	= ( '-', '\\', '|', '/' );												#define symbols for spinner

my $NoSlats;																			#number of slats per source image
my $CanvasWidth;																		#frame canvas width in pixels
my $CanvasHeight;																		#frame canvas height in pixels
if( $Simulation eq 'vertical' ) {														#if vertical slats requested
	$NoSlats		= POSIX::ceil( $ImgWidth / $SlatWidth );							# compute integral number of slats
	$ImgWidth		= $NoSlats * $SlatWidth;											# adjust source image width
	$CanvasWidth	= $ImgWidth;														# set frame canvas width
	$CanvasHeight	= $ImgHeight + 2 * $SlatStretch;									# set frame canvas height
} elsif( $Simulation eq 'horizontal' ) {												#else if horizontal slats requested
	$NoSlats		= POSIX::ceil( $ImgHeight / $SlatWidth );							# compute integral number of slats
	$ImgHeight		= $NoSlats * $SlatWidth;											# adjust source image height
	$CanvasWidth	= $ImgWidth + 2 * $SlatStretch;										# set frame canvas width
	$CanvasHeight	= $ImgHeight;														# set frame canvas height
} else {																				#else unknown/undefined simulation
	die FATAL, "Invalid simulation request '$Simulation'\n";
}																						#end if-elsif-else
print colored ['bold green'], "XML data read\n\n";										#report end of initialization
#-------------------------------------------------------------------------------------------------------------------------------
# 1) LOAD AND SCALE THE IMAGES:
print 'Reading & scaling images... ';													#report start of image processing
my $Images = Image::Magick->new( magick => 'JPG' );										#instantiate an object for the images

die FATAL, "Even number of images required\n" if $NoImages % 2;							#check for even number of images
for( 0..$NoImages-1 ) {																	#repeat for each source image
	my $file = $$Anim{image}[$_];														# parameterize the file name
	die FATAL, "Cannot locate image file '$file'\n" unless -e $file;					# check image existence
	$Images->Read( $file );																# read image file
}																						#until all images processed
$Images->Quantize( colors => 256, colorspace => 'RGB' );								#ensure uniform color space
$Images->Scale( geometry => "${ImgWidth}x${ImgHeight}!" );								#scale images to adjusted dimensions
print colored ['bold green'], "Done\n\n";												#report end of image processing
#-------------------------------------------------------------------------------------------------------------------------------
# 2) CREATE SLAT IMAGES:
print 'Creating slat images... ';														#report start of slat processing
my ( $CursorX, $CursorY ) = Cursor(); 													#record cursor position

my $Slats		= Image::Magick->new( magick => 'GIF' );								#instantiate an image object for the slats
{																						#start naked block as firewall
	my $slat	= Image::Magick->new( magick => 'GIF' );								# instantiate an image object for a slat

	if( $Simulation eq 'vertical' ) {													# if vertical slats requested
		for my $imgIdx ( 0..$NoImages-1 ) {												#  repeat for each source image
			for (	my $x_topLeft	= 0;												#   for each slat: work left to right
					$x_topLeft		<= $ImgWidth - $SlatWidth;
					$x_topLeft		+= $SlatWidth
				) {
				my $geometry	= "${SlatWidth}x${ImgHeight}+$x_topLeft+0";				#    define slat geometry
				$slat 			= $Images->[$imgIdx]->Clone();							#    init slat with image
				$slat->Crop( geometry => $geometry );									#    crop slat area
				$slat->Set( page => '0x0+0+0' );										#    shrink canvas
				push @$Slats, @$slat;													#    store the slat image
				print	locate( $CursorY, $CursorX ), clline,							#    report slat processing
						colored ['bold yellow'], '(', $Spinners[$#$Slats % 4], ')';
			}																			#   until all slats created
		}																				#  until all images processed
	} else {																			# else horizontal slats requested
		for my $imgIdx ( 0..$NoImages-1 ) {												#  repeat for each source image
			for (	my $y_topLeft	= 0;												#   for each slat: work top to bottom
					$y_topLeft		<= $ImgHeight - $SlatWidth;
					$y_topLeft		+= $SlatWidth
				) {
				my $geometry	= "${ImgWidth}x${SlatWidth}+0+$y_topLeft";				#    define slat geometry
				$slat 			= $Images->[$imgIdx]->Clone();							#    init slat with image
				$slat->Crop( geometry => $geometry );									#    crop slat area
				$slat->Set( page => '0x0+0+0' );										#    shrink canvas
				push @$Slats, @$slat;													#    store the slat image
				print	locate( $CursorY, $CursorX ), clline,							#    report slat processing
						colored ['bold yellow'], '(', $Spinners[$#$Slats % 4], ')';
			}																			#   until all slats created
		}																				#  until all images processed
	}																					# end if-else
	undef $slat;																		# destroy the slat image object
}																						#end naked block
print	locate( $CursorY, $CursorX ), clline,											#report end of slat processing
		colored ['bold green'], scalar @$Slats, " slats\n\n";
undef $Images;																			#destroy the source image object
#-------------------------------------------------------------------------------------------------------------------------------
# 3) 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 frame 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 turn step-size

my $SlatX_topLeft;																		#top-left corner coords for 2D slat
my $SlatY_topLeft;
my $SlatX_bottomRight;																	#bottom-right corner coords for 2D slat
my $SlatY_bottomRight;
my $SlatX_mid;																			#mid coord along x-axis
my $SlatY_mid;																			#mid coord along y-axis
if( $Simulation eq 'vertical' ) {														#if vertical slats requested
	$SlatX_mid			= ( $SlatWidth - 1 ) / 2;										# set mid coord along x-axis
	$SlatX_topLeft 		= 0;															# set top-left corner coords
	$SlatY_topLeft		= $SlatStretch;
	$SlatX_bottomRight	= $SlatWidth - 1;												# set bottom-right corner coords
	$SlatY_bottomRight	= $CanvasHeight - $SlatStretch - 1;
} else {																				#else horizontal slats requested
	$SlatY_mid			= ( $SlatWidth - 1 ) / 2;										# set mid coord along y-axis
	$SlatX_topLeft		= $SlatStretch;													# set top-left corner coords
	$SlatY_topLeft 		= 0;
	$SlatX_bottomRight	= $CanvasWidth  - $SlatStretch - 1;								# set bottom-right corner coords
	$SlatY_bottomRight	= $SlatWidth;
}																						#end if-else

my $x_left;																				#perspective apex coords for vertical slats
my $x_right;
my $y_topLeft;
my $y_bottomLeft;
my $y_topRight;
my $y_bottomRight;

my $y_top;																				#perspective apex coords for horizontal slats
my $y_bottom;
my $x_topLeft;
my $x_bottomLeft;
my $x_topRight;
my $x_bottomRight;

for my $imgIdx ( 0..$NoImages - 1 ) {													#repeat for each pairing of images
	#QUARTER RIGHT-HAND-RULE TURN OF RECTO SLATS:
	for( my $lambda = 0.; $lambda < 1. - $DeltaLambda/2.; $lambda += $DeltaLambda ) {	# repeat for each turn step
		if( $Simulation eq 'vertical' ) {												#   interpolate apex coords
			$x_left			= &$Interpolate( $lambda,	$SlatX_topLeft,		$SlatX_mid							);
			$x_right		= &$Interpolate( $lambda,	$SlatX_bottomRight,	$SlatX_mid							);
			$y_topLeft		= &$Interpolate( $lambda, 	$SlatY_topLeft,		0									);
			$y_bottomLeft	= &$Interpolate( $lambda,	$SlatY_bottomRight,	$SlatY_bottomRight	+ $SlatStretch	);
			$y_topRight		= &$Interpolate( $lambda, 	$SlatY_topLeft,		$SlatY_topLeft		+ $SlatStretch	);
			$y_bottomRight	= &$Interpolate( $lambda,	$SlatY_bottomRight,	$SlatY_bottomRight	- $SlatStretch 	);
			&drawVerticalSlats( $imgIdx );							 					#   draw all the image's slats
		} else {																		#   interpolate apex coords
			$y_top			= &$Interpolate( $lambda,	$SlatY_topLeft,		$SlatY_mid							);
			$y_bottom		= &$Interpolate( $lambda,	$SlatY_bottomRight,	$SlatY_mid							);
			$x_topLeft		= &$Interpolate( $lambda, 	$SlatX_topLeft,		$SlatX_topLeft		+ $SlatStretch	);
			$x_bottomLeft	= &$Interpolate( $lambda,	$SlatX_topLeft,		0									);
			$x_topRight		= &$Interpolate( $lambda, 	$SlatX_bottomRight,	$SlatX_bottomRight	- $SlatStretch	);
			$x_bottomRight	= &$Interpolate( $lambda,	$SlatX_bottomRight,	$SlatX_bottomRight	+ $SlatStretch 	);
			&drawHorizontalSlats( $imgIdx );											#   draw all the image's slats
		}																				#  end if-else
	}																					# until all turn steps processed
	#QUARTER RIGHT-HAND-RULE TURN OF VERSO SLATS:
	for(my $lambda=$DeltaLambda; $lambda < 1.-$DeltaLambda/2.; $lambda+=$DeltaLambda) {	# repeat for each turn step
		if( $Simulation eq 'vertical' ) {												#   interpolate apex coords
			$x_left			= &$Interpolate( $lambda,	$SlatX_mid,							$SlatX_topLeft		);
			$x_right		= &$Interpolate( $lambda,	$SlatX_mid,							$SlatX_bottomRight	);
			$y_topLeft		= &$Interpolate( $lambda, 	$SlatY_topLeft		+ $SlatStretch,	$SlatY_topLeft		);
			$y_bottomLeft	= &$Interpolate( $lambda,	$SlatY_bottomRight	- $SlatStretch,	$SlatY_bottomRight	);
			$y_topRight		= &$Interpolate( $lambda, 	0, 									$SlatY_topLeft		);
			$y_bottomRight	= &$Interpolate( $lambda,	$SlatY_bottomRight	+ $SlatStretch,	$SlatY_bottomRight	);
			&drawVerticalSlats( ( $imgIdx + 1 ) % $NoImages );							#   draw all the image's slats
		} else {																		#   interpolate apex coords
			$y_top			= &$Interpolate( $lambda,	$SlatY_mid,							$SlatY_topLeft		);
			$y_bottom		= &$Interpolate( $lambda,	$SlatY_mid,							$SlatY_bottomRight	);
			$x_topLeft		= &$Interpolate( $lambda, 	0,									$SlatX_topLeft		);
			$x_bottomLeft	= &$Interpolate( $lambda,	$SlatX_topLeft		+ $SlatStretch,	$SlatX_topLeft		);
			$x_topRight		= &$Interpolate( $lambda, 	$SlatX_bottomRight	+ $SlatStretch,	$SlatX_bottomRight	);
			$x_bottomRight	= &$Interpolate( $lambda,	$SlatX_bottomRight	- $SlatStretch,	$SlatX_bottomRight 	);
			&drawHorizontalSlats( ( $imgIdx + 1 ) % $NoImages );						#   draw all the image's slats
		}																				#  end if-else
	}																					# until all turn steps processed
}																						#until all images processed
print	locate( $CursorY, $CursorX ), clline,											#report end of frame processing
		colored ['bold green'], $FrameNo, " frames\n\n";
undef $Canvas;																			#destroy the canvas object
undef $Slats;																			#destroy the slats object
#-------------------------------------------------------------------------------------------------------------------------------
# 4) CREATE ANIMATED GIF IMAGE:
print 'Creating animated GIF image... ';												#report start of animation processing
$Frames->Write																			#output the animation
			(	delay		=> $$Anim{delay},
				loop		=> $$Anim{loops},
				dispose		=> 'background',
				filename	=> $$Anim{output}
			);
print colored ['bold green'], $$Anim{output}, "\n";										#report end of animation processing
exit;
#===== SUBROUTINES =============================================================================================================
#     Usage : &drawHorizontalSlats( $IMGINDEX );
#   Purpose : Draw an animation frame with horizontal slats for the specified image index
# Arguments : $IMGINDEX = image index as was defined for the ImageMagick object $Images.
#      Subs : None.
#   Remarks : None.
#   History : v1.0.0 - September 28, 2009 - Original release.

sub drawHorizontalSlats {																#begin sub
	my $imgIdx	= shift;																# parameterize the argument
	my $slat	= Image::Magick->new( magick => 'GIF' );								# instantiate an image object for the slat canvas

	@$Canvas 	= ();																	# clear the frame canvas
	$Canvas->Set( size => "${CanvasWidth}x${CanvasHeight}" );							# set frame canvas size
	$Canvas->ReadImage( 'xc:transparent' );												# set frame canvas background to transparent

	for my $slatIdx ( $imgIdx*$NoSlats..($imgIdx+1)*$NoSlats - 1 ) {					# repeat for each of the image's slats
		@$slat 	= ();																	#  clear the slat canvas
		$slat->Set( size => "${CanvasWidth}x${SlatWidth}" );							#  set slat canvas size
		$slat->ReadImage( 'xc:transparent' );											#  set slat canvas background to transparent
		$slat->Composite																#  init slat canvas with designated slat image
					(	image			=> $Slats->[$slatIdx],
						compose			=> 'Over',
						geometry		=> "${ImgWidth}x${SlatWidth}+$SlatStretch+0"
					);
		$slat->Distort																	#  match slat corners to perspective apexes:
				( 	points			=>	[	$SlatX_topLeft,		$SlatY_topLeft,		$x_topLeft,		$y_top,    #  top left
											$SlatX_topLeft,		$SlatY_bottomRight,	$x_bottomLeft,	$y_bottom, #  bottom left
											$SlatX_bottomRight,	$SlatY_topLeft,		$x_topRight,	$y_top,    #  top right
											$SlatX_bottomRight,	$SlatY_bottomRight,	$x_bottomRight,	$y_bottom  #  bottom right
										],
						type			=> 'Bilinear',
						'virtual-pixel'	=> 'transparent',
						'best-fit'		=> 1,
					);
		$Canvas->Composite																#  add slat to frame canvas
					(	image			=> $slat,
						compose			=> 'Over',
						x				=> 0,
						y				=> ( $slatIdx % $NoSlats ) * $SlatWidth
					);
	}																					# until all image's slats processed
	push @$Frames, @$Canvas;															# add frame canvas to animation sequence
	print	locate( $CursorY, $CursorX ), clline,										# report frame processing
			colored ['bold yellow'], '(', $Spinners[++$FrameNo % 4], ')';
}																						#end sub drawHorizontalSlats
#-------------------------------------------------------------------------------------------------------------------------------
#     Usage : &drawVerticalSlats( $IMGINDEX );
#   Purpose : Draw an animation frame with vertical slats for the specified image index
# Arguments : $IMGINDEX = image index as was defined for the ImageMagick object $Images.
#      Subs : None.
#   Remarks : None.
#   History : v1.0.0 - September 28, 2009 - Original release.

sub drawVerticalSlats {																	#begin sub
	my $imgIdx	= shift;																# parameterize the argument
	my $slat	= Image::Magick->new( magick => 'GIF' );								# instantiate an image object for the slat canvas

	@$Canvas 	= ();																	# clear the frame canvas
	$Canvas->Set( size => "${CanvasWidth}x${CanvasHeight}" );							# set frame canvas size
	$Canvas->ReadImage( 'xc:transparent' );												# set frame canvas background to transparent

	for my $slatIdx ( $imgIdx*$NoSlats..($imgIdx+1)*$NoSlats - 1 ) {					# repeat for each of the image's slats
		@$slat 	= ();																	#  clear the slat canvas
		$slat->Set( size => "${SlatWidth}x${CanvasHeight}" );							#  set slat canvas size
		$slat->ReadImage( 'xc:transparent' );											#  set slat canvas background to transparent
		$slat->Composite																#  init slat canvas with designated slat image
					(	image			=> $Slats->[$slatIdx],
						compose			=> 'Over',
						geometry		=> "${SlatWidth}x${ImgHeight}+0+$SlatStretch"
					);
		$slat->Distort																	#  match slat corners to perspective apexes:
					( 	points			=>	[	$SlatX_topLeft,		$SlatY_topLeft,		$x_left,	$y_topLeft,    #  top left
												$SlatX_topLeft,		$SlatY_bottomRight,	$x_left,	$y_bottomLeft, #  bottom left
												$SlatX_bottomRight,	$SlatY_topLeft,		$x_right,	$y_topRight,   #  top right
												$SlatX_bottomRight,	$SlatY_bottomRight,	$x_right,	$y_bottomRight #  bottom right
											],
						type			=> 'Bilinear',
						'virtual-pixel'	=> 'transparent',
						'best-fit'		=> 1,
					);
		$Canvas->Composite																#  add slat to frame canvas
					(	image			=> $slat,
						compose			=> 'Over',
						x				=> ( $slatIdx % $NoSlats ) * $SlatWidth,
						y				=> 0
					);
	}																					# until all image's slats processed
	push @$Frames, @$Canvas;															# add frame canvas to animation sequence
	print	locate( $CursorY, $CursorX ), clline,										# report frame processing
			colored ['bold yellow'], '(', $Spinners[++$FrameNo % 4], ')';
}																						#end sub drawVerticalSlats
#===== Copyright 2009, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# end of anim_blinds.pl