#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Pane;
use Tk::JPEG;
use Tk::HList;
use Tk::ItemStyle;
use Imager;
use File::Basename;
use MIME::Base64;

my $photo;#my $photo; 
my $image;
my $h; #my HList; 
my %info;
my $key_sel;

my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x700+100+15');

$mw->bind('<Control-c>', [sub{&save_it(); Tk::exit;}] );

my $topframe = $mw->Frame(-height =>30, -background=>'black')
                            ->pack(-fill=>'both', -expand=>1);

$topframe->Button(-text => "Exit",
                   -activebackground =>'snow',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub { exit; })->pack();

my $leftframe = $mw->Frame( -width =>25,
                            -background=>'black',
                            )->pack(-side => "left", -anchor => "n",
                                     -fill=>'both', -expand=>1);

my $mainframe = $mw->Frame(-background=>'black')
                            ->pack(-side => "right", -anchor => "n",
                              -fill=>'both', -expand=>1);

#default empty image 
$image = $mw->Photo(-file => '' ) or die $!;

#fill leftframe with thumbnails 
HList2();

#fill mainframe with default screen  
setup_pane();

$mw->waitVisibility;

load_thumbs();

MainLoop;

######################################################################
+### 
sub HList2 {

 $h = $leftframe->Scrolled( 'HList',
                               -header => 1,
                               -columns => 2,
                               -width => 20,
                               -height => 60,
                               -takefocus => 1,
                               -background => 'steelblue',
                               -foreground =>'snow',
                               -selectmode => 'single',
                               -selectforeground => 'pink',
                               -selectbackground => 'black',
                               -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '   THUMBNAIL  ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
                        -relief => 'raised');


$h->header('create', 1, -text => '      ID      ',
                        -borderwidth => 3,
                        -headerbackground => 'lightsteelblue',

                        -relief => 'raised');


my $font = '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*';

}

############################################################# 
sub setup_pane{

my $pane = $mainframe->Scrolled('Pane', Name => 'Main Display',
               -width => 1000,
               -height =>1000,
               -background => 'black',
               -scrollbars => 'osoe',
               -sticky => 'n',
              )->pack(-side => "left", -anchor => "n",
                      -fill=>'both',-expand=>1);


$photo = $pane->Label(-image => $image,
                      -background =>'black'
                     )->pack(-side => 'top',
                       -anchor => 'n',
                       -fill => 'both',
                       -expand => 1,
                      );

}

##############################################################  
sub browseThis {
   my $ent = shift;
   $key_sel = $h->itemCget($ent, 1, '-text');

   my $pic = $info{$key_sel}{'pic'} || '';
   my $image = $mw->Photo(-file => "$pic");

   $photo->configure(-image => $image );

   $image->blank;
   $image->read($pic);

}

############################################################ 

sub load_thumbs{

my @exts = qw(.jpg .png .gif); # list allowed extensions  
my @pics = <*.jpg *.gif *.png>;

my $image = Imager->new();

foreach my $pic (@pics){
            my ($basename,$path,$suffix) = fileparse($pic,@exts);

            $info{$basename}{'name'} = $basename;
            $info{$basename}{'pic'} = $basename.$suffix;
            $info{$basename}{'comment'} = 'nice';
            $image->open(file=>$pic) or die $image->errstr();

# Create smaller version 
         my $thumb = $image->scale(xpixels=>100);
         $thumb->write( data  => \$info{$basename}{'thumbnail'},
                        type  => 'jpeg',
                        jpegquality => 30) or die $thumb->errstr;

        &add_key( $basename );
        $mw->update;
  }

}
################################################################### 
sub add_key{

my($key,$color) = @_;

#color is for the IDcolor, defaults to lightsteelblue 
if(! defined $info{$key}{'color'}){ $info{$key}{'color'} = 'lightsteel
+blue'};

my $textstyle  = $h->ItemStyle('text', -justify => 'center',
                                    -bg => $info{$key}{'color'},
                                    -selectforeground => 'green',
                                    );

my $e = $h->addchild("", -data => $info{$key}{'pic'});

        #Tk needs data images base64 encoded 
        my $content = encode_base64( $info{$key}{'thumbnail'} );
        my $image = $mw->Photo(-data => $content  );

        $h->itemCreate ($e, 0,
           -itemtype => 'imagetext',
           -image => $image,
           -text => $info{$key}{'comment'},
           );

         $h->itemCreate($e, 1,
           -itemtype => 'text',
           -style => $textstyle,
           -text => $info{$key}{'name'},
           );

if($e == 0){
    #select first entry 
    $h->selectionSet(0);
    browseThis(0);
  }

}
#############################################################
[download]