#ActivePerl v5.10.1, build 1007 for MSWin32-x86-multi-thread
#===== Copyright 2011, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# img2PhotographicMosaic(threaded).pl: Threaded photographic-mosaic image filter.
#===============================================================================================================================
#           Usage : perl img2PhotographicMosaic(threaded).pl XmlFile
#       Arguments : XmlFile = path of the XML file detailing the processing specifications.
#     Input Files : - The image file to be rendered as a mosaic.
#                   - The GIF tiles in the designated directory along with the associated database file "_tiles.dat"
#                     created by the Perl script "prep4PhotographicMosaic(threaded).pl".
#    Output Files : - Mosaic image, in accordance with the specified pathname.
#                   - A tentative backup copy of any previous mosaic file if one exists with the same filename. In which
#                     case, the basename will have the smallest possible positive integer, enclosed in parentheses, appended to
#                     it such that it ensured a non-conflicting filename. It will be retained only if it differs with the newly
#                     created mosaic.
#                   - A tentative backup copy of any previous blueprint file if one exists with the same filename. In which
#                     case, the basename will have the smallest possible positive integer, enclosed in parentheses, appended to
#                     it such that it ensured a non-conflicting filename. It will be retained only if it differs with the newly
#                     created blueprint.
# Temporary Files : None.
#         Remarks : See http://www.webpraxis.ab.ca/photo_mosaic_v2/img2PhotographicMosaic(threaded).php for details.
#         History : v2.0.1 - March 31, 2012 - Added chomp to tile-data read. v2.0.0 - April 20, 2011 - Original release.
#===============================================================================================================================
# 0) INITIALIZE:
use strict;																					#pragma to restrict unsafe constructs
use warnings;																				#pragma for all optional warnings
use Time::HiRes qw(gettimeofday tv_interval);												#high resolution interval timer, v1.9721
use File::Basename;																			#core module to parse file specifications
use File::Compare;																			#core module to compare files
use File::Copy;																				#core module to copy files
use File::Spec;																				#core module to perform operations on file names
use Image::Magick;																			#PerlMagick from ImageMagick-6.6.3-4-Q16 Win package
use POSIX qw(HUGE_VAL ceil);																#core module
use Term::ANSIScreen qw/:color :cursor :screen/;											#terminal control using ANSI escape sequences, v1.42
use Win32::Console::ANSI qw/ Cursor /;														#emulate ANSI console on Win32 system, v1.04
use threads;																				#pragma for interpreter-based threads, v1.79
use threads::shared;																		#pragma for sharing data structures between threads, v1.33
use Thread::Queue;																			#core module for thread-safe queues, v2.11
use XML::Simple;																			#module to maintain XML files, v2.18
	$XML::Simple::PREFERRED_PARSER = 'XML::Parser';											#set module to parse XML documents, v2.36-r1
use constant FATAL => colored ['white on red'],"\n\n\aFATAL ERROR:",colored ['reset'], ' ';	#intro msg when reporting a fatal error

my $StartTime 	= [gettimeofday];															#record start of execution time

$| = 1; 																					#set STDOUT buffer to auto-flush
cls();																						#clear screen
print colored ['black on white'], "$0\n\n\n",												#display program name
	  colored ['bold white on black'], 'Initializing...';									#report start of processing

( my $XmlFile	= shift ) =~ tr#\\#/#;														#get path of XML file (Unix style)
die FATAL, "Cannot locate the XML file '$XmlFile' -" unless -e $XmlFile;					#check its existence

my $Specs		= XMLin( $XmlFile, SuppressEmpty => undef );								#read the XML data file for specifications

my $N  			= $$Specs{noThreads}		|| $ENV{NUMBER_OF_PROCESSORS} + 1;				#parameterize number of tile-overlaying threads
my $L  			= $$Specs{metric}			|| 'Manhattan';									#parameterize Minkowski metric
my $Pruning		= lc( $$Specs{pruning} )	|| 'yes';										#parameterize tile-pruning option
die FATAL, 'Invalid number of threads -' unless $N > 0;										#check that there's at least one thread
die FATAL, "Unrecognized metric selection '$L' -"											#check validity of metric specification
 unless ( $L eq 'Manhattan' ) or ( $L eq 'Euclidean' ) or ( $L eq 'Max' );
