Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Welcome to the Monastery
 
PerlMonks  

Comment on

( #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'); }

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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (12)
    As of 2014-04-18 09:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (464 votes), past polls