#!/usr/bin/perl -w
use Tk;
use Cwd;
use Image::Magick;
use strict;

# Copyright License -- GPL v2.  If you change this, please send me a copy at clab@swva.net, and make your changes
# public.  We're supposed to be helping each other.  Not tested on windows, but should work if you can find a
#Tk library for windows (or build it again from source on CPAN) -- activestate doesn't have it anymore.


# requires perl modules Tk, PerlMagick (or, Image::Magick, and application ImageMagick  
#(Cwd is a standard one for most perls)

# This is a program to work as a nautilus-script to perform some processing on all .jpg's in
# the input arguments.  The idea is to make it simple to shrink and compress a bunch of huge
# megapixel photos from a camera in an f-spot directory into something you can email or post
# on the web without it being too doggone huge for that.  Tk is used for the GUI, as it (should) be
# pretty simple.

# images are modified IN PLACE and THE ORIGINALS ARE WIPED.  Saves a step for most users.
# contact me if you need something fancier, or do the code and send me a copy

# When run from the command line, any set of names and directories can be used as arguments, and
# if there are some errors (that I check for), you'll get them on stdout.  Else they go in the bit bucket.

# amazingly on the latest kernel for ubuntu 10.04 LTS, all available cpu cores are used in parallel.
# So this can be nicely quick.


# these need to be visible to the whole program
my $mw;
my $flbltxt; 	 # list of full file paths to process, for display to user so they can decide not to, if...
my $cwd; 		 # where are we looking - and maybe where the results go (root if there are subdirs)
my @infilepaths; # list of files to process, global


# I didn't get fancy enough to have a config file, here's the defaults for you to change as desired
# I also don't check if you put legal numbers in here - be careful.  They have to match the options
# in the radio buttons (search for Radiobutton below)

my $resize = 1;		 # boolean for do resize
my $autolevel = 1;	 # ditto for auto level
my $newwidth = 640;	 # new X size (scale maintained)
my $changequality = 1; # bool for do compresson change
my $newquality = 60; # new compression quality if desired

#################### subroutines

#////////////////////////////////////////////////////////////////
sub dofiles
{ # actually run all the files through the processing selected in the GUI
my $ipath;
my $image = Image::Magick->new;
my $x; # error variable
my $geo;

foreach $ipath (@infilepaths)
{
  $x = $image->Read($ipath); # get current image into ram
  warn "$x" if "$x";
 
# $x = $image->get('quality'); # evidently same scale as gimp uses, 1-99
# print ("\nQuality of $ipath:$x");

 if ($resize)
 {
 $geo = "$newwidth" .'x'."$newwidth"; # I'm sure I missed a slick trick to get this line free, impatient
  $x = $image->Resize(geometry => $geo, filter => 'Cubic');
  warn "$x" if "$x";
 }

 if ($autolevel)
 { # adjust total brightness/contrast to fill the available space
  $x = $image->AutoLevel();
  warn "$x" if "$x";
 }
 
 if ($changequality) # changes the compression level for jpegs
 { # nothing beats cutting down the total pixels, but this helps a lot too
  $x = $image->Set(quality => $newquality);
  warn "$x" if "$x";
 }

# could add more transforms here (along with GUI elsewhere)

  $x = $image->Write($ipath); # overwrite the original image with the new
  warn "$x" if "$x";
# update display here...so we know it's working and user is comfortable
$flbltxt =~ s/$ipath//; # remove the one we just finished
$mw->update(); # and draw the new text on screen so user can see we're working
  
 @$image = (); # clear out object for reuse, don't fill up memory
} # end for each image

undef $image; #done with this, be clean (same as C++ delete)
exit 0;  # we're done entirely at this point, so go away
}
#////////////////////////////////////////////////////////////////


# find files to process according to my particular rule-set.  In this case, jpegs only,
# and we can handle a mixed list of directories and files as input from Nautilus or command line
# we'll go down into a directory, but not recurse past that -- else user might get in big trouble

