http://www.perlmonks.org?node_id=91401
Category: GUI Programming
Author/Contact Info djw
Description: ** update ** I fixed a small typo in the thumbnail sub and a small error in my html tags. djw - June 27/01. Sorry if the code format is off a bit, I was testing out Komodo as an editor.

You can find the latest and greatest version at my site. You can find win32 binaries of Tk as well as html examples of output.

WebPic Beta
================================

What it does:

Read in a directory of digital cam pics, scale them to whatever percentage you want(in multiples of 10), provide an option for descriptions, and write an html page for viewing pictures.


0.3.6 Changelog
***************
- removed all hard coded paths/names - added to options
- added html style types - cascade and thumbnails
- added some defaults for the options window
- added clear and cancel buttons to options
- added a help menu (this file) - will include more later

0.3.5 Changelog
***************
- finished options window
- added a new dir location option
- Added a scale value
- finished html output default

0.3.0 Changelog
***************
- Added GUI - too much to name, first real version


To Do:
  • Complete keyboard shortcuts and frame focus stuff for speedy use
  • No GUI option. eg: "# webpic.pl -nogui -scale 20% -dir /var/www/images -newdir pr0n" etc
  • add the option to not have descriptions (no gui mode only?)
  • thinking about a slideshow html style
  • Need to add html bg and font colors to the option
#!/usr/bin/perl -w
use Image::Magick;
use strict;
use Tk;
use Tk::JPEG;

#----------------------------------------------
# love me
my $displayPercentage = "0%";
my $htmlStyle = "Cascade";
my $scaleValue = "";
my $oldPicDir = "";
my $scaledImage = "";
my $description = "";
my $htmlLocation = "";
my $height = 0;
my $width = 0;
# two
my $count = 0;
my %imgHash = ();
my %thumbHash = ();
my @pictures = ();
my $last_image = 0;
# times
my $newPicDir = "wp-images";
my $htmlFileName = "wp-pictures.html";
my $title = "Perl WebPic 0.3.6 Beta";
my $info = "          Click Options to start.          ";
my $optionStatusInfo = "Enter all the details and press Done to contin
+ue.";




# Perl/Tk stuff for drawing our window and
# for controlling its actions - reprahsent!!
#
#------------------------------------------------
# Main Window configuration

my $mainWindow = MainWindow->new;
$mainWindow->title("$title");

# Menu Frame configuration - very top, all the way across
my $menuFrame = $mainWindow->Frame(-relief => 'ridge', -borderwidth =>
+ 2)->pack(-side => 'top', -anchor => 'n', -fill => 'x');
my $helpButton = $menuFrame->Menubutton(-text => ' Help ', -tearoff =>
+ '0', -underline => '1', -menuitems => [['command' => "Help", -comman
+d => \&help], "-", ['command' => "About", -command => \&about]])->pac
+k(-side => 'right');
my $fileButton = $menuFrame->Menubutton(-text => ' File ', -tearoff =>
+ '0', -underline => '1', -menuitems => [['command' => "Exit", -underl
+ine => '1', -command => sub { exit; }]])->pack(-side =>'left');
my $optionBUtton = $menuFrame->Button(-text => 'Options', -underline =
+> '0', -relief => 'flat', -command => \&optionWindow)->pack(-side => 
+'left');
my $runButton = $menuFrame->Button(-text => "  Scale  ", -underline =>
+ '2', -relief => 'flat', -state => 'disabled', -command => \&create_i
+mages)->pack(-side => 'left');