die FATAL, "Unrecognized pruning option '$Pruning' -"										#check validity of pruning option
 unless ( $Pruning eq 'yes' ) or ( $Pruning eq 'no' );

my $ImageFile	= $$Specs{image}{file};														#parameterize the source image path
my $MosaicFile	= $$Specs{mosaic}{file};													#parameterize the mosaic image path
my $BluePrtFile	= $$Specs{blueprint}{file};													#parameterize the tiling blueprint path
die FATAL, "Cannot locate specified source image '$ImageFile' -" unless -e $ImageFile;		#check existence of the source image

my $TileWidth	= $$Specs{tiles}{width};													#parameterize pixel width of a tile
my $TileHeight  = $$Specs{tiles}{height};													#parameterize pixel height of a tile
my $Collections	= $$Specs{tiles}{collections};												#get tile collection names
my $TileDir		= $$Specs{tiles}{dir};														#parameterize tile directory
my $TileData	= "$TileDir/_tiles.dat";													#set the filepath for the tile data
die FATAL, "Invalid tile width '$TileWidth' -" unless $TileWidth > 0;						#check validity
die FATAL, "Invalid tile height '$TileHeight' -" unless $TileHeight > 0;					#check validity
die FATAL, "No tile collection names specified -" unless $Collections;						#check validity
die FATAL, "Cannot locate specified tile directory '$TileDir' -" unless -d $TileDir;		#check existence of the tile directory
die FATAL, "Cannot locate the tile data file '$TileData' -" unless -e $TileData;			#check existence of the tile database
die FATAL, "The tile data file '$TileData' is empty -" unless -s $TileData;					#check for non-empty tile database

my $Manifest			= '';																#tile-collection manifest report
my $NoExclude			= 0;																#number of excluded tiles
my $NoTiles4Matching;																		#number of tiles available for matching
my @Centroid;																				#centroid RGB coordinates of the tile distribution
my @TileRGB;																				#normalized RGB tile values for matching
{																							#start naked block
	my %tileManifest;																		# hash for the tile manifest
	my %tileExclude = map{ 'tile_' . $_ . '.gif', 1 } split( /,/, $$Specs{tiles}{exclude} )	# hash for the tiles to be excluded
	 if defined $$Specs{tiles}{exclude};
	$NoExclude		= scalar keys %tileExclude;												# count number of tiles to be excluded
	my $collName;																			# name of a tile's associated image collection
	my $key;																				# tile database key = tile filename
	my $value;																				# tile database value = TSV string of tile data
	my @rgb;																				# array of RGB values for a tile

	local *DATA;																			# input filehandle for the tile database

	open( DATA, $TileData )																	# open the tile data file for read
	 or die FATAL, "Cannot open the tile data file '$TileData' for read: $! -";
	while( chomp( ( $key, $collName, @rgb ) = split /\t/, <DATA> ) ) {						# repeat for each tile record; parse data
		next if defined $tileExclude{$key};													#  skip if record is to be excluded
		next unless ( $Collections eq '*' 						) or						#  skip record unless all collections to be used or
					( $Collections =~ /(^|,)\Q$collName\E(,|$)/ );							#   collection specified explicitly
		push @{ $TileRGB[8]{$key} }, @rgb;													#  record tile's mean normalized RGB values
		++$tileManifest{"$collName"};														#  update tile manifest
		$Centroid[$_] += $rgb[$_] for( 0..2 );												#  sum RGB coordinate component for centroid
	}																						# until all tile records processed
	close( DATA );																			# close the tile data file

	$NoTiles4Matching	= scalar keys %{$TileRGB[8]};										# determine number of tiles available for matching
	die FATAL, " No tiles available for matching -" unless $NoTiles4Matching;				# check that tiles are available

	$Manifest 			= join ",\n" . ' ' x 18,											# compose the manifest report
								map{ "$_ [$tileManifest{$_}]" } sort keys %tileManifest;	#  as "collection name [tile total]"
	$Centroid[$_] 		/= $NoTiles4Matching for( 0..2 );									# compute centroid coordinate

	if( $Pruning eq 'yes' ) {																# if pruning requested
		while( ( $key, $value ) = each %{$TileRGB[8]} ) {									#  repeat for each tile: assign to octant
			my $octant				= 0;													#   init sub-space index
			vec( $octant, $_, 1 )	= ( $Centroid[$_] > @{ $value }[$_] ) for ( 0..2 );		#   determine octant, bit by bit, relative to centroid
			$TileRGB[$octant]{$key}	= $TileRGB[8]{$key};									#   assign tile to octant
			delete $TileRGB[8]{$key};														#   delete tile from general population
		}																					#  until all tiles segregated
		pop @TileRGB;																		#  shorten the array
		do{	die FATAL, " No tiles available for matching in one of the octants -"			#  check for tiles in each octant
			 unless scalar keys %{$TileRGB[$_]};
		  }	for( 0..7 );
	} else {																				# else no pruning
		splice @TileRGB, 0, 8;																#  shorten the array
	}																						# end if-else

	undef %tileManifest;																	# discard work hashes
	undef %tileExclude;
}																							#end naked block

