Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 
#!/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');
}

[download]

In reply to WebPic Beta by djw

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2024-04-23 06:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found