sub findfiles
{
 my $name;
 my $dcwd; # for single level descent into a directory, no recursion here
 @infilepaths = (); # in case someday we go more than once on this routine
 $cwd = getcwd; # base dir for other filenames

# check first arg(s), if  dir, expand that dir.  If a file(s), get all args to a filepath list
# not perfect probably, but gotta have some plan at all

foreach $name (@ARGV) # could be just a filename, or a whole directory (we won't recurse below that)
 {
  next if $name =~ /\.\.?$/; # skip . and .. if they are present
  
  if (-f "$cwd/$name") # simple case, just a file name
  {
   push (@infilepaths, "$cwd/$name") if $name =~ m/\.jpg|\.jpeg/i; # add it to the list
  }
  elsif (-d "$cwd/$name") # it's a directory, so go fishing down inside it instead
  {
   $dcwd = "$cwd/$name"; # new directory to look for files in
   opendir(DIR, $dcwd) or die "can't open $dcwd: $!";
   
   while (defined($name = readdir(DIR)))
   { # test file and add if it's a good one
    next if $name =~ /\.\.?$/; # skip . and .. if they are present
   # now check each for being a file and a jpg both (could have done a one-liner here and above)
   if (-f "$dcwd/$name")
   {
    push (@infilepaths,"$dcwd/$name") if $name =~ m/\.jpg|\.jpeg/i;
   }
   
   } # end each file in subdir
   closedir(DIR);  # clean up after self
  
  } # end if directory
 
 
 } # for argv input
 $flbltxt .= join ("\n",@infilepaths);  # show user what we're about to work on
} # end findfiles


####################### main #############################


my $btframe; # frame for buttons on bottom
my $qbutton;
my $gobutton;

my $tframe;
my $t2frame;
my $t3frame;
my $mframe;
my $label;
my $flabel;


$mw = MainWindow->new;
$mw->title("Batch Photo Shrinker"); # save them bytes
# make some frame windows to organize where things go in the GUI
$btframe = $mw->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'bottom',-fill => 'x');
$tframe = $mw->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'top',-fill => 'x');
$t2frame = $mw->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'top',-fill => 'x');
$t3frame = $mw->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'top',-fill => 'x');
$mframe = $mw->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'top',-fill => 'x');

# bottom frame stuff
$gobutton = $btframe->Button(-text => "Do them all", -command => sub { \dofiles })
	->pack(-expand => 1, -side => 'left', -fill => 'x');

$qbutton = $btframe->Button(-text => "Exit", -command => sub { exit 0 }, -cursor => 'pirate')
	->pack(-expand => 1, -side => 'right', -fill => 'x');

#top frame stuff
# controls for image processing parameters
my $rs = $tframe->Checkbutton(-text => "Resize?", -variable => \$resize)->pack(-side => 'left');

foreach (qw(160 320 640 1024 1280))
{
  $tframe->Radiobutton(-text => $_,-value => $_,-variable => \$newwidth)->pack(-side => 'left', -expand => 1, 
  						-fill =>'both');
}
# t2 frame for next batch o' controls
my $cq = $t2frame->Checkbutton(-text => "Change compression quality?", -variable => \$changequality)->
								pack(-side => 'left');
foreach (qw(40 50 60 70 80))
{
  $t2frame->Radiobutton(-text => $_,-value => $_,-variable => \$newquality)->pack(-side => 'left');
}


# bottom of control frames
my $al = $t3frame->Checkbutton(-text => "AutoLevel?", -variable => \$autolevel, -anchor => 'w')->
								pack(-side => 'left');


# bottom-middle frame stuff
$label =  $mframe->Label(-text =>"**************** Files found: ****************")->pack(-side => 'top');
$flabel = $mframe->Label(-textvariable => \$flbltxt)->pack(-side => 'bottom');


# some debug stuff to see what Nautilus was handing this script as arguments with various things selected
# had to do it this way as we don't have stdout then.
#$flbltxt = join ("\n",@ARGV);
#$flbltxt .= "\n........\n";
#$flbltxt .=  getcwd;
#$flbltxt .= "\nend\n";

findfiles(); # find all the jpegs in current arguments, show list to user before they hit go
MainLoop; # draw the windows and process events

# fall out when user hits exit, or finished via exit in dofiles()
exit 0;