use strict;
use File::Basename;
use FileHandle;
use Image::Magick;
#===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# img2mosaic.pl: Mosaic image filter with assembly instructions.
#===============================================================================================================================
#           Usage : perl img2mosaic.pl ImageFile ColorChartFile TileWidth TileHeight Verbose
#       Arguments : ImageFile      = path of image file to be filtered.
#                   ColorChartFile = path of text file containing the hash declarations for the color chart.
#                   TileWidth      = width of a tile in pixels
#                   TileHeight     = height of a tile in pixels
#                   Verbose        = boolean flag for verbose output
#     Input Files : See arguments.
#    Output Files : Mosaic GIF file in the form "basename_wxh_px_tiles.gif" where "basename" denotes the basename of the
#                     source image file, "w" the tile width and "h" the tile height.
#                   Mosaic text assembly instructions in the form "basename_wxh_px_tiles.txt".
# Temporary Files : None.
#         Remarks : Requires PerlMagick. Used module from ImageMagick 6.3.7.
#         History : v1.0.0 - January 24, 2008  - Original release.
#                   v1.0.1 - February 11, 2008 - Scaling of mosaic image now done with force
#                   v1.0.2 - February 17, 2008 - Added call to "fileparse_set_fstype" to force Unix syntax
#===============================================================================================================================
# 0) INITIALIZE:
system( 'cls' ) if $^O =~ /^MSWin/;															#clear screen if running Windows
print "$0\n", '=' x length($0), "\n\n";														#display program name

my $SourceFile	= shift || die 'ERROR: No image file specified';							#get path of source image file
my $ChartFile	= shift || die 'ERROR: No color-chart file specified';						#get path of color-chart file
my $TileWidth	= shift || die 'ERROR: No tile width specified';							#get pixel width of a tile
my $TileHeight  = shift || die 'ERROR: No tile height specified';							#get pixel height of a tile
my $Verbose		= shift;																	#get boolean flag for verbose mode
die 'ERROR: Cannot locate image file'       unless -e $SourceFile;
die 'ERROR: Cannot locate color-chart file' unless -e $ChartFile;

fileparse_set_fstype('');
my ( $basename,																				#extract basename &
	 $path																					#extract path
   )			= fileparse( $SourceFile, '\..*' );											# of source image file
my $MosaicFile	= "$path${basename}_${TileWidth}x${TileHeight}_px_tiles.gif";				#compose filename of mosaic image
my $ReportFile	= "$path${basename}_${TileWidth}x${TileHeight}_px_tiles.txt";				#compose filename of report
local *REPORT;																				#define filehandle for the report

my %ColorChart;																				#hash of tile id codes => rgb color values
push @ARGV, $ChartFile;																		#set up reading of color chart
eval '%ColorChart = (' . join( '', <> ) . ')';												#load chart into hash

my %TileRGB;																				#hash of arrays for each color channel value
my %TileColor;																				#hash of rgb fill attributes
my %TileId;																					#hash of tile id codes
{																							#start naked block
	my $key;																				# chart hash key
	my $value;																				# chart hash value
	my @rgb;																				# array of rgb channel colors

	while( ( $key, $value ) = each %ColorChart ) {											# repeat for each chart entry
		@rgb = split / /, $value;															#  extract hex channel colors
		push @{ $TileRGB{ $key } }, hex for @rgb;											#  create RGB array of decimal values
		$TileColor{ $key }	= '#' . join '', @rgb;											#  create rgb fill attribute
		$TileId{ $key }		= ( split /-/, $key )[0];										#  extract tile id code
	}																						# until all chart entries processed
}																							#end naked block
undef %ColorChart;																			#discard the color chart

my %TileCounts;																				#hash for tile totals per type
my $Blueprint;																				#mosaic assembly instructions
#-------------------------------------------------------------------------------------------------------------------------------
# 1) SETUP MOSAIC IMAGE:
my $source			= Image::Magick->new;													#instantiate an image object for the source
my ( $SourceWidth,																			#get width &
	 $SourceHeight																			#get height
   )				= ( $source->Ping( $SourceFile ) )[0,1];								#of source
undef $source;																				#destroy the image object for the source

my $No_Tile_Cols	= $SourceWidth / $TileWidth;											#compute raw number of tile columns
   $No_Tile_Cols	= int( ++$No_Tile_Cols )												#adjust to an integral number
					   unless $No_Tile_Cols == int( $No_Tile_Cols );						# if necessary
my $No_Tile_Rows	= $SourceHeight / $TileHeight;											#compute raw number of tile rows
   $No_Tile_Rows	= int( ++$No_Tile_Rows )												#adjust to an integral number
					   unless $No_Tile_Rows == int( $No_Tile_Rows );						# if necessary

