Now that the two fundamental scripts for creating photo mosaics are done, namely prep4photomosaic.pl and img2photomosaic.pl, a lot of time can be spent trying to find that ideal combination of tile sets that leads to the most visually appealing result. After a while, it becomes rather tedious typing which tile sets to try or exclude. Thus the motivation for some sort of a graphical user interface to drive the mosaic filter.
Of course, after coding such a GUI, one can go one step further and have the interface program launch an image viewer to display the resulting mosaic. Given that these discussion have involved the use of ImageMagick and its Perl interface PerlMagick, we use the application imdisplay.exe that comes with the distribution. We leave it to users to edit the system call for their preferred viewer.
The Perl script gui4photomosaic.pl, displayed below, creates the required GUI by making use of the Perl/Tk widget toolkit. As usual, our script is released for personal, non-commercial and non-profit use only.
The listing includes the line numbers in order to reference them in the following general remarks.
perl gui4photomosaic.pl 15 15
If you have any questions regarding the code or my explanations, please do not hesitate in contacting me.
001 use strict;
002 use English;
003 use File::Basename;
004 use Tk;
005 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
006 # gui4photomosaic.pl: GUI for photo mosaic image filter "img2photomosaic.pl".
007 #===============================================================================================================================
008 # Usage : perl gui4photomosaic.pl TileWidth TileHeight
009 # Arguments : TileWidth = width of a tile in pixels
010 # TileHeight = height of a tile in pixels
011 # Input Files : "photomosaic_tiles.dbm", the DBM file of tile information.
012 # Output Files : None.
013 # Temporary Files : None.
014 # Remarks : Calls "img2photomosaic.pl" in quiet mode to create the mosaic and "imdisplay.exe" to display it.
015 # History : v1.0.0 - February 20, 2008 - Original release.
016 #===============================================================================================================================
017 # 0) INITIALIZE:
018 my $TileWidth = shift || die 'ERROR: No tile width specified'; #get pixel width of a tile
019 my $TileHeight = shift || die 'ERROR: No tile height specified'; #get pixel height of a tile
020 my $TileDir = "tiles_${TileWidth}x${TileHeight}_px"; #tile subdirectory
021 my $TileDBM = "$TileDir/photomosaic_tiles.dbm"; #DBM filepath for tile info
022
023 my $ActiveBgColor = 'Yellow'; #define background hover color for inputs
024 my $ArgValBgColor = 'Gray'; #define background color for argument values
025 my $BtnBgColor = 'Red'; #define backgrond color for execution buttons
026 my $HeadingBgColor = 'Cyan'; #define background color for headings
027 my $InputBgColor = 'DarkSeaGreen'; #define background color for inputs
028 my $MainBgColor = 'DarkCyan'; #define main background color
029
030 my $CollOption; #collections processing option
031 my $SourceFile; #image filename
032
033 my %TileSets; #hash of tile collections with "checkbox" values
034 my $CollNameMaxLen; #length of longest collection name
035 { #start naked block
036 my %tileInfo; # DBM hash
037 my $collName; # name of a tile's associated image collection
038 my $collNameLen; # length of collection name
039 my $key; # DBM hash key
040 my $value; # DBM hash value
041 dbmopen( %tileInfo, $TileDBM, undef ) # open the DBM file of tile info
042 or die "ERROR: No tiles available of the specified width and height.";
043 while( ( $key, $value ) = each %tileInfo ) { # repeat for each tile record
044 $collName = ( split /,/, $value )[0]; # extract collection name
045 unless( exists $TileSets{$collName} ) { # if new collection name
046 $TileSets{$collName} = 0; # record collection name; init as not selected
047 $collNameLen = length $collName; # compute its length
048 $CollNameMaxLen = $collNameLen if $CollNameMaxLen < $collNameLen; # update maximum length
049 } # end if
050 } # until all tile records processed
051 dbmclose %tileInfo; # close the DBM file
052 undef %tileInfo; # discard DBM hash
053 } #end naked block
054
055 my %Options4ArgVal = ( -state=>'disabled', #options for tile dimension entry widget
056 -disabledforeground=>'Black',
057 -disabledbackground =>$ArgValBgColor,
058 -width=>5
059 );
060 my %Options4Debug = ( -relief=>'solid', #options for setting a border during debug
061 -borderwidth=>0 #(set to 0 or 1 to show or hide)
062 );
063 my %Options4Heading = ( -background=>$HeadingBgColor, #options for heading labels
064 -anchor=>'e',
065 -font=>"fixed 9 bold",
066 -padx=>5,
067 -width=>13
068 );
069 my %Options4RadioBtn = ( -variable=>\$CollOption, #options for processing-option radio buttons
070 -background=>$InputBgColor,
071 -activebackground=>$ActiveBgColor
072 );
073 my %Options4CheckBtn = ( -background=>$InputBgColor, #options for tile-collection checkboxes
074 -activebackground=>$ActiveBgColor,
075 -font=>"courier 9 normal",
076 -anchor=>"w",
077 -width=>$CollNameMaxLen
078 );
079 my %Options4ExecBtn = ( -background=>$BtnBgColor, #options for execution buttons
080 -activebackground=>$ActiveBgColor,
081 );
082 #-------------------------------------------------------------------------------------------------------------------------------
083 # 1) DEFINE MAIN WINDOW:
084 my $Main = MainWindow->new(); #create new window widget
085 $Main->minsize( qw(400 400) ); #set minimum size
086 $Main->title( " GUI for img2photomosaic.pl" ); #set title
087 $Main->configure( -background=>$MainBgColor ); #set background color
088 $Main->geometry( '+300+100' ); #set initial screen location
089 #-------------------------------------------------------------------------------------------------------------------------------
090 # 2) ECHO TILE-WIDTH ARGUMENT:
091 { #start naked block
092 my $widthFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget
093 ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 );
094 $widthFrame->Label( -text=>'Tile Width:', %Options4Heading ) # display label
095 ->pack( -side=>'left' );
096 $widthFrame->Entry( -textvariable=>$TileWidth, %Options4ArgVal ) # display value
097 ->pack( -side=>'left', -padx=>10 );
098 } #end naked block
099 #-------------------------------------------------------------------------------------------------------------------------------
100 # 3) ECHO TILE-HEIGHT ARGUMENT:
101 { #start naked block
102 my $heightFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget
103 ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 );
104 $heightFrame->Label( -text=>'Tile Height:', %Options4Heading ) # display label
105 ->pack( -side=>'left' );
106 $heightFrame->Entry( -textvariable=>$TileHeight, %Options4ArgVal ) # display value
107 ->pack( -side=>'left', -padx=>10 );
108 } #end naked block
109 #-------------------------------------------------------------------------------------------------------------------------------
110 # 4) DEFINE ENTRY FIELDS FOR IMAGE FILENAME:
111 { #start naked block
112 my $fileFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget
113 ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 );
114 $fileFrame->Label( -text=>'Image File:', %Options4Heading ) # display label
115 ->pack( -side=>'left' );
116 $SourceFile = $fileFrame->Entry( -background=>$InputBgColor, -width=>40 ) # define input field
117 ->pack( -side=>'left', -padx=>10 );
118 } #end naked block
119 #-------------------------------------------------------------------------------------------------------------------------------
120 # 5) DEFINE FIELDS FOR TILE COLLECTIONS:
121 { #start naked block
122 my $tilesFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define main frame widget
123 ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 );
124 $tilesFrame->Label( -text => 'Tile Collections:', %Options4Heading ) # display label
125 ->pack( -side=>'left', -anchor=>'n', -pady=>3 );
126
127 my $inputFrame = $tilesFrame->Frame( -background=>$MainBgColor, %Options4Debug ) # define sub frame widget for input area
128 ->pack( -side=>'left', -anchor=>'w', -padx=>10 );
129 $inputFrame->Radiobutton( -text=>'ALL', -value=>'ALL', %Options4RadioBtn ) # define radiobutton for "ALL" option
130 ->pack( -side=>'left', -anchor=>'n', -pady=>3 )
131 ->select();
132
133 my $subsetFrame = $inputFrame->Frame( -background=>$MainBgColor, # define sub frame for use/exclude area
134 -relief=>'ridge', -borderwidth=>3 )
135 ->pack( -side=>'top', -anchor=>'w' );
136 my $radioFrame = $subsetFrame->Frame( -background=>$MainBgColor, %Options4Debug ) # define sub frame for use/exclude radiobtns
137 ->pack( -side=>'top', -anchor=>'w' );
138 $radioFrame->Radiobutton( -text=>'Use Subset', -value=>'+', %Options4RadioBtn ) # define radiobutton for "+" option
139 ->pack( -side => 'left' );
140 $radioFrame->Radiobutton( -text=>'Exclude Subset', -value=>'-', %Options4RadioBtn ) # define radiobutton for "-" option
141 ->pack( -side=>'left' );
142
143 my $setsFrame = $subsetFrame->Frame( %Options4Debug ) # define sub frame for tile collection names
144 ->pack( -side=>'top', -anchor=>'c', -pady=>10 );
145 for( sort keys %TileSets ) { # repeat for each tile collection name
146 $setsFrame->Checkbutton( -variable=>\$TileSets{$_}, -text=>$_, %Options4CheckBtn ) # define checkbutton
147 ->pack( -side=>'top', -anchor=>'w' );
148 } # until all names processed
149 } #end naked block
150 #-------------------------------------------------------------------------------------------------------------------------------
151 # 6) DEFINE EXECUTION BUTTONS:
152 { #start naked block
153 my $btnFrame = $Main->Frame( -background => $MainBgColor, %Options4Debug ) # define frame for buttons
154 ->pack( -side => 'bottom', -pady=>10 );
155 $btnFrame->Button( -text=>'Create Mosaic', -command=>\&createMosaic, %Options4ExecBtn ) # define button to create the mosaic
156 ->pack( -side=>'left', -padx=>20 );
157 $btnFrame->Button( -text=>'Quit', -command => sub{ exit(0) }, %Options4ExecBtn ) # define button to exit
158 ->pack( -side=>'right', -padx=>20 );
159 } #end naked block
160 #-------------------------------------------------------------------------------------------------------------------------------
161 MainLoop(); #start the GUI and handle all events
162 #===== SUBROUTINES =============================================================================================================
163 # Usage : &createMosaic();
164 # Purpose : Launches the creation and viewing of the photo mosaic
165 # Arguments : None.
166 # Externals : $CollOption, $SourceFile, %TileSets
167 # Subs : None.
168 # Remarks : None.
169 # History : v1.0.0 - February 20, 2008 - Original release.
170
171 sub createMosaic { #begin sub
172 my $sourceFileVal = $SourceFile->get or die 'ERROR: No image file specified'; # get filename of source image
173
174 # Launch "img2photomosaic.pl" to create the mosaic
175 my $collections = ( $CollOption eq 'ALL' ) # compose CSV string for tile collections
176 ? 'ALL' # all tiles, or
177 : join ',', $CollOption, grep { $TileSets{$_} } keys %TileSets; # use/exclude selected tile sets
178 system( qq|perl img2photomosaic.pl "$sourceFileVal" "$collections" $TileWidth $TileHeight 0| );
179
180 # Launch "imdisplay.exe" to view the mosaic if created
181 fileparse_set_fstype(''); # force Unix syntax
182 my ( $basename, # extract basename &
183 $path # extract path
184 ) = fileparse( $sourceFileVal, '\..*' ); # of source image file
185 my $mosaicFile = "$path${basename}_${TileWidth}x${TileHeight}_px_tiles.jpg"; # compose filename of mosaic image
186 system( qq|imdisplay "$mosaicFile"| ) if -e "$mosaicFile";
187 } #end sub createMosaic
188 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
189 # end of gui4photomosaic.pl
© 2012 Webpraxis Consulting Ltd. – ALL RIGHTS RESERVED.