my $Image			= Image::Magick->new();													#instantiate an image object for the source image
$Image->Read( "$ImageFile" );																#init with source image file
$Image->Quantize( colorspace => 'RGB' );													#insure correct colorspace
my ( $ImageWidth, $ImageHeight ) = $Image->Get( 'width', 'height' );						#get width & height of source image

my $NoTileCols		= POSIX::ceil( $ImageWidth  / $TileWidth  );							#compute integral number of tile columns
my $NoTileRows		= POSIX::ceil( $ImageHeight / $TileHeight );							#compute integral number of tile rows
my $NoTiles			= $NoTileCols * $NoTileRows;											#compute total number of tiles in mosaic
my $MosaicWidth		= $NoTileCols * $TileWidth;												#compute pixel width of mosaic image
my $MosaicHeight	= $NoTileRows * $TileHeight;											#compute pixel height of mosaic image
my $MosaicComment	=	  "XML input file: $XmlFile\n"										#create comment for mosaic image
						. "Source Image: $ImageFile\n"
						. "Mosaic Image: $MosaicFile\n"
						. "Blueprint: $BluePrtFile\n\n"
						. "Created with \"img2PhotographicMosaic(threaded).pl\",\n"
						. "Copyright 2010, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED\n"
						. "Web: http://www.webpraxis.ab.ca/ - Email: webpraxis\@gmail.com";

my @Threads;																				#thread description
push @Threads, "#0 = main";
push @Threads, "#$_ = create mosaic" for ( 1..$N );
push @Threads, "#" . ( $N + 1 ) . " = create blueprint.";

print "\r", clline,							  												#echo initialization results
	  colored ['reset'], 'XML input file  : ', colored ['bold white'], $XmlFile, "\n\n",
	  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\n",
      colored ['reset'], 'Mosaic Image    : ', colored ['bold white'], $MosaicFile, "\n",
      colored ['reset'], ' -Width         : ', colored ['bold white'], $MosaicWidth, " px\n",
      colored ['reset'], ' -Height        : ', colored ['bold white'], $MosaicHeight, " px\n\n",
      colored ['reset'], 'Mosaic Details  : ', colored ['bold white'], $NoTiles, " tiles\n",
	  colored ['reset'], ' -Tile Width    : ', colored ['bold white'], $TileWidth, " px\n",
      colored ['reset'], ' -Tile Height   : ', colored ['bold white'], $TileHeight, " px\n",
      colored ['reset'], ' -No. of Rows   : ', colored ['bold white'], $NoTileRows, "\n",
      colored ['reset'], ' -No. of Cols   : ', colored ['bold white'], $NoTileCols, "\n\n",
	  colored ['reset'], 'HTML Blueprint  : ', colored ['bold white'], $BluePrtFile, "\n\n",
	  colored ['reset'], 'Collections     : ', colored ['bold white'], $Manifest, "\n",
	  colored ['reset'], ' -No of Tiles   : ', colored ['bold white'], $NoTiles4Matching, " [$NoExclude excluded]\n",
	  colored ['reset'], ' -RGB Centroid  : ', colored ['bold white'], "($Centroid[0], $Centroid[1], $Centroid[2])\n\n",
	  colored ['reset'], 'Metric          : ', colored ['bold white'], $L, "\n",
	  colored ['reset'], 'Pruning         : ', colored ['bold white'], $Pruning, "\n\n",
	  colored ['reset'], 'Threads         : ', colored ['bold white'], join( ",\n" . ' ' x 18, @Threads ), "\n",
	  colored ['reset'], "\n", '-' x 80, "\n\n";