my $MosaicWidth		= $No_Tile_Cols * $TileWidth;											#compute pixel width of mosaic image
my $MosaicHeight	= $No_Tile_Rows * $TileHeight;                            				#compute pixel height of mosaic image
my $Mosaic			= Image::Magick->new( magick=>"GIF" );									#instantiate an image object for the mosaic
   $Mosaic->Read( $SourceFile );															#init mosaic with source image file
   $Mosaic->Quantize( colors=>scalar keys %TileColor, colorspace=>'RGB' );					#insure correct colorspace
   $Mosaic->Scale( geometry=>"${MosaicWidth}x${MosaicHeight}!" );							#scale mosaic image

print "Source Image:   $SourceFile\n",                                                      #echo initialization results
      "  Width:        $SourceWidth px\n",
      "  Height:       $SourceHeight px\n",
      "Mosaic Image:   $MosaicFile\n",
      "  Width:        $MosaicWidth px\n",
      "  Height:       $MosaicHeight px\n",
      "Report File:    $ReportFile\n\n",
      "Mosaic Details: ", $No_Tile_Cols * $No_Tile_Rows, " tiles\n",
      "  No. of rows:  $No_Tile_Rows\n",
      "  No. of cols:  $No_Tile_Cols\n",
      "  Tile width:   $TileWidth px\n",
      "  Tile height:  $TileHeight px\n\n";
print( "Pause. Press the ENTER key to continue..." ), <STDIN> if $Verbose;
#-------------------------------------------------------------------------------------------------------------------------------
# 2) CREATE MOSAIC IMAGE:
{																							#start naked block
	my $best_tile;																			# name of best matching tile
	my $colNo;																				# tile column number
	my $rowNo;																				# tile row number
	my $geometry;																			# geometry of a tile: width, height & x,y offsets
	my $x_top_left;																			# x-coordinate of a tile's top-left corner
	my $y_top_left;																			# y-coordinate of a tile's top-left corner
	my $x_bottom_right;																		# x-coordinate of a tile's bottom-right corner
	my $y_bottom_right;																		# y-coordinate of a tile's bottom-right corner

	print "Creating mosaic image...\n";
	for ( $y_top_left = $MosaicHeight - $TileHeight;										# for each tile row: start at bottom and work up
		  $y_top_left >= 0;
		  $y_top_left -= $TileHeight
		) {
			++$rowNo;																		#  update tile row number
			$colNo			= 0;															#  reset tile column number
			$y_bottom_right	= $y_top_left + $TileHeight - 1;								#  compute y-coord. of the tile's bottom-right corner
			for ( $x_top_left = 0;															#  for each tile column: work left to right
				  $x_top_left < $MosaicWidth - 1;
				  $x_top_left += $TileWidth
				) {
					++$colNo;																#   update tile column number
					$x_bottom_right	= $x_top_left + $TileWidth - 1;							#   compute x-coord. of the tile's bottom-right corner
					print "\tTile# $rowNo,$colNo \@ $x_top_left,$y_top_left-$x_bottom_right,$y_bottom_right: "
					 if $Verbose;															#   report progress if requested

					$geometry		= "${TileWidth}x${TileHeight}+$x_top_left+$y_top_left";	#   define tile geometry
					$best_tile		= &bestTileMatch										#   match mean image-area colors to a tile
									  (	&meanColor											#    compute mean red color
										( $Mosaic->GetPixels								#     get normalized red intensities of all pixels
										  (	map			=> 'r',
											geometry	=> $geometry,
											normalize	=> 'true'
										  )
									    ),
										&meanColor											#    compute mean green color
										( $Mosaic->GetPixels								#     get normalized green intensities of all pixels
										  (	map			=> 'g',
											geometry	=> $geometry,
											normalize	=> 'true'
										  )
									    ),
										&meanColor											#    compute mean blue color
										( $Mosaic->GetPixels								#     get normalized blue intensities of all pixels
										  (	map			=> 'b',
											geometry	=> $geometry,
											normalize	=> 'true'
										  )
									    )
									  );
					$Blueprint	   .= "$TileId{ $best_tile } ";								#   add tile id to assembly instructions
					++$TileCounts{ $best_tile };											#   update corresponding tile total

					$Mosaic->Draw( primitive	=> 'rectangle',								#   replace image subregion with tile
								   fill			=> $TileColor{ $best_tile },
								   points		=> "$x_top_left,$y_top_left $x_bottom_right,$y_bottom_right"
								 );
			}																				#  until all tile columns processed
			$Blueprint .= "\n";																#  mark end of row in assembly blueprint
	}																						# until all tile rows processed
    $Mosaic->Write( filename => $MosaicFile );												# save the mosaic to file
	undef $Mosaic;																			# destroy the mosaic image object
}																							#end naked block
#-------------------------------------------------------------------------------------------------------------------------------
# 3) REPORT TILE BREAKDOWN:
open REPORT, ">$ReportFile";
print "\nWriting the report...\n\n";
print REPORT "Tile Totals: ", $No_Tile_Rows * $No_Tile_Cols, " ($No_Tile_Rows rows x $No_Tile_Cols columns)\n\n";
printf REPORT "\t%-25s: %d\n", $_, $TileCounts{$_} for sort keys %TileCounts;
#-------------------------------------------------------------------------------------------------------------------------------
# 4) REPORT AGGREGATED BLUEPRINT:
{																							#start naked block
	my $repetitions;                                                                      	# number of tile-id repetitions

	print REPORT "\nBlueprint (bottom to top, left to right):\n\n";							# report header
	study $Blueprint;																		# prep for substitutions
	for ( map{ $TileId{ $_ } } keys %TileCounts ) {											# for each id of tile present
		for ( $repetitions = $No_Tile_Cols; $repetitions > 1; --$repetitions ) {			#  for each possible repetition
			$Blueprint =~ s/($_ ){$repetitions}/"$_\[$repetitions\] "/esg;					#   aggregate
		}																					#  until all repetitions examined
	}																						# until all tile ids processed

	REPORT->format_name( "BLUEPRINT" );														# declare report format for blueprint
	$: = " ";																				# set the line-break character
	write REPORT for split /\n/, $Blueprint;												# output assembly instructions
}																							#end naked block
close REPORT;
print "\a\nDone!\n";																		#report end of processing
exit;																						#end processing
#===== FORMATS =================================================================================================================
{																							#start naked block
	my $rowNo;																				# blueprint row number

	format BLUEPRINT =																		# format for reporting the assembly instructions
  Row# @>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ++$rowNo, $_
            ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
           $_
.
}																							#end naked block

