use strict; use English; use File::Basename; use Tk; #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================ # gui4photomosaic.pl: GUI for photo mosaic image filter "img2photomosaic.pl". #=============================================================================================================================== # Usage : perl gui4photomosaic.pl TileWidth TileHeight # Arguments : TileWidth = width of a tile in pixels # TileHeight = height of a tile in pixels # Input Files : "photomosaic_tiles.dbm", the DBM file of tile information. # Output Files : None. # Temporary Files : None. # Remarks : Calls "img2photomosaic.pl" in quiet mode to create the mosaic and "imdisplay.exe" to display it. # History : v1.0.0 - February 20, 2008 - Original release. #=============================================================================================================================== # 0) INITIALIZE: 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 $TileDir = "tiles_${TileWidth}x${TileHeight}_px"; #tile subdirectory my $TileDBM = "$TileDir/photomosaic_tiles.dbm"; #DBM filepath for tile info my $ActiveBgColor = 'Yellow'; #define background hover color for inputs my $ArgValBgColor = 'Gray'; #define background color for argument values my $BtnBgColor = 'Red'; #define backgrond color for execution buttons my $HeadingBgColor = 'Cyan'; #define background color for headings my $InputBgColor = 'DarkSeaGreen'; #define background color for inputs my $MainBgColor = 'DarkCyan'; #define main background color my $CollOption; #collections processing option my $SourceFile; #image filename my %TileSets; #hash of tile collections with "checkbox" values my $CollNameMaxLen; #length of longest collection name { #start naked block my %tileInfo; # DBM hash my $collName; # name of a tile's associated image collection my $collNameLen; # length of collection name my $key; # DBM hash key my $value; # DBM hash value dbmopen( %tileInfo, $TileDBM, undef ) # open the DBM file of tile info or die "ERROR: No tiles available of the specified width and height."; while( ( $key, $value ) = each %tileInfo ) { # repeat for each tile record $collName = ( split /,/, $value )[0]; # extract collection name unless( exists $TileSets{$collName} ) { # if new collection name $TileSets{$collName} = 0; # record collection name; init as not selected $collNameLen = length $collName; # compute its length $CollNameMaxLen = $collNameLen if $CollNameMaxLen < $collNameLen; # update maximum length } # end if } # until all tile records processed dbmclose %tileInfo; # close the DBM file undef %tileInfo; # discard DBM hash } #end naked block my %Options4ArgVal = ( -state=>'disabled', #options for tile dimension entry widget -disabledforeground=>'Black', -disabledbackground =>$ArgValBgColor, -width=>5 ); my %Options4Debug = ( -relief=>'solid', #options for setting a border during debug -borderwidth=>0 #(set to 0 or 1 to show or hide) ); my %Options4Heading = ( -background=>$HeadingBgColor, #options for heading labels -anchor=>'e', -font=>"fixed 9 bold", -padx=>5, -width=>13 ); my %Options4RadioBtn = ( -variable=>\$CollOption, #options for processing-option radio buttons -background=>$InputBgColor, -activebackground=>$ActiveBgColor ); my %Options4CheckBtn = ( -background=>$InputBgColor, #options for tile-collection checkboxes -activebackground=>$ActiveBgColor, -font=>"courier 9 normal", -anchor=>"w", -width=>$CollNameMaxLen ); my %Options4ExecBtn = ( -background=>$BtnBgColor, #options for execution buttons -activebackground=>$ActiveBgColor, ); #------------------------------------------------------------------------------------------------------------------------------- # 1) DEFINE MAIN WINDOW: my $Main = MainWindow->new(); #create new window widget $Main->minsize( qw(400 400) ); #set minimum size $Main->title( " GUI for img2photomosaic.pl" ); #set title $Main->configure( -background=>$MainBgColor ); #set background color $Main->geometry( '+300+100' ); #set initial screen location #------------------------------------------------------------------------------------------------------------------------------- # 2) ECHO TILE-WIDTH ARGUMENT: { #start naked block my $widthFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 ); $widthFrame->Label( -text=>'Tile Width:', %Options4Heading ) # display label ->pack( -side=>'left' ); $widthFrame->Entry( -textvariable=>$TileWidth, %Options4ArgVal ) # display value ->pack( -side=>'left', -padx=>10 ); } #end naked block #------------------------------------------------------------------------------------------------------------------------------- # 3) ECHO TILE-HEIGHT ARGUMENT: { #start naked block my $heightFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 ); $heightFrame->Label( -text=>'Tile Height:', %Options4Heading ) # display label ->pack( -side=>'left' ); $heightFrame->Entry( -textvariable=>$TileHeight, %Options4ArgVal ) # display value ->pack( -side=>'left', -padx=>10 ); } #end naked block #------------------------------------------------------------------------------------------------------------------------------- # 4) DEFINE ENTRY FIELDS FOR IMAGE FILENAME: { #start naked block my $fileFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define frame widget ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 ); $fileFrame->Label( -text=>'Image File:', %Options4Heading ) # display label ->pack( -side=>'left' ); $SourceFile = $fileFrame->Entry( -background=>$InputBgColor, -width=>40 ) # define input field ->pack( -side=>'left', -padx=>10 ); } #end naked block #------------------------------------------------------------------------------------------------------------------------------- # 5) DEFINE FIELDS FOR TILE COLLECTIONS: { #start naked block my $tilesFrame = $Main->Frame( -background=>$MainBgColor, %Options4Debug ) # define main frame widget ->pack( -side=>'top', -anchor=>'w', -padx=>10, -pady=>10 ); $tilesFrame->Label( -text => 'Tile Collections:', %Options4Heading ) # display label ->pack( -side=>'left', -anchor=>'n', -pady=>3 ); my $inputFrame = $tilesFrame->Frame( -background=>$MainBgColor, %Options4Debug ) # define sub frame widget for input area ->pack( -side=>'left', -anchor=>'w', -padx=>10 ); $inputFrame->Radiobutton( -text=>'ALL', -value=>'ALL', %Options4RadioBtn ) # define radiobutton for "ALL" option ->pack( -side=>'left', -anchor=>'n', -pady=>3 ) ->select(); my $subsetFrame = $inputFrame->Frame( -background=>$MainBgColor, # define sub frame for use/exclude area -relief=>'ridge', -borderwidth=>3 ) ->pack( -side=>'top', -anchor=>'w' ); my $radioFrame = $subsetFrame->Frame( -background=>$MainBgColor, %Options4Debug ) # define sub frame for use/exclude radiobtns ->pack( -side=>'top', -anchor=>'w' ); $radioFrame->Radiobutton( -text=>'Use Subset', -value=>'+', %Options4RadioBtn ) # define radiobutton for "+" option ->pack( -side => 'left' ); $radioFrame->Radiobutton( -text=>'Exclude Subset', -value=>'-', %Options4RadioBtn ) # define radiobutton for "-" option ->pack( -side=>'left' ); my $setsFrame = $subsetFrame->Frame( %Options4Debug ) # define sub frame for tile collection names ->pack( -side=>'top', -anchor=>'c', -pady=>10 ); for( sort keys %TileSets ) { # repeat for each tile collection name $setsFrame->Checkbutton( -variable=>\$TileSets{$_}, -text=>$_, %Options4CheckBtn ) # define checkbutton ->pack( -side=>'top', -anchor=>'w' ); } # until all names processed } #end naked block #------------------------------------------------------------------------------------------------------------------------------- # 6) DEFINE EXECUTION BUTTONS: { #start naked block my $btnFrame = $Main->Frame( -background => $MainBgColor, %Options4Debug ) # define frame for buttons ->pack( -side => 'bottom', -pady=>10 ); $btnFrame->Button( -text=>'Create Mosaic', -command=>\&createMosaic, %Options4ExecBtn ) # define button to create the mosaic ->pack( -side=>'left', -padx=>20 ); $btnFrame->Button( -text=>'Quit', -command => sub{ exit(0) }, %Options4ExecBtn ) # define button to exit ->pack( -side=>'right', -padx=>20 ); } #end naked block #------------------------------------------------------------------------------------------------------------------------------- MainLoop(); #start the GUI and handle all events #===== SUBROUTINES ============================================================================================================= # Usage : &createMosaic(); # Purpose : Launches the creation and viewing of the photo mosaic # Arguments : None. # Externals : $CollOption, $SourceFile, %TileSets # Subs : None. # Remarks : None. # History : v1.0.0 - February 20, 2008 - Original release. sub createMosaic { #begin sub my $sourceFileVal = $SourceFile->get or die 'ERROR: No image file specified'; # get filename of source image # Launch "img2photomosaic.pl" to create the mosaic my $collections = ( $CollOption eq 'ALL' ) # compose CSV string for tile collections ? 'ALL' # all tiles, or : join ',', $CollOption, grep { $TileSets{$_} } keys %TileSets; # use/exclude selected tile sets system( qq|perl img2photomosaic.pl "$sourceFileVal" "$collections" $TileWidth $TileHeight 0| ); # Launch "imdisplay.exe" to view the mosaic if created fileparse_set_fstype(''); # force Unix syntax my ( $basename, # extract basename & $path # extract path ) = fileparse( $sourceFileVal, '\..*' ); # of source image file my $mosaicFile = "$path${basename}_${TileWidth}x${TileHeight}_px_tiles.jpg"; # compose filename of mosaic image system( qq|imdisplay "$mosaicFile"| ) if -e "$mosaicFile"; } #end sub createMosaic #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================ # end of gui4photomosaic.pl