my $CursorY			= ( Cursor() )[1];  													#record cursor row position
#-------------------------------------------------------------------------------------------------------------------------------
# 1) CREATE MOSAIC IMAGE & TILING BLUEPRINT:
&report( 0, 'bold green', 'Scaling source image to mosaic dimensions' );					#report processing step
$Image->Scale( geometry => "${MosaicWidth}x${MosaicHeight}!" );								#scale source image to mosaic size
my @ImageBlob:shared = $Image->ImageToBlob();												#convert source image to a shared blob
undef $Image;																				#destroy source image object before thread launch

my $Backup = &fileBackup( $MosaicFile );													#tentatively backup any previous mosaic
my $Mosaic = Image::Magick->new();															#instantiate an image object for the mosaic
$Mosaic->Set( size => "${MosaicWidth}x${MosaicHeight}!" );									#set canvas size
$Mosaic->Read( 'xc:none' );																	#set no background

my $NoThreadsDone:shared	= 0;															#number of tile-overlayer threads that have ended
my $GeometryQueue			= Thread::Queue->new();											#create queue for the tile geometries
my $LayoutQueue				= Thread::Queue->new();											#create queue for the tile layout data
threads->create( \&createMosaic )->detach() for ( 1..$N );									#launch thread(s) for composing the mosaic
threads->create( \&createBlueprint );														#launch thread for writing the HTML mosaic blueprint

&report( 0, 'bold green', 'Populating geometry queue' );									#report processing step
{																							#start naked block for tile geometries
	my $tileIdx	= 0;																		# init tile index for blueprint
	for( my $y = 0; $y < $MosaicHeight - 1; $y += $TileHeight ) {							# repeat for each tile row: work top to bottom
		for( my $x = 0; $x < $MosaicWidth - 1; $x += $TileWidth ) {							#  repeat for each tile column: work left to right
			my $geometry = "${TileWidth}x${TileHeight}+$x+$y";								#   define tile's geometry
			$GeometryQueue->enqueue( $tileIdx++, $geometry );								#   enqueue blueprint tile index & geometry
		}																					#  until all tile columns processed
	}																						# until all tile rows processed
}																							#end naked block
$GeometryQueue->enqueue( map{ undef } 1..2*$N );											#signal tile-overlayer threads to end

&report( 0, 'bold yellow', 'Waiting...' );													#report wait state
$_->join() for threads->list(threads::running);												#wait for the tiling-blueprint thread to end

&report( 0, 'bold green', 'Writing Mosaic...' );											#report processing step
$Mosaic->Comment( $MosaicComment );															#try to write main parameters to comment field
$Mosaic->Write( filename => "$MosaicFile" );												#output the mosaic to file
if( defined( $Backup ) ) {																	#delete backup if no change
	unlink $Backup unless compare( $MosaicFile, $Backup );
}
#-------------------------------------------------------------------------------------------------------------------------------
# 2) TERMINATE:
&report( 0, 'bold red', 'Done' );															#report termination
my $Elapsed = tv_interval( $StartTime );													#determine total elapsed time
print locate( $CursorY + $N + 3, 1 ), 														#report total elapsed time
	  colored ['reset'], "\aElapsed time: ",
	  colored ['bold white'], $Elapsed,
	  colored ['reset'], " secs\nThroughput: ",
	  colored ['bold white'], int( 100*$NoTiles/$Elapsed ) / 100, " tiles/sec\n";
