Photo Mosaic, Part IV:
Video clip version - unleash the "turtles"
Video clip version - unleash the "turtles"
You may well ask what have turtles to do with photo mosaics. As you might suspect, I'm not alluding to amphibean reptiles, but rather the control paradigm used by the Logo programming language and its turtle graphics. As with Logo, my turtles also have orientation and position. However, instead of using a pen to draw vector graphics, mine overlay photo mosaic tiles.
The motivation behind this unusual approach takes a bit of explaining. It crossed my mind that it might be interesting to make a video clip of the photo mosaic process as generated by the "img2photomosaic" script. At first blush, I would simply need to save the mosaic after each tile has been overlaid. Think of it as taking snapshots of the intermediate stages. But that means that there would be as many snapshot files and, hence, video frames as there are tiles. For the images I've been working with, this implies 30 to 40,000 frames, each between 2 and 3 Mbytes. Even considering any possible frame optimization, the resulting videos would be huge. To surmount the problem, one obvious solution is to scale down each frame. Experience shows that scaling indeed reduces the video size but this causes two new problems. First, the tiles themselves are so small that it makes it hard to appreciate what's going on. Also, the video is a tad boring as it takes a while before the tiny tiling process starts to make the process interesting. I could instead take snapshots after a certain number of tiles have been overlaid. Though it would drastically cut down the number of frames, the resulting video would certainly appear very jerky. So it occurred to me that a way of salvaging the project would be to have multiple, concurrent tile-overlaying processes. Instead of the single, bottom to top, left to right process, start many similar processes at various locations. Of course, the crux of the problem now becomes how to orchestrate all these processes. Upon considering some sort of recursive version of "img2photomosaic", difficult control issues quickly emerged. It just wasn't clear to me how they could be resolved in a simple manner. So I opted instead to unleash a bale of turtles on the task!
Let's begin by exploring how to make a virtual turtle move around a checkerboard so as to visit every square. Each square has a row and column coordinate, in the range 0 to 7. The board's origin is located at the top left corner square, with the x-coordinate running horizontally and the y one vertically. A turtle is a hash with heading and coordinate values. So, with north pointing towards decreasing y-values, we then have the following Perl statement for a turtle placed at the origin with a southern heading:
my %Turtle = ( HEADING => 'S',
X => 0,
Y => 0
);
Next we need to establish rules governing the turle's movements. If no board edge (boundary) ahead or the adjacent square ahead has not been visited (i.e., no tracks present), move into the square. Otherwise, turn left in the current square and try again. However, if the turtle spins around completely, halt. This last condition is readily checked by counting the number of consecutive turns and stopping after four. This pseudocode can be implemented as follows:
my @Tracks; #array for recording turtle's locations
my $No_Consecutive_Turns; #number of consecutive left turns by turtle
$Tracks[$Turtle{X}][$Turtle{Y}] = 1; #record turtle's initial location
until( $No_Consecutive_Turns == 4 ) { #repeat
if( &noTracksAhead() and &noBoundaryAhead() ) { # if next step forward is permitted
&stepForward(); # move forward one step
} else { # else
&turnLeft(); # turn left
} # end if-else
} #until complete spin around
exit;
Finally, we just need the four subroutines that carry out the checks and movements:
my $No_Rows = 8;
my $No_Cols = 8;
sub noTracksAhead {
if ( $Turtle{HEADING} eq 'S' ) { return !$Tracks[$Turtle{X}][$Turtle{Y}+1]; }
elsif( $Turtle{HEADING} eq 'N' ) { return !$Tracks[$Turtle{X}][$Turtle{Y}-1]; }
elsif( $Turtle{HEADING} eq 'E' ) { return !$Tracks[$Turtle{X}+1][$Turtle{Y}]; }
elsif( $Turtle{HEADING} eq 'W' ) { return !$Tracks[$Turtle{X}-1][$Turtle{Y}]; }
}
sub noBoundaryAhead {
if ( $Turtle{HEADING} eq 'S' ) { return $Turtle{Y} + 1 < $No_Rows; }
elsif( $Turtle{HEADING} eq 'N' ) { return $Turtle{Y} - 1 >= 0; }
elsif( $Turtle{HEADING} eq 'E' ) { return $Turtle{X} + 1 < $No_Cols; }
elsif( $Turtle{HEADING} eq 'W' ) { return $Turtle{X} - 1 >= 0; }
}
sub stepForward {
if ( $Turtle{HEADING} eq 'S' ) { ++$Turtle{Y}; }
elsif( $Turtle{HEADING} eq 'N' ) { --$Turtle{Y}; }
elsif( $Turtle{HEADING} eq 'E' ) { ++$Turtle{X}; }
elsif( $Turtle{HEADING} eq 'W' ) { --$Turtle{X}; }
$Tracks[$Turtle{X}][$Turtle{Y}] = 1; # update turtle's accessed locations
$No_Consecutive_Turns = 0; # reset the turn count
}
sub turnLeft {
$Turtle{HEADING} =~ tr/NSEW/WENS/; # set new heading
++$No_Consecutive_Turns; # increment the turn count
}
Of course, other rules can also achieve the desired result. However, the above approach is straightfoward in that it doesn't require the turtle to turn right at any stage and, thus, knowing how and when to. The simple animated GIF to the left represents the actual trek generated by the above code. You can download the complete routine "__turtle.pl" here and its MD5 checksum here.
Having a single turtle trekking around the checkerboard is just the first step. Our ultimate goal is to have a group of turtles, collectively known apparently as a bale. Accordingly, the above code can be readily extended by converting the variable "$No_Consecutive_Turns" to an array with one element for each turtle. The hash "%Turtle" now becomes "@Bale", an array of hashes. For example, for four turtles placed at each corner, we have
my @Bale = ( { HEADING => 'S', X => 0, Y => 0 }, #define turtle at top left corner
{ HEADING => 'E', X => 0, Y => $No_Rows - 1 }, #define turtle at bottom left corner
{ HEADING => 'N', X => $No_Cols - 1, Y => $No_Rows - 1 }, #define turtle at bottom right corner
{ HEADING => 'W', X => $No_Cols - 1, Y => 0 } #define turtle at top right corner
);
The control loop becomes
my @Tracks; #array for recording bale's locations
my @No_Consecutive_Turns; #number of consecutive left turns by turtles
$Tracks[$Bale[$_]{X}][$Bale[$_]{Y}] = 1 for (0..$#Bale); #record turtles initial locations
until( &sumArray(@No_Consecutive_Turns) == 4 * @Bale ) { #repeat
for my $turtle ( 0..$#Bale ) { # repeat for each turtle
next if $No_Consecutive_Turns[$turtle] == 4; # skip if turtle has spun around
if( &noTracksAhead($turtle) and &noBoundaryAhead($turtle) ) { # if next step forward is permitted
&stepForward($turtle); # move forward one step
} else { # else
&turnLeft($turtle); # turn left
} # end if-else
} # until all turtles processed
} #until all turtles have spun around
exit;
Note the presence of the additional subroutine "sumArray". As it name suggests, it simply totals the values of all the elements
of an array. Thus, the bale's trek comes to an end when the sum of consecutive turns by all the turtles is equal to four
times the bale's size.
Similar modifications are also carried out to the various subroutines. For example, "noTracksAhead" now requires a turtle's bale-index value in order to check for its tracks ahead:
sub noTracksAhead {
my $turtle = shift;
if ( $Bale[$turtle]{HEADING} eq 'S' ) { return !$Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}+1]; }
elsif( $Bale[$turtle]{HEADING} eq 'N' ) { return !$Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}-1]; }
elsif( $Bale[$turtle]{HEADING} eq 'E' ) { return !$Tracks[$Bale[$turtle]{X}+1][$Bale[$turtle]{Y}]; }
elsif( $Bale[$turtle]{HEADING} eq 'W' ) { return !$Tracks[$Bale[$turtle]{X}-1][$Bale[$turtle]{Y}]; }
}
The animated GIF on the right represents the actual trek generated by the above code. You can download the complete routine "__bale.pl" here and its MD5 checksum here.
There's an important caveat here: the starting locations and headings are critical. Success is guaranteed if the turtles start at opposite corners with the appropriate unique headings. Otherwise, a turtle can become boxed in prematurely or an area of the board unreachable after being fenced in by the turtles' tracks.
In accordance then with this warning, the following recursive approach was adopted for initilizating the locations. Divide a region into quadrants. Place either
- a turtle at the top left corner, or
- a turtle at the top left corner and one at the bottom right or
- one at each corner,
 One turtle per quadrant |
 Two turtles per quadrant |
 Four turtles per quadrant |