# Image Frame - under options, all the way across
my $imageFrame = $mainWindow->Frame->pack(-side => 'top', -anchor => '
+n', -fill => 'both', -expand => 1, -pady => 8);
my $imageFile = $imageFrame->Photo(-format => 'jpeg', -file => "$scale
+dImage");
my $imageLabel = $imageFrame->Label(-image => $imageFile)->pack(-ancho
+r => 'n', -side => 'top', -fill => 'x', expand => 1);

# Status Frame - under all, all the way across
my $statusFrame = $mainWindow->Frame(-relief => 'ridge', -borderwidth 
+=> 2)->pack(-side => 'bottom', -anchor => 's', -fill => 'x');
$statusFrame->Label(-textvariable => \$info)->pack(-side => 'bottom', 
+-anchor => 's');

# Description Frame - above status, all the way across
my $descriptionFrame = $mainWindow->Frame(-relief => 'ridge', -borderw
+idth => 2)->pack(-side => 'bottom', -anchor => 's', -fill => 'both');
$descriptionFrame->Label(-text => "Description:")->pack(-side => 'left
+', -anchor => 'w', -fill => 'x');
my $entryBox = $descriptionFrame->Entry(-textvariable => \$description
+, -state => 'disabled')->pack(-side => 'left', -anchor => 'w', -fill 
+=> 'x', -expand => 1);
my $nextButton = $descriptionFrame->Button(-text => 'Next', -command =
+> \&next_file, -state => 'disabled', -underline => '0')->pack(-side =
+> 'right', -anchor => 'e');
my $previousButton = $descriptionFrame->Button(-text => 'Prev', -comma
+nd => \&prev_file, -state => 'disabled', -underline => '0')->pack(-si
+de => 'right', -anchor => 'e');
my $finishButton = $descriptionFrame->Button(-text=> 'Write', -command
+ => \&write_html, -state => 'disabled', -underline => '1')->pack(-sid
+e => 'right', anchor => 'e');


MainLoop;


sub create_images
{
       
        if (-d $oldPicDir && $scaleValue)
        {
            $oldPicDir =~ s/\\/\//g;                    # wintendo suc
+ks ass
            $newPicDir =~ s/\\/\//g;                  # wintendo sucks
+ ass
            $htmlLocation =~ s/\\/\//g;              # wintendo sucks 
+ass
            @pictures = <$oldPicDir/*.JPG>;
            $count = 1000;
            if (-d $newPicDir)
            {
                1;
            } else {
                mkdir("$newPicDir", 0777) || die "Oops: ($!)";
            }

            foreach (@pictures) 
            {
                my $p = new Image::Magick;
                $p->Read("$_");
                $p->Scale("$scaleValue");
                $p->Write("$newPicDir/$count.jpg");
                $count++;
            }
            $last_image = $count -1;
            $count = 1000;
            $scaledImage = "$newPicDir/$count.jpg";
            $imageFile->configure(-file => $scaledImage);
            $nextButton->configure(-state => 'active');
            $info = "Enter a description for - $scaledImage";
            $runButton->configure(-state => 'disabled');
            $entryBox->configure(-state => 'normal');
        } else {
            $info = "Error: can't find directory: $oldPicDir. Double c
+heck your location";
            $runButton->configure(-state => 'disabled');
        }    
}


sub next_file
{
    if ($last_image == $count)
    {
        $imgHash{$scaledImage} = "$description";
        $description = "";
        $scaledImage = "";
        $imageFile->configure(-file => $scaledImage);
        $nextButton->configure(-state => 'disabled');
        $info = "Finished processing all images - click Write to creat
+e html";
        $finishButton->configure(-state => 'active');
    } else {
        $imgHash{$scaledImage} = "$description";
        $description = "";
        $previousButton->configure(-state => 'active');
        $count++;
        $scaledImage = "$newPicDir/$count.jpg";
        $info = "Enter description for: $scaledImage";
        $imageFile->configure(-file => $scaledImage);
    }
}


sub prev_file
{
    if($count == 1000)
    {
        $nextButton->configure(-state => 'active');
        $info = "Already at the first file - use 'Next' to cycle throu
+gh the list";
        $previousButton->configure(-state => 'disabled');
    } else {
        $description = "";
        $previousButton->configure(-state => 'active');
        $count--;
        $scaledImage = "$newPicDir/$count.jpg";
        $info = "Enter description for: $scaledImage";
        $imageFile->configure(-file => $scaledImage);
    }
}

#------------------------------------------------------------
# The write html sub checks $htmlStyle to see which
# of the next three html write subs to run

sub write_html
{
    if ($htmlStyle eq "Cascade")
    {
        htmlStyleCascade();
    } 
    elsif ($htmlStyle eq "Thumbnail")
    {
        htmlStyleThumbnail($newPicDir);
    }
    elsif ($htmlStyle eq "Slideshow")
    {
        htmlStyleSlideshow();
    }
}

#------------------------------------------------------------
# HTML style subs start here - cascsade, thumb, slide

sub htmlStyleCascade
{
    $finishButton->configure(-state => 'disabled');
    $previousButton->configure(-state => 'disabled');
        if ($htmlLocation) 
        {    
        open(HTML, "+>$htmlLocation/$htmlFileName") || die "Can't open
+ html file: ($!)\n";
    } else {
        open(HTML, "+>$htmlFileName") || die "Can't write html file: (
+$!)\n";
    }
    print HTML "<html><head><title>Automatically Generated by WebPic</
+title></head>\n";
    print HTML "<body bgcolor=\"#404040\" text=\"#FFFFFF\">\n";
    print HTML "<center><font size=\"1\">Automatically created with We
+bPic.</font><br><br><hr><table border=\"0\" cellpadding=\"0\" cellspa
+cing=\"0\">\n";
    print HTML "<tr><td align=\"center\">\n";
    foreach (sort keys %imgHash)
    {
        print HTML "<img src=\"$_\"><br><font size=\"1\" face=\"arial\
+">$imgHash{$_}</font><br><br>\n";
    }
    print HTML "</td></tr>";
    print HTML "</table><hr><font size=\"1\">Automatically created wit
+h WebPic.</font></center></body></html>\n";
    close(HTML);
    $info = "Completed.";
        
    #----------------------------
    # clear out all our options
            
    $oldPicDir = "";
        $displayPercentage = "0%";
        $scaleValue = "";
        $entryBox->configure(-state => 'disabled');
        $htmlStyle = "Cascade";
        $newPicDir = "";
        $scaledImage = "";
        $htmlFileName = "";
        $description = "";
        $htmlLocation = "";
}  
      
sub htmlStyleThumbnail
{
        $finishButton->configure(-state => 'disabled');
    $previousButton->configure(-state => 'disabled');
    my $popUpHeight = $height + 30;
    my $popUpWidth = $width +30;
    if ($htmlLocation) 
        {    
        open(HTML, "+>$htmlLocation/$htmlFileName") || die "Can't open
+ html file: ($!)\n";
    } else {
        open(HTML, "+>$htmlFileName") || die "Can't write html file: (
+$!)\n";
    }
    
    my $thumbCount = 1000;

    foreach (@pictures)
        {
            my $thumb = new Image::Magick;
            $thumb->Read("$_");
            $thumb->Scale("10%");
            $thumb->Write("$newPicDir/$thumbCount-thumb.jpg");
            $thumbHash{"$newPicDir/$thumbCount.jpg"} = "$newPicDir/$th
+umbCount-thumb.jpg";
            ($height, $width) = $thumb->Get('height', 'width');
            $thumbCount++;
        }
        
        print HTML "<html><head><title>Automatically Generated by WebP
+ic</title></head>\n";
        print HTML "<body bgcolor=\"#404040\" text=\"#FFFFFF\">\n";
    print HTML "<font size=\"1\">Automatically created with WebPic.</f
+ont><br><br><hr>\n";
    print HTML "<table border=\"1\" cellpadding=\"4\" cellspacing=\"6\
+">\n";
 
    my @imgArray = sort keys %imgHash;
    while (my @keys = splice(@imgArray, 0, 3))
    {
        print HTML "<tr>\n";
        my @values = @imgHash{@keys};
        foreach (@keys)
        {
                print HTML "<td><a href=\"$_\" target=\"_new\"><img sr
+c=\"$thumbHash{$_}\" border=\"0\"></a><br><font size=\"1\" face=\"ari
+al\">$imgHash{$_}</font></td>\n";
        }
        print HTML "</tr>\n";
    }
        print HTML "</table><hr><br><br><font size=\"1\">Automatically
+ created with WebPic.</font><br><br>\n";
        print HTML "</body></html>";
    close(HTML);
    
    $info = "Completed.";
    
    #----------------------------
    # clear out all our options
            
    $oldPicDir = "";
        $displayPercentage = "0%";
        $scaleValue = "";
        $entryBox->configure(-state => 'disabled');
        $htmlStyle = "Cascade";
        $newPicDir = "";
        $scaledImage = "";
        $htmlFileName = "";
        $description = "";
        $htmlLocation = "";

    
}

sub htmlStyleSlideshow
{
        $finishButton->configure(-state => 'disabled');
    $previousButton->configure(-state => 'disabled');
    $info = "Writing html file....";
    open(HTML, "+>$htmlLocation/$htmlFileName") || die "Can't open htm
+l file: ($!)\n";
    
}
#------------------------------------------------------------
# end of html style subs


#------------------------------------------------------------
# window for all my sexxah options
sub optionWindow 
{
        my $optionWindow = MainWindow->new;
    $optionWindow->title("$title");
        $optionWindow->geometry("400x330+40+20");

        # text label frame for locations
        my $labelFrame = $optionWindow->Frame->pack(-side => 'top', -a
+nchor => 'n', -fill => 'x', -pady => 8);
        $labelFrame->Label(-text => "Image and html Locations",  -reli
+ef => 'ridge')->pack(-side => 'top', -anchor => 'center', -fill => 'b
+oth');
        
        #----------------------------------
        # All the entry fields - Old pic dir, new pid dir, html filena
+me, html location
        
    # Old pic dir location entry
        my $oldPicFrame = $optionWindow->Frame->pack(-side => 'top', -
+anchor => 'n', -fill => 'x');
        $oldPicFrame->Label(-text => "  Old Image Location:")->pack(-s
+ide => 'left', -anchor => 'center');
        $oldPicFrame->Entry(-textvariable => \$oldPicDir)->pack(-side 
+=> 'left', -anchor => 'center', -fill => 'x', -expand => 1);
        
        # New pic dir location entry
        my $newPicFrame = $optionWindow->Frame->pack(-side => 'top', -
+anchor => 'n', -fill => 'x');
        $newPicFrame->Label(-text => "New Image Location:")->pack(-sid
+e => 'left', -anchor => 'center');
        $newPicFrame->Entry(-textvariable => \$newPicDir)->pack(-side 
+=> 'left', -anchor => 'center', -fill => 'x', -expand => 1);
        
        # HTML File name entry
        my $htmlNameFrame = $optionWindow->Frame->pack(-side => 'top',
+ -anchor => 'n', -fill => 'x');
        $htmlNameFrame->Label(-text => "       Name of html file:")->p
+ack(-side => 'left', -anchor => 'center');
        $htmlNameFrame->Entry(-textvariable => \$htmlFileName)->pack(-
+side => 'left', -anchor => 'center', -fill => 'x', -expand => 1);    
+    
        
        # HTML File locaion entry
        my $htmlLocationFrame = $optionWindow->Frame->pack(-side => 't
+op', -anchor => 'n', -fill => 'x');
        $htmlLocationFrame->Label(-text => "                 dir for h
+tml:")->pack(-side => 'left', -anchor => 'center');
        $htmlLocationFrame->Entry(-textvariable => \$htmlLocation)->pa
+ck(-side => 'left', -anchor => 'center', -fill => 'x', -expand => 1);
        
        # text label frame for other options
        my $optionsFrame = $optionWindow->Frame->pack(-side => 'top', 
+-anchor => 'n', -fill => 'x', -pady => 8);
        $optionsFrame->Label(-text => "Scale and html values",  -relie
+f => 'ridge')->pack(-side => 'top', -anchor => 'center', -fill => 'bo
+th');
        
        #-------------------------------------
        # All the buttons - Scale, html style, html colors
        
        # Scale optionmenu
        my $buttonFrame = $optionWindow->Frame->pack(-side => 'top', -
+anchor => 'n', -fill => 'x');
        $buttonFrame->Label(-text => "Scale:")->pack(-side => "left", 
+-anchor => 'center');
        my $scaleButton = $buttonFrame->Optionmenu(-textvariable => \$
+displayPercentage, -variable => \$scaleValue, -options => [ "0%", "10
+%", "20%", "30%",  "40%", "50%", "60%", "70%", "80%", "90%" ])->pack(
+-side => 'left', -anchor => 'center');
        
        # htmlStyle radio buttons
        my $htmlStyleFrame = $optionWindow->Frame->pack(-side => 'top'
+, -anchor => 'n', -fill => 'x');
        $htmlStyleFrame->Label(-text => "HTML Style type:",)->pack(-si
+de => 'left', -anchor => 'center');
        my $cascStyleButton = $htmlStyleFrame->Radiobutton(-text => "C
+ascade", -value => "Cascade", -variable => \$htmlStyle)->pack(-side =
+> 'left', anchor => 'center', -fill => 'both');
        my $thumbStyleButton = $htmlStyleFrame->Radiobutton(-text => "
+Thumbnail", -value => "Thumbnail", -variable => \$htmlStyle)->pack(-s
+ide => 'left', anchor => 'center', -fill => 'both');
        
        
        #-------------------------------------
        # These are always at the bottom
        # Info Frame
        my $optionStatusFrame = $optionWindow->Frame(-relief => 'ridge
+', -borderwidth => 2)->pack(-side => 'bottom', anchor => 's', -fill =
+> 'x');
    my $optionDoneLabel = $optionStatusFrame->Label(-textvariable => \
+$optionStatusInfo)->pack(-side => 'bottom', -anchor => 's');        
        
    # Done button frame...
    my $doneFrame = $optionWindow->Frame->pack(-side => 'bottom', anch
+or => 's', -fill => 'x');
    my $doneButton = $doneFrame->Button(-text => 'Done', -command => 
                                                 sub 
                                                 { 
                                                     if ($scaleValue &
+& $oldPicDir) {
                                                         $info = "Now 
+hit the Scale button to scale images";
                                                         $runButton->c
+onfigure(-state => 'active');
                                                         $optionWindow
+->destroy();
                                                     } else {
                                                         $optionStatus
+Info = "Please make sure you have entered all options";
                                                     }
                                                 },
                                                 -underline => '0')->p
+ack(-side => 'left');
    my $clearButton = $doneFrame->Button(-text => "Clear", -command =>
+ sub {
                                                                      
+                                      $oldPicDir = "";
                                                                      
+                                      $newPicDir = "";
                                                                      
+                                      $htmlFileName = "";
                                                                      
+                                      $htmlLocation = "";
                                                                      
+                                      $scaleValue = "";
                                                                      
+                                      $htmlStyle = "";
                                                                      
+                                      $optionStatusInfo = "All option
+s cleared";
                                                                      
+                                      $displayPercentage = "0%";
                                                                      
+                                      })->pack(-side => 'left');
    my $defaultsButton = $doneFrame->Button(-text => "Defaults", -comm
+and => sub {
                                                                      
+                                      $oldPicDir = "";
                                                                      
+                                      $newPicDir = "wp-images";
                                                                      
+                                      $htmlFileName = "wp-pictures.ht
+ml";
                                                                      
+                                      $htmlLocation = "";
                                                                      
+                                      $scaleValue = "";
                                                                      
+                                      $htmlStyle = "Cascade";
                                                                      
+                                      $optionStatusInfo = "Options re
+set to defaults.";
                                                                      
+                                      $displayPercentage = "0%";
                                                                      
+                                      })->pack(-side => 'left');     
+                                                                     
+                              
        my $cancelButton = $doneFrame->Button(-text => "Cancel", -comm
+and => sub { $optionWindow->destroy(); })->pack(-side => 'left');    
+    
}

sub help
{
       my $helpFile = "readme.txt";
       my $helpWindow = MainWindow->new;
       my $t = $helpWindow->Scrolled("Text")->pack(-side => 'top', -an
+chor => 'n', fill => 'both', expand => 1);
       open(FH, "$helpFile") || die "Can't find filename $helpFile: ($
+!)\n";
       while (<FH>) { $t->insert("end", "$_"); }
       MainLoop;
}


#------------------------------------------------------------
# code re-use from xjar's server status aboot window
sub about 
{
    my $aboutWindow = MainWindow->new;
    $aboutWindow->title("About WebPic");

    # Make a frame to display a little question mark logo
    my $logoFrame = $aboutWindow->Frame()->pack(-side => 'left');
    my $logoLabel = $logoFrame->Label(-bitmap => 'question')->pack(-si
+de => 'top', padx => 10, pady => 10);

    # And now make a frame for the About info...
    my $aboutFrame = $aboutWindow->Frame()->pack(-side => 'left', padx
+ => 15, pady => 10);
    my $aboutLabel = $aboutFrame->Label(-text => "$title\n\nWritten by
+ David Wakeman\ndjw\@gibfest.org\nhttp://www.gibfest.org/work/webpic/
+\n", -justify => 'left')->pack(-side => 'top');
    
    # Done button frame...
    my $doneFrame = $aboutWindow->Frame()->pack(-side => 'bottom', anc
+hor => 's', -fill => 'x', -expand => 1);
        my $doneButton = $doneFrame->Button(-text => 'Done', -command 
+=> sub { $aboutWindow->destroy(); }, -underline => '0')->pack(-side =
+> 'bottom', -anchor => 's');
}
Replies are listed 'Best First'.
Re: WebPic Beta
by djw (Vicar) on Jul 17, 2001 at 01:45 UTC