exec( qq|imdisplay "$MosaicFile"| ) if -e "$MosaicFile";									#display mosaic
exit;																						#end processing
#===== SUBROUTINES =============================================================================================================
#            Usage : &fileBackup( Source )
#          Purpose : Copies the designated source file to a target file with a similar file specification. The target's basename
#                    will differ by having a positive integer, enclosed in parentheses, appended. The chosen integer will be the
#                    smallest possible value that ensures a non-conflicting filename.
#        Arguments : Source = Source file specification.
#          Returns : String containing the target file specification or the undefined value.
#  Externals -  In : FATAL.
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : The undefined value is returned if the source file does not exist.
#          History : v1.0.0 - October 1, 2010 - Original release.

sub fileBackup {																			#begin sub
	my $source		= shift;																# parameterize the source file specification
	my $target		= $source;																# init backup file specification
	my $modifier	= 0;																	# init basename modifier

	return undef unless -e $source;															# return undefined value if source does not exist

	fileparse_set_fstype('');																# force Unix-style interpretation
	my ( $basename, $path, $suffix ) = fileparse( $source, '\..*' );						# split the source file spec into components
	$target = "$path${basename}(" . ++$modifier . ')' . $suffix while -e $target;			# compose unique filename

	copy( $source, $target )																# copy source file to target
	 or die FATAL, "Cannot backup the file '$source' to '$target': $! -";
	return $target;																			# return the target file specification
}																							#end sub fileBackup
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &report( ThreadId, Colors, Msg );
#          Purpose : Reports a thread's processing status.
#        Arguments : ThreadId = thread integer id
#                    Colors   = color attribute of message
#                    Msg      = message to be displayed
#          Returns : None.
#  Externals -  In : $CursorY
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : None.
#          History : v2.0.0 - October 1, 2010 - Original release.

sub report {																				#begin sub
	my( $threadId, $colors, $msg ) = @_;													# parameterize the arguments

	print locate( $CursorY + $threadId, 1 ), clline,										# clear line coresponding to thread
		  colored [ 'reset' ], "Thread #$threadId: ",										# display heading
		  colored [ $colors ], $msg;														# display message
}																							#end sub report
#===== THREADED SUBROUTINES ====================================================================================================
#            Usage : &createMosaic();
#          Purpose : Finds the best matching tiles for specified tile geometries and overlays them on the mosaic canvas.
#        Arguments : None.
#          Returns : None.
#  Externals -  In : $Pruning, $L, $Mosaic, $N, $TileDir, @Centroid, @TileRGB
#  Externals - Out : $Mosaic
#     Shared -  In : $NoThreadsDone, @ImageBlob
#     Shared - Out : $NoThreadsDone
#           Queues : $GeometryQueue, $LayoutQueue
#             Subs : report
#          Remarks : - Dequeues $GeometryQueue for the tile blueprint layout index & geometry.
#                    - Enqueues $LayoutQueue with the filename and blueprint layout index of each best-matching tile.
#          History : v2.0.0 - November 10 - Original release.

sub createMosaic {																			#begin sub
	my $threadId	= threads->tid();														# parameterize thread id
	&report( $threadId, 'bold white', 'Initializing...' );									# report initialization
	( my $image		= Image::Magick->new() )->BlobToImage( @ImageBlob );					# init an image object from the image blob
	my %file2index;																			# mapping of filenames to image object indices
	my $geometry;																			# geometry of a tile: width, height & x,y offsets
	my $layoutIdx;																			# layout index for blueprint
	my $tile		= Image::Magick->new( magick => "GIF" );								# instantiate an image object for the tiles
	my $tileCount;																			# number of tiles processed
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sub meanColor {																			# begin sub to compute a mean normalized channel color
		my @colors = $image->GetPixels														#  get channel intensities of all pixels:
								(	map			=> shift,									#   get color channel designation,
									geometry	=> $geometry,								#   specify tile geometry,
									normalize	=> 'true'									#   request normalized values
								);
		my $mean = 0;																		#  average value
		$mean  += $_ for @colors;															#  sum all intensities
		$mean  /= scalar @colors;															#  return the average value
	}																						# end sub meanColor
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sub max {																				# begin sub to compute a maximum value
		my $max = shift;																	#  init max with first value
		do{ $max = $_ if $_ > $max } for @_;												#  update max following comparison with remaining values
		return $max;																		#  result maximum value
	}																						# end sub max
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sub matchBestTile {																		# begin sub to match a tile to an image area
		my ( $red, $green, $blue )	= @_;													#  parameterize the mean normalized RGB colors
		my $minMetric				= &POSIX::HUGE_VAL;										#  minimum value of the metric
		my $bestTile;																		#  filename of tile that best matches mean colors
		my $octant					= 0;													#  init "octant" restriction

		do{ vec( $octant, $_, 1 ) = ( $Centroid[$_] > $_[$_] ) for( 0..2 ); }				#  compute restriction, bit by bit, relative to centroid
		 if( $Pruning eq 'yes' );															#   if pruning requested

		if( $L eq 'Manhattan' ) {															#  case of Manhattan metric:
			while( my ( $key, $value ) = each %{$TileRGB[$octant]} ) {						#   repeat for each possible tile
				my $metric		= abs( $red   - @{$value}[0] ) +							#    compute metric
								  abs( $green - @{$value}[1] ) +
								  abs( $blue  - @{$value}[2] );
				( $minMetric, $bestTile ) = ( $metric, $key ) if $metric < $minMetric;		#    update minimum metric & best tile if metric is less
			}																				#   until all tiles processed
		} elsif( $L eq 'Euclidean' ) {														#  case of Euclidean metric:
			while( my ( $key, $value ) = each %{$TileRGB[$octant]} ) {						#   repeat for each possible tile
				my $deltaRed	= $red   - @{$value}[0];									#    compute difference in red colors
				my $deltaGreen	= $green - @{$value}[1];									#    compute difference in green colors
				my $deltaBlue	= $blue  - @{$value}[2];									#    compute difference in blue colors
				my $metric		= $deltaRed		* $deltaRed		+							#    compute square of metric
								  $deltaGreen	* $deltaGreen	+
								  $deltaBlue 	* $deltaBlue;
				( $minMetric, $bestTile ) = ( $metric, $key ) if $metric < $minMetric;		#    update minimum metric & best tile if metric is less
			}																				#   until all tiles processed
		} else {																			#  case of Max metric:
			while( my ( $key, $value ) = each %{$TileRGB[$octant]} ) {						#   repeat for each possible tile
				my $metric		= &max( abs( $red   - @{$value}[0] ),						#    compute metric
									    abs( $green - @{$value}[1] ),
									    abs( $blue  - @{$value}[2] )
									  );
				( $minMetric, $bestTile ) = ( $metric, $key ) if $metric < $minMetric;		#    update minimum metric & best tile if metric is less
			}																				#   until all tiles processed
		}																					#  end case of selected metric
		return $bestTile;																	#  return tile filename
	}																						# end sub matchBestTile
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	while( ( $layoutIdx, $geometry ) = $GeometryQueue->dequeue( 2 ) ) {						# repeat; dequeue task specifications
		last unless defined $layoutIdx;														#  end repeat if end of queue encountered
		my $bestTile = &matchBestTile														#  match mean image-area colors to a tile:
						(	&meanColor( 'r' ),												#   compute mean normalized red color,
							&meanColor( 'g' ),												#   compute mean normalized green color,
							&meanColor( 'b' )												#   compute mean normalized blue color.
						);																	#   record tile filename

		unless( defined $file2index{$bestTile} ) {											#  if current tile differs from previous ones
			$tile->Read( "$TileDir/$bestTile" );											#   load tile object with its image file
			$file2index{$bestTile} = $#$tile;												#   update mapping
		}																					#  end if
		$Mosaic->Composite(	image		=> $tile->[$file2index{$bestTile}],					#  overlay mosaic canvas with tile
							compose		=> 'Over',
							geometry	=> $geometry
						  );

		++$tileCount;																		#  update tile count
		$LayoutQueue->enqueue( $bestTile, $layoutIdx );										#  enqueue task specs for blueprint thread
		&report( $threadId, 'bold green', "Matched $bestTile for $geometry" );				#  report best tile match
	}																						# until all end of queue marker encountered
	{	lock $NoThreadsDone;																# get lock on threads-done counter
		$LayoutQueue->enqueue( undef, undef )												# signal blueprint thread that no more data forthcoming
		 if ++$NoThreadsDone == $N;															#  if this is the last tile-overlaying thread to end
	}																						# release lock on counter
	&report( $threadId, 'bold red', "Done ($tileCount tiles overlaid)" );					# report end of processing
}																							#end sub createMosaic
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &createBlueprint()
#          Purpose : Creates the HTML blueprint file for displaying the individual tiles of the mosaic along with
#                    the tile histogram.
#        Arguments : None.
#          Returns : None.
#  Externals -  In : FATAL, $BluePrtFile, $MosaicHeight, $MosaicWidth, $TileDir, $TileHeight, $TileWidth
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : $LayoutQueue
#             Subs : fileBackup, report
#          Remarks : Dequeues $LayoutQueue for the filename and layout index of the best matching tiles.
#          History : v2.0.0 - November 10 - Original release.