The number of turtles one gets therefore for the first five recursion levels are as follows:
| Recursion Depth | ||||||
|---|---|---|---|---|---|---|
| 0 | 1 | 2 | 3 | 4 | ||
| Number of turtles per quadrant |
1 | 1 | 4 | 16 | 64 | 256 |
| 2 | 2 | 8 | 32 | 128 | 512 | |
| 4 | 4 | 16 | 64 | 256 | 1024 | |
Note that the quadrants will be of equal size if the grid has an even number of rows and columns. Otherwise, they will be assymetric. However these distortions will be inconsequential if the quadrant boundaries are close enough to the true center lines. Hence there's no need for any additional scaling of the original image beyond that of insuring an integral number of tiles. Also note that the above initial positions guarantee that the turtles will not wander off into adjacent quadrants. Finally, even though certain combinations yield the same bale size, the resulting visual effects will be different.
Fusing the above turtle controls then to our "img2photomosaic" filter yields the Perl script img2photomosaic_slides.pl, which is displayed below. It is released for personal, non-commercial and non-profit use only. The program generates a sequence of slide images which can then be converted into a video clip by third party applications. Our featured AVI video clip, ugolino_640x480_256.avi, was produced with the free, now a decade old Fast Movie Processor 1.41.
The listing includes the line numbers in order to reference them in the following general remarks:
- Lines 001-130: All the opening remarks for
img2photomosaic.pl
apply here, except that we have a few additional processing parameters to declare. The
arguments "SlideWidth" and "SlideHeight" dictate the dimensions of each slide/video frame. Setting
both to zero waves off any scaling. The number of turtles is governed by the arguments "InitType" and
"InitRepeat" as per our previous discussion.
To create the slides for our example video clip, the following command was executed:
perl img2photomosaic_slides.pl ugolino.jpg ALL 15 15 640 480 4 3
- Lines 133-148: Initializes the locations and headings for all the turtles. The section starts by checking that the bale size doesn't exceed the number of tiles to create. The call to Subroutine "InitBale" at Line 147 launches the recursive initialization process by first treating the whole image as a single quadrant.
- Lines 151-174: Unleashes the bale to overlay the photomosaic tiles. The motion controls are those we discussed previously. After a turtle has been relocated, a call to Subroutine "overlayTile" is made to draw the best matching tile over the turtle's corresponding image area. Subroutine "outputSnapshot" outputs the partially completed mosaic after all the turtles have completed their current tasks.
- Lines 176-225: See our discussion of img2mosaic.pl for details regarding Subroutines "bestTileMatch" and "meanColor".
- Lines 235-278: Subroutine version of the photomosaic overlaying process in img2mosaic.pl. Instead of two nested loops directing the whole process, the routine is executed after each turtle's relocation. The image coordinates of the targeted region are now a function of a turtle's grid coordinates and a tile's dimensions.
- Lines 288-365: The five basic subroutines we discussed previously for controlling a turtle's movements.
- Lines 375-384: Outputs the current state of the photomosaic image to a file. The file's basename is formatted, with zero padding, in order to accomodate video-creation software that only allows sorting by filename and not by creation date.
- Lines 398-433: This final subroutine intializes the turtles locations and headings in accordance with the scheme we elaborated previously.
If you have any questions regarding the code or my explanations, please do not hesitate in contacting me.
001 use strict;
002 use File::Basename;
003 use Image::Magick;
004 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
005 # img2photomosaic_slides.pl: Photo mosaic slide generator.
006 #===============================================================================================================================
007 # Usage : perl img2photomosaic_slides.pl ImageFile TileCollections TileWidth TileHeight
008 # SlideWidth SlideHeight InitType InitRepeat Verbose
009 # Arguments : ImageFile = path of image file to be filtered.
010 # TileCollections = CSV string specifying which tiles to use or exclude, via references to their source
011 # collections:
012 # "ALL" to use all the available tiles, or
013 # "+,ImageCollectionName1,ImageCollectionName2,..." to use just the tiles in the subset, or
014 # "-,ImageCollectionName1,ImageCollectionName2,..." to exclude the subset from use.
015 # TileWidth = width of a tile in pixels
016 # TileHeight = height of a tile in pixels
017 # SlideWidth = width of each slide in pixels
018 # SlideHeight = height of each slide in pixels
019 # InitType = number of turtles per quadrant: 1,2 or 4
020 # InitRepeat = recursion depth for partioning the image into quadrants
021 # Verbose = boolean flag for verbose output
022 # Input Files : See arguments. Also "photomosaic_tiles.dbm", the DBM file of tile information.
023 # Output Directory : Slide subdirectory "frames". Directory will be created if it does not exist.
024 # Output Files : (a) Mosaic GIF file in the form "basename_wxh_px_tiles.gif" where "basename" denotes the basename of the
025 # source image file, "w" the tile width and "h" the tile height,
026 # (b) the slide JPEG files, in the form "nnn.jpg" where "nnn" denotes a positive zero-padded integer.
027 # Temporary Files : None.
028 # Remarks : (a) Requires PerlMagick. Used module from ImageMagick 6.3.7,
029 # (b) Setting both 'SlideWidth' and 'SlideHeight' to zero will suppress any scaling of the slides,
030 # (c) The number of turtles, corresponding to the values of 'InitType' and 'InitRepeat', will be as follows:
031 # InitRepeat
032 # 0 1 2 3 4 ....
033 # +---------------------------------------------
034 # 1 | 1 4 16 64 256
035 # InitType 2 | 2 8 32 128 512
036 # 4 | 4 16 64 256 1024
037 # History : v1.0.0 - March 9, 2008 - Original release.
038 #===============================================================================================================================
039 # 0) INITIALIZE:
040 system( 'cls' ) if $^O =~ /^MSWin/; #clear screen if running Windows
041 print "$0\n", '=' x length($0), "\n\n"; #display program name
042
043 my $SourceFile = shift || die 'ERROR: No image file specified'; #get path of source image file
044 my $Collections = shift || die 'ERROR: No tile collection references specified'; #get tile collection references
045 my $TileWidth = shift || die 'ERROR: No tile width specified'; #get pixel width of a tile
046 my $TileHeight = shift || die 'ERROR: No tile height specified'; #get pixel height of a tile
047 my $SlideWidth = shift;
048 my $SlideHeight = shift;
049 my $InitType = shift;
050 my $InitRepeat = shift;
051 my $Verbose = shift; #get boolean flag for verbose mode
052 die "ERROR: Cannot locate image file '$SourceFile'" unless -e $SourceFile;
053 die "ERROR: Also set 'SlideWidth' to zero to suppress scaling"
054 if $SlideHeight == 0 and $SlideWidth;
055 die "ERROR: Also set 'SlideHeight' to zero to suppress scaling"
056 if $SlideWidth == 0 and $SlideHeight;
057 die "ERROR: Invalid value for 'InitType'" unless
058 ( $InitType == 1 ) or ( $InitType == 2 ) or ( $InitType == 4 );
059 die "ERROR: Invalid value for 'InitRepeat'" if $InitRepeat < 0;
060
061 fileparse_set_fstype(''); #force Unix syntax
062 my ( $basename, #extract basename &
063 $path #extract path
064 ) = fileparse( $SourceFile, '\..*' ); # of source image file
065 my $MosaicFile = "$path${basename}_${TileWidth}x${TileHeight}_px_tiles.jpg"; #compose filename of mosaic image
066
067 my $NoSlides; #slide count
068 my $FrameDir = 'frames'; #frame subdirectory
069 die "ERROR: Cannot create directory '$FrameDir': $!"
070 unless ( -d $FrameDir ) or ( mkdir $FrameDir, 0600 );
071
072 my $Tile = Image::Magick->new( magick=>"GIF" ); #instantiate an image object for a tile
073 my $TileDir = "tiles_${TileWidth}x${TileHeight}_px"; #tile subdirectory
074 my $TileDBM = "$TileDir/photomosaic_tiles.dbm"; #DBM filepath for tile info
075
076 my %TileRGB; #hash of tile rgb values
077 { #start naked block
078 my %tileInfo; # DBM hash
079 my ($collOption) = $Collections =~ /^(ALL|\+|\-)/; # collections processing option
080 die "ERROR: Cannot recognize collection option '$collOption' in '$Collections'"
081 unless $collOption;
082 my $collName; # name of a tile's associated image collection
083 my $key; # DBM hash key
084 my $value; # DBM hash value
085 my @rgb; # array of rgb values for a tile
086 dbmopen( %tileInfo, $TileDBM, undef ) # open the DBM file of tile info
087 or die "ERROR: No tiles available of the specified width and height.";
088 while( ( $key, $value ) = each %tileInfo ) { # repeat for each tile record
089 ( $collName, @rgb ) = split /,/, $value; # parse collection name & rgb values
090 push @{$TileRGB{$key}}, @rgb # retain this tile
091 if ( $collOption eq 'ALL' ) or # if inclusion of all tiles requested, or
092 ( $collOption eq '+' and $Collections =~ /\Q$collName\E,*/ ) or # if use only some collections, or
093 ( $collOption eq '-' and $Collections !~ /\Q$collName\E,*/ ); # if not excluded
094 } # until all tile records processed
095 dbmclose %tileInfo; # close the DBM file
096 undef %tileInfo; # discard DBM hash
097 } #end naked block
098 #-------------------------------------------------------------------------------------------------------------------------------
099 # 1) SETUP MOSAIC IMAGE:
100 my $source = Image::Magick->new; #instantiate an image object for the source
101 my ( $SourceWidth, #get width &
102 $SourceHeight #get height
103 ) = ( $source->Ping( $SourceFile ) )[0,1]; #of source
104 undef $source; #destroy the image object for the source
105
106 my $No_Tile_Cols = $SourceWidth / $TileWidth; #compute raw number of tile columns
107 $No_Tile_Cols = int( ++$No_Tile_Cols ) #adjust to an integral number
108 unless $No_Tile_Cols == int( $No_Tile_Cols ); # if necessary
109 my $No_Tile_Rows = $SourceHeight / $TileHeight; #compute raw number of tile rows
110 $No_Tile_Rows = int( ++$No_Tile_Rows ) #adjust to an integral number
111 unless $No_Tile_Rows == int( $No_Tile_Rows ); # if necessary
112
113 my $MosaicWidth = $No_Tile_Cols * $TileWidth; #compute pixel width of mosaic image
114 my $MosaicHeight = $No_Tile_Rows * $TileHeight; #compute pixel height of mosaic image
115 my $Mosaic = Image::Magick->new( magick=>"JPG" ); #instantiate an image object for the mosaic
116 $Mosaic->Read( $SourceFile ); #init mosaic with source image file
117 $Mosaic->Quantize( colorspace=>'RGB' ); #insure correct colorspace
118 $Mosaic->Scale( geometry=>"${MosaicWidth}x${MosaicHeight}!" ); #scale mosaic image
119
120 print "Source Image: $SourceFile\n", #echo initialization results
121 " Width: $SourceWidth px\n",
122 " Height: $SourceHeight px\n",
123 "Mosaic Image: $MosaicFile\n",
124 " Width: $MosaicWidth px\n",
125 " Height: $MosaicHeight px\n",
126 "Mosaic Details: ", $No_Tile_Cols * $No_Tile_Rows, " tiles\n",
127 " No. of rows: $No_Tile_Rows\n",
128 " No. of cols: $No_Tile_Cols\n",
129 " Tile width: $TileWidth px\n",
130 " Tile height: $TileHeight px\n";
131 #-------------------------------------------------------------------------------------------------------------------------------
132 # 2) INITIALIZE BALE:
133 my @Bale; #array of hashes for the turtle headings & coordinates
134 my @Tracks; #array for recording bale's prior locations
135 { #start naked block
136 my $no_turtles; # number of turtles
137 $no_turtles = 4**$InitRepeat if $InitType == 1; # compute number of turtles according to initialization type
138 $no_turtles = 2*4**$InitRepeat if $InitType == 2;
139 $no_turtles = 4**($InitRepeat+1) if $InitType == 4;
140
141 print "Bale Details: $no_turtles turtles\n",
142 " Init Type: $InitType turtle(s) per quadrant\n",
143 " Init Repeat: $InitRepeat\n\n";
144 die "ERROR: Bale size exceeds number of tiles"
145 if $no_turtles > $No_Tile_Cols * $No_Tile_Rows;
146 }
147 &initBale( 0, 0, $No_Tile_Cols - 1, $No_Tile_Rows - 1, $InitRepeat ); # init all turtles
148 print( "Pause. Press the ENTER key to continue..." ), <STDIN> if $Verbose;
149 #-------------------------------------------------------------------------------------------------------------------------------
150 # 3) PUT TURTLES IN MOTION:
151 my $Snapshot = Image::Magick->new( magick=>"JPG" ); #instantiate an image object for the mosaic
152 my $SnapshotIdx = 0; #snapshot index
153 my $SnapshotIdxWidth = length( $No_Tile_Cols * $No_Tile_Rows ); #set width of slide basenames
154 my @No_Consecutive_Turns; #array for number of consecutive left turns by each turtle
155
156 &outputSnapshot(); #output source image as first slide
157 &overlayTile($_) for ( 0..$#Bale ); #overlay first tiles before putting bale in motion
158 &outputSnapshot(); #output resulting slide
159
160 until( &sumArray(@No_Consecutive_Turns) == 4 * @Bale ) { #repeat
161 for my $turtle ( 0..$#Bale ) { # repeat for each turtle
162 next if $No_Consecutive_Turns[$turtle] == 4; # skip if turtle has spun around
163 if( &noTracksAhead($turtle) and &noBoundaryAhead($turtle) ) { # if next step forward is permitted
164 &stepForward($turtle); # move forward one step
165 &overlayTile($turtle); # overlay tile at location
166 } else { # else
167 &turnLeft($turtle); # turn left
168 } # end if-else
169 } # until all turtles processed
170 &outputSnapshot(); # output resulting slide
171 } #until all turtles have spun around
172 $Mosaic->Write( filename => $MosaicFile ); #save the mosaic to file
173 print "\a\nNumber of slides: $NoSlides\n\nDone!\n"; #report end of processing
174 exit; #end processing
175 #===== SUBROUTINES =============================================================================================================
176 # Usage : &bestTileMatch( $RED, $GREEN, $BLUE );
177 # Purpose : Matches a tile to the mean RGB channel values of an image area.
178 # Arguments : $RED = mean 8-bit red color
179 # $GREEN = mean 8-bit green color
180 # $BLUE = mean 8-bit blue color
181 # Externals : $TileRGB, $Verbose
182 # Subs : None.
183 # Remarks : None.
184 # History : v1.0.0 - January 23, 2008 - Original release.
185
186 sub bestTileMatch { #begin sub
187 my ( $red, $green, $blue ) = @_; # parametrize the arguments
188 my $bestTile; # name of tile that best matches mean color
189 my $deltaRed; # difference in red color values
190 my $deltaGreen; # difference in green color values
191 my $deltaBlue; # difference in blue color values
192 my $key; # hash key = tile name
193 my $value; # hash value = array of channel color intensities
194 my $metric; # squared Euclidean metric of intensities
195 my $minMetric = 65536 * 65536; # minimum value of the metric
196
197 while( ( $key, $value ) = each %TileRGB ) { # repeat for each possible tile
198 $deltaRed = $red - @{$value}[0]; # compute difference in red colors
199 $deltaGreen = $green - @{$value}[1]; # compute difference in green colors
200 $deltaBlue = $blue - @{$value}[2]; # compute difference in blue colors
201 $metric = $deltaRed * $deltaRed + # compute metric
202 $deltaGreen * $deltaGreen +
203 $deltaBlue * $deltaBlue;
204 $minMetric = $metric, $bestTile = $key if $metric < $minMetric; # update minimum metric & possible best tile
205 } # until all tiles processed
206 print "=> $bestTile\n" if $Verbose; # report if requested
207 return $bestTile; # return best matching tile name
208 } #end sub bestTileMatch
209 #-------------------------------------------------------------------------------------------------------------------------------
210 # Usage : &meanColor( @COLORS );
211 # Purpose : Computes the mean 8-bit channel color.
212 # Arguments : @COLORS = list of normalized channel intensities to be averaged.
213 # Externals : $Verbose
214 # Subs : None.
215 # Remarks : None.
216 # History : v1.0.0 - January 23, 2008 - Original release.
217
218 sub meanColor { #begin sub
219 my $mean; # mean 8-bit color value
220
221 $mean += $_ for @_; # sum all the normalized color values
222 $mean = 256 * $mean / scalar @_; # compute the mean 8-bit value
223 printf "%5.1f ", $mean if $Verbose; # report if requested
224 return $mean; # return the mean
225 } #end sub meanColor
226 #-------------------------------------------------------------------------------------------------------------------------------
227 # Usage : &overlayTile( TURTLE );
228 # Purpose : Overlays the region corresponding to a turtle's location with the best matching photomosaic tile.
229 # Arguments : TURTLE = turtle's array index for @Bale.
230 # Externals : $Tile, $TileDir, $TileHeight, $TileWidth, $Verbose, @Bale
231 # Subs : &bestTileMatch, &meanColor.
232 # Remarks : None.
233 # History : v1.0.0 - March 9, 2008 - Original release.
234
235 sub overlayTile { #begin sub
236 my $turtle = shift; # turtle index
237 my $x_top_left = $Bale[$turtle]{X} * $TileWidth; # image x-coordinate of a tile's top-left corner
238 my $y_top_left = $Bale[$turtle]{Y} * $TileHeight; # image y-coordinate of a tile's top-left corner
239 my $x_bottom_right = $x_top_left + $TileWidth - 1 ; # image x-coordinate of a tile's bottom-right corner
240 my $y_bottom_right = $y_top_left + $TileHeight - 1 ; # image y-coordinate of a tile's bottom-right corner
241 my $best_tile; # name of best matching tile
242 my $geometry; # geometry of a tile: width, height & x,y offsets
243
244 print " overlayTile: $x_top_left,$y_top_left-$x_bottom_right,$y_bottom_right: " # report progress if requested
245 if $Verbose;
246
247 $geometry = "${TileWidth}x${TileHeight}+$x_top_left+$y_top_left"; # define tile geometry
248 $best_tile = &bestTileMatch ( # match mean image-area colors to a tile
249 &meanColor ( # compute mean red color
250 $Mosaic->GetPixels ( # get normalized red intensities of all pixels
251 map => 'r',
252 geometry => $geometry,
253 normalize => 'true'
254 )
255 ),
256 &meanColor ( # compute mean green color
257 $Mosaic->GetPixels ( # get normalized green intensities of all pixels
258 map => 'g',
259 geometry => $geometry,
260 normalize => 'true'
261 )
262 ),
263 &meanColor ( # compute mean blue color
264 $Mosaic->GetPixels ( # get normalized blue intensities of all pixels
265 map => 'b',
266 geometry => $geometry,
267 normalize => 'true'
268 )
269 )
270 );
271 @$Tile = (); # reset tile object
272 $Tile->Read( "$TileDir/$best_tile" ); # init tile with its image file
273 $Mosaic->Composite( # overlay image subregion with tile
274 image => $Tile,
275 compose => 'Over',
276 geometry => $geometry
277 );
278 } #end sub overlayTile
279 #-------------------------------------------------------------------------------------------------------------------------------
280 # Usage : &noTracksAhead( TURTLE );
281 # Purpose : Returns true if the next grid location ahead has not been visited. Otherwise, returns false.
282 # Arguments : TURTLE = turtle's array index for @Bale.
283 # Externals : @Bale, @Tracks
284 # Subs : None.
285 # Remarks : None.
286 # History : v1.0.0 - March 3, 2008 - Original release.
287
288 sub noTracksAhead { #begin sub
289 my $turtle = shift;
290
291 if ( $Bale[$turtle]{HEADING} eq 'S' ) { return !$Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}+1]; }
292 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { return !$Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}-1]; }
293 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { return !$Tracks[$Bale[$turtle]{X}+1][$Bale[$turtle]{Y}]; }
294 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { return !$Tracks[$Bale[$turtle]{X}-1][$Bale[$turtle]{Y}]; }
295 } #end sub noTracksAhead
296 #-------------------------------------------------------------------------------------------------------------------------------
297 # Usage : &noBoundaryAhead( TURTLE );
298 # Purpose : Returns true if the next grid location ahead is beyond a boundary. Otherwise, returns false.
299 # Arguments : TURTLE = turtle's array index for @Bale.
300 # Externals : @Bale, @Tracks
301 # Subs : None.
302 # Remarks : None.
303 # History : v1.0.0 - March 3, 2008 - Original release.
304
305 sub noBoundaryAhead { #begin sub
306 my $turtle = shift;
307
308 if ( $Bale[$turtle]{HEADING} eq 'S' ) { return $Bale[$turtle]{Y} + 1 < $No_Tile_Rows; }
309 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { return $Bale[$turtle]{Y} - 1 >= 0; }
310 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { return $Bale[$turtle]{X} + 1 < $No_Tile_Cols; }
311 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { return $Bale[$turtle]{X} - 1 >= 0; }
312 } #end sub noBoundaryAhead
313 #-------------------------------------------------------------------------------------------------------------------------------
314 # Usage : &stepForward( TURTLE );
315 # Purpose : Repositions a turtle to an adjacent grid location in accordance with its heading.
316 # Arguments : TURTLE = turtle's array index for @Bale.
317 # Externals : $Verbose, @Bale, @No_Consecutive_Turns
318 # Subs : None.
319 # Remarks : None.
320 # History : v1.0.0 - March 3, 2008 - Original release.
321
322 sub stepForward { #begin sub
323 my $turtle = shift;
324
325 if ( $Bale[$turtle]{HEADING} eq 'S' ) { ++$Bale[$turtle]{Y}; }
326 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { --$Bale[$turtle]{Y}; }
327 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { ++$Bale[$turtle]{X}; }
328 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { --$Bale[$turtle]{X}; }
329 $Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}] = 1; # update bale's accessed locations
330 $No_Consecutive_Turns[$turtle] = 0; # reset turtle's turn count
331 print "stepForward: Turtle #$turtle - $Bale[$turtle]{X}, $Bale[$turtle]{Y}\n" # report new location if requested
332 if $Verbose;
333 } #end sub stepForward
334 #-------------------------------------------------------------------------------------------------------------------------------
335 # Usage : &turnLeft( TURTLE );
336 # Purpose : Changes a turtle's heading in accordance with a left turn.
337 # Arguments : TURTLE = turtle's array index for @Bale.
338 # Externals : $Verbose, @Bale, @No_Consecutive_Turns
339 # Subs : None.
340 # Remarks : None.
341 # History : v1.0.0 - March 3, 2008 - Original release.
342
343 sub turnLeft { #begin sub
344 my $turtle = shift;
345
346 $Bale[$turtle]{HEADING} =~ tr/NSEW/WENS/; # change heading to the left
347 ++$No_Consecutive_Turns[$turtle]; # update turtle's turn count
348 print "turnLeft: Turtle #$turtle - $Bale[$turtle]{HEADING}\n" # report new heading if requested
349 if $Verbose;
350 } #end sub turnLeft
351 #-------------------------------------------------------------------------------------------------------------------------------
352 # Usage : &sumArray( ARRAY );
353 # Purpose : Returns the sum of the elements of the specified array .
354 # Arguments : ARRAY = array to be summed
355 # Externals : None.
356 # Subs : None.
357 # Remarks : None.
358 # History : v1.0.0 - March 3, 2008 - Original release.
359
360 sub sumArray { #begin sub
361 my $sum;
362
363 $sum += $_ for @_;
364 return $sum;
365 } #end sub sumArray
366 #-------------------------------------------------------------------------------------------------------------------------------
367 # Usage : &outputSnapshot();
368 # Purpose : Outputs a scaled snapshot of the photomosaic to file.
369 # Arguments : None.
370 # Externals : $FrameDir, $NoSlides, $SlideHeight, $SlideWidth, $Snapshot, $SnapshotIdx, $SnapshotIdxWidth
371 # Subs : None.
372 # Remarks : None.
373 # History : v1.0.0 - March 9, 2008 - Original release.
374
375 sub outputSnapshot { #begin sub
376 my $snapshotFile = "$FrameDir/" . # compose file name
377 sprintf( "%${SnapshotIdxWidth}.${SnapshotIdxWidth}d", ++$SnapshotIdx ) .
378 '.jpg';
379 @$Snapshot = (); # reset snapshot object
380 $Snapshot = $Mosaic->Clone(); # init snapshot to full mosaic image
381 $Snapshot->Scale( geometry => "${SlideWidth}x${SlideHeight}!" ); # scale snapshot image
382 $Snapshot->Write( filename => $snapshotFile ); # save snapshot to file
383 ++$NoSlides; # increment slide count
384 } #end sub outputSnapshot
385 #-------------------------------------------------------------------------------------------------------------------------------
386 # Usage : &initBale( X_TOP_LEFT, Y_TOP_LEFT, X_BOTTOM_RIGHT, Y_BOTTOM_RIGHT, RECURSION_COUNT );
387 # Purpose : Recursively assigns initial grid locations and headings to all the turtles on a per quadrant basis.
388 # Arguments : X_TOP_LEFT = grid x-coordinate of top-left corner
389 # X_TOP_LEFT = grid y-coordinate of top-left corner
390 # X_BOTTOM_RIGHT = grid x-coordinate of bottom-right corner
391 # Y_BOTTOM_RIGHT = grid y-coordinate of bottom-right corner
392 # RECURSION_COUNT = counter for the recursion depth
393 # Externals : $InitType, @Bale, @Tracks
394 # Subs : None.
395 # Remarks : None.
396 # History : v1.0.0 - March 4, 2008 - Original release.
397
398 sub initBale { #begin sub
399 my $x_top_left = shift; # grid x-coordinate of top-left corner
400 my $y_top_left = shift; # grid y-coordinate of top-left corner
401 my $x_bottom_right = shift; # grid x-coordinate of bottom-right corner
402 my $y_bottom_right = shift; # grid y-coordinate of bottom-right corner
403 my $recursionCount = shift; # recursion counter
404
405 { # start naked block
406 unless( $Tracks[$x_top_left][$y_top_left] ) { # if top-left corner vacant
407 push @Bale, { HEADING => 'S', X => $x_top_left, Y => $y_top_left }; # define turtle at corner
408 $Tracks[$x_top_left][$y_top_left] = 1; # record turtle location
409 } # end if
410 last if $InitType == 1; # check if only one turtle to be defined
411 unless( $Tracks[$x_bottom_right][$y_bottom_right] ) { # if bottom-right corner vacant
412 push @Bale, { HEADING => 'N', X => $x_bottom_right, Y => $y_bottom_right }; # define turtle at corner
413 $Tracks[$x_bottom_right][$y_bottom_right] = 1; # record turtle location
414 } # end if
415 last if $InitType == 2; # check if only two turtles to be defined
416 unless( $Tracks[$x_top_left][$y_bottom_right] ) { # if bottom-left corner vacant
417 push @Bale, { HEADING => 'E', X => $x_top_left, Y => $y_bottom_right }; # define turtle at corner
418 $Tracks[$x_top_left][$y_bottom_right] = 1; # record turtle location
419 } # end if
420 unless( $Tracks[$x_bottom_right][$y_top_left] ) { # if top-right corner vacant
421 push @Bale, { HEADING => 'W', X => $x_bottom_right, Y => $y_top_left }; # define turtle at corner
422 $Tracks[$x_bottom_right][$y_top_left] = 1; # record turtle location
423 } # end if
424 } # end naked block
425 if( $recursionCount ) { # if recursion in effect
426 my $x_center = $x_top_left + int( 0.5 * ( $x_bottom_right - $x_top_left ) ); # x-coordinate at 'center'
427 my $y_center = $y_top_left + int( 0.5 * ( $y_bottom_right - $y_top_left ) ); # y-coordinate at 'center'
428 &initBale( $x_top_left, $y_top_left, $x_center, $y_center, $recursionCount-1 ); # init top-left quadrant
429 &initBale( $x_top_left, $y_center+1, $x_center, $y_bottom_right, $recursionCount-1 ); # init bottom-left quadrant
430 &initBale( $x_center+1, $y_top_left, $x_bottom_right, $y_center, $recursionCount-1 ); # init top-right quadrant
431 &initBale( $x_center+1, $y_center+1, $x_bottom_right, $y_bottom_right, $recursionCount-1 ); # init bottom-right quadrant
432 } # end if
433 } #end sub initBale
434 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
435 # end of img2photomosaic_slides.pl