#!/usr/bin/perl
use warnings;
use strict;
use MIME::Base64;
use Image::Resize;
use Tk;
use Tk::JPEG;
use Image::EXIF;



die "usage: $0 250x169xmin 768x250xmed\n
\tEg Width x High x Descr.
Third element can be omitted (the description) and
Width x High string will be used.\n\n" unless  (defined $ARGV[0] and $
+ARGV[0] =~ /\d+x\d+/);

my @files = glob('*.jpg');
   print "\nFound ".scalar @files." files\n\n";
exit if  scalar @files == 0;
my @size_descr = map { [split 'x', $_] }@ARGV;
my $x = 640; my $y = 480;
my $mx = $x; my $my = $y + 200;

my $mw    = new MainWindow ();
$mw -> geometry ($mx.'x'.$my);
$mw->optionAdd('*font', 'Courier 12');


my $c  = $mw->Canvas;
$c->pack(-expand => 1, -fill => 'both');
my $cur_file = shift @files;
    print "Considering $cur_file\n";
my $exif = &get_exif($cur_file);

my $gd = &phres($cur_file,$x,$y);
my $image = $c->Photo( -data=>  MIME::Base64::encode( $gd ));
$c->createImage($x/2 , $y/2, -image => $image);
my $label_exif_txt = "Exif info\n".
                     "size: ".($$exif{width} ? $$exif{width} : 'undef'
+ ).
                     " x ".( $$exif{height} ? $$exif{height} :'undef' 
+)."\n".
                     "date: ". ($$exif{date} ? $$exif{date} : 'undef')
+;
my $label_exif =$mw->Label( -justify  => 'left', -background => 'black
+',-foreground => 'chartreuse1',
                            -textvariable => \$label_exif_txt )->pack;
my $label =$mw->Label(-text=> 'Insert a new name for the photo above.'
+."\n".
                      'The name will be added with the infix specified
+ in command line'."\n".
                      'Then hit <Return> or the button below.')->pack(
+) ;
my $button_skip = $mw->Button(-borderwidth => 2,-relief => 'solid',-te
+xt => 'Skip this image', -command => \&next_pic)->pack;
my $newname;
my $entry = $mw->Entry( -width => 100,-borderwidth => 4, -textvariable
+ => \$newname)->pack;
   $entry->bind('<Return>' => \&elaborate);
   $entry->focus;
my $button = $mw->Button(-borderwidth => 2,-relief => 'solid',-text =>
+ 'Create resized and renamed images', -command => \&elaborate)->pack;




$mw->MainLoop;
######################################################################
+##########
sub next_pic {
    $cur_file = shift @files;
    unless ($cur_file){
        print "\nThe End\n";
        $c->destroy;
        $label->destroy;
        $label_exif->destroy;
        $button_skip->destroy;
        $entry->destroy;
        $button->destroy;
        $mw->Label(-text=>"The End\nwill happen in 3 seconds..")->pack
+() ;
        $mw->update;
        sleep 3;
        exit 0;
    }
    print "Considering $cur_file\n";
    $gd = &phres($cur_file,$x,$y);
    my $enc =  MIME::Base64::encode($gd);

    $image->blank;
    $image= $c->Photo( -data=>$enc);
    $c->createImage($x/2 , $y/2,-image => $image );
      $exif = &get_exif($cur_file);
      $label_exif_txt = "Exif info\n".
                            "size: ".($$exif{width} ? $$exif{width} : 
+'undef' ).
                            " x ".( $$exif{height} ? $$exif{height} :'
+undef' )."\n".
                            "date: ". ($$exif{date} ? $$exif{date} : '
+undef');
    $entry->delete(0, 'end');
    $mw->update;
    select(undef, undef, undef, .1);
}
######################################################################
+##########
sub elaborate{
    $newname = $entry->get();
    #########################################
    foreach my $res ( @size_descr ) {
            my $gd = &phres($cur_file,$$res[0], $$res[1]);
            &write_resized ($newname."_".(defined $$res[2] ? $$res[2] 
+: "$$res[0]x$$res[1]" )."_".'.jpg',$gd);
    }
    #########################################
    &next_pic;
}
######################################################################
+##########
sub phres {
    my ($file, $x, $y) = @_;
    my    $image_orig = Image::Resize->new($file, $x, $y);
    my    $gd = $image_orig->resize($x, $y);
    return $gd->jpeg();
}
######################################################################
+##########
sub write_resized{
    my ($name, $data) = @_;
    open(FH, '>', $name) or warn "Cannot write to $name! ";
    binmode FH;
    print FH $data;
    close(FH);
    print "\tOK: wrote $name\n";
}
######################################################################
+##########
sub get_exif {
    my $file = shift;
    my $exif = Image::EXIF->new($file);
    my %exif_img = %{$exif->get_image_info()|| {} };
    my %exif = (
          width => $exif_img{'Image Width'},
          height=> $exif_img{'Image Height'},
          date  => $exif_img{'Image Created'},
    );
    return \%exif;
}
__END__
[download]