sub createBlueprint {																		#begin sub
	my $threadId = threads->tid();															# parameterize thread id
	my $backup	= &fileBackup( $BluePrtFile );												# tentatively backup any previous blueprint
	my @layout;																				# tile-code layout
	my %codeBins;																			# tile-code histogram bins
	&report( $threadId, 'bold yellow', 'Waiting...' );										# report wait state
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sub aggregate {																			# begin sub to aggregate tile runs in blueprint
		my $codeList = join( ',', @layout ) . ',';											#  make CSV list of tile codes & append extra comma

		for ( keys %codeBins ) {															#  repeat for each tile code
			while( my( $leadIn, $run ) = $codeList =~ /(^|,)(($_,)(\3)+)/ ) {				#   repeat for each code run
				$codeList =~ s/$&/"$leadIn${_}x" . $run =~ tr#,#,# . ','/e;					#    replace run with aggregate expression
			}																				#   until all runs processed
		}																					#  until all tile codes processed
		chop( $codeList );																	#  remove trailing extra comma
		return $codeList;																	#  return aggregated list of tile codes
	}																						# end sub aggregate
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	while( my( $bestTile, $layoutIdx, ) = $LayoutQueue->dequeue( 2 ) ) {					# repeat for each tile specification
		last unless defined $bestTile;														#  end repeat if end of queue encountered
		( $layout[$layoutIdx] ) = $bestTile =~ /^tile_(.+)\.gif/;							#  update tile-code layout
		++$codeBins{ $1 };																	#  update tile-code histogram
		&report( $threadId, 'bold green', "Updated layout with tile code '$1'" );			#  report processing
	}																						# until all tiles processed

	&report( $threadId, 'bold green', 'Creating the HTML tiling blueprint...' );			# report blueprint creation
	( my $tileDir	= File::Spec->rel2abs( $TileDir ) ) =~ tr#\\#/#;						# convert tile directory to Unix-style absolute
	my $histogram	= join ',', map{ "$_," . $codeBins{$_} }								# compose histogram data list
						sort{ $codeBins{$b} <=> $codeBins{$a} } keys %codeBins;				#  in descending frequency order

	local *HTML;																			# filehandle for the HTML blueprint file
	open( HTML, ">$BluePrtFile" )															# open blueprint file for write
	 or die FATAL, "Cannot create HTML blueprint file '$BluePrtFile': $! -";

	print HTML <<BLUEPRINT;																	# write the HTML file
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
	<meta http-equiv="Content-Type"	content="text/html; charset=ISO-8859-1">
	<meta name="author"				content="Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED; webpraxis\@gmail.com">
	<style type="text/css">
		BODY {
			background-color:					silver;
			font-family:						Verdana,Helvetica,sans-serif;
			font-size:							9pt;
		}

		DIV#histogram {
			float:								left;
		}
		DIV#histogram TABLE {
			border:								3px double teal;
			border-collapse:					collapse;
			margin-top:							20px;
			font-size:							9pt;
			table-layout:						auto;
		}
		DIV#histogram TABLE TD,
		DIV#histogram TABLE TH {
			background-color:					transparent;
			border:								1px solid teal;
			padding-left:						10px;
			padding-right:						10px;
			text-align:							left;
		}
		DIV#histogram TABLE TD:first-child,
		DIV#histogram TABLE TH:first-child {
			text-align:							center;
		}

		DIV#mosaic {
			position:							absolute;
			top:								30px;
			left:								250px;
			width:								${MosaicWidth}px;
			height:								${MosaicHeight}px;
		}

		IMG {
			height:								${TileWidth}px;
			width:								${TileHeight}px;
		}
	</style>
	<script type="text/javascript">
		String.prototype.repeat = function( multiplier ) {
			var newString = '';
			while( multiplier-- > 0 ) {
				newString += this;
			}
			return newString;
		}
		String.prototype.displayMosaic = function() {
			var blueprint = this.split(",");
			for( var i = 0; i < blueprint.length; i++ ) {
				var operands	= blueprint[i].split("x"),
					img			= '<img src="file:///$tileDir/tile_' + operands[0] + '.gif" onclick="tileInfo(' + operands[0] + ');">';
				document.write( ( typeof operands[1] == 'undefined' ) ? img : img.repeat( operands[1]) );
			}
		}

		var tileHistogram = new Histogram( $histogram );
		function Histogram()
		{
			var data	= arguments;
			this.length	= 0;
			this.bins	= new Array();
			for( var i = 0; i < data.length; i += 2 ) {
				this.bins[data[i].toString()] = data[i+1];
				this.length++;
			}

			this.display = function() {
				document.write( '<table><tr><th>Tile</th><th>Code</th><th>Frequency</th></tr>' );
				for( var i = 0; i < data.length; i += 2 ) {
					document.write( '<tr id="' + data[i] + '">' );
					document.write( '<td><a name="' + data[i] + '"></a><img src="file:///$tileDir/tile_' + data[i] + '.gif"></td>' );
					document.write( '<td>' + data[i] + '</td>' );
					document.write( '<td>' + data[i+1] + '</td>' );
					document.write( '</tr>\\n' );
				}
				document.write( '<tr><th colspan="3">Total unique tiles = ' + this.length + '</th></tr></table>\\n' );
			}
		}

		var hilitedRow = null;
		function tileInfo( code ) {
			if( hilitedRow != null ) hilitedRow.style.backgroundColor = 'transparent';
			hilitedRow = document.getElementById( code );
			hilitedRow.style.backgroundColor = 'whitesmoke';
			alert( 'Code = ' + code + '\\nFrequency = ' + tileHistogram.bins[code.toString()] )
		}
	</script>
</head>
<body>
	<div id="histogram">
		<script type="text/javascript">tileHistogram.display();</script>
	</div>
	<div id="mosaic">
		<b>Click on a tile to highlight its entry in the histogram. Use the associated code to exclude it.</b>
		<p>
		<script type="text/javascript">"@{[ &aggregate() ]}".displayMosaic();</script>
	</div>
</body>
</html>
BLUEPRINT
	close HTML;																				# close the HTML blueprint file

	if( defined( $backup ) ) {																# delete backup if no change
		unlink $backup unless compare( $BluePrtFile, $backup );
	}
	&report( $threadId, 'bold red', 'Done' );												# report end of processing
}																							#end sub createBlueprint
#===== Copyright 2011, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# end of img2PhotographicMosaic(threaded).pl