#===== SUBROUTINES =============================================================================================================
#     Usage : &bestTileMatch( $RED, $GREEN, $BLUE );
#   Purpose : Matches a tile to the mean RGB channel values of an image area.
# Arguments : $RED   = mean 8-bit red color
#             $GREEN = mean 8-bit green color
#             $BLUE  = mean 8-bit blue color
# Externals : $TileRGB, $Verbose
#      Subs : None.
#   Remarks : None.
#   History : v1.0.0 - January 23, 2008 - Original release.

sub bestTileMatch {																			#begin sub
	my ( $red, $green, $blue )	= @_;														# parametrize the arguments
	my $bestTile;																			# name of tile that best matches mean color
	my $deltaRed;																			# difference in red color values
	my $deltaGreen;																			# difference in green color values
	my $deltaBlue;																			# difference in blue color values
	my $key;																				# hash key = tile name
	my $value;																				# hash value = array of channel color intensities
	my $metric;																				# squared Euclidean metric of intensities
	my $minMetric				= 65536 * 65536;											# minimum value of the metric

	while( ( $key, $value ) = each %TileRGB ) {												# repeat for each possible tile
		$deltaRed   = $red   - @{$value}[0];												#  compute difference in red colors
		$deltaGreen = $green - @{$value}[1];												#  compute difference in green colors
		$deltaBlue  = $blue  - @{$value}[2];												#  compute difference in blue colors
		$metric     = $deltaRed   * $deltaRed   +											#  compute metric
					  $deltaGreen * $deltaGreen +
					  $deltaBlue  * $deltaBlue;
		$minMetric  = $metric, $bestTile = $key if $metric < $minMetric;					#  update minimum metric & possible best tile
	}																						# until all tiles processed
	print "=> $bestTile\n" if $Verbose;														# report if requested
	return $bestTile;																		# return best matching tile name
}																							#end sub bestTileMatch
#-------------------------------------------------------------------------------------------------------------------------------
#     Usage : &meanColor( @COLORS );
#   Purpose : Computes the mean 8-bit channel color.
# Arguments : @COLORS = list of normalized channel intensities to be averaged.
# Externals : $Verbose
#      Subs : None.
#   Remarks : None.
#   History : v1.0.0 - January 23, 2008 - Original release.

sub meanColor {																				#begin sub
	my $mean;																				# mean 8-bit color value

	$mean += $_ for @_;																		# sum all the normalized color values
	$mean  = 256 * $mean / scalar @_;														# compute the mean 8-bit value
    printf "%5.1f ", $mean if $Verbose;														# report if requested
	return $mean;																			# return the mean
}																							#end sub meanColor
#===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# end of img2mosaic.pl