#!/usr/bin/perl 
use warnings;
use strict;
use Tk;
use Tk::Pane;
use Tk::PNG;
use Tk::JPEG;
use Tk::HList;
use File::Spec;
use File::Basename;
use MIME::Base64;
use Image::Magick;

# Fri, Mar 10, 2006  by zentara@zentara.net
# This is GPL'd code, do what you want with it. I hope
# you find it useful.
# General purpose thumbnail viewer. Run in the top directory
# of the images. It will show directories, and make dynamic
# thumbs for each directory clicked on. It does not store
# any images, so it is useful for viewing large collections. 

# tested and does not "leak" memory
# setup to view images in the free PNG image collection
# available at http://www.wpclipart.com

my $im = Image::Magick->new; # a single object for thumbnails

my $photo;  #my $photo label;
my %thumbs; #global for reusing Photo objects which hold thumbs
my %info;   #reusable hash to hold photo file info 
my $info = 'File Information';

my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x600');

my $textbox = $mw->Text(); # a utility text box used solely for
                           # copying to the system clipboard
			   # never shown(packed)
$mw->fontCreate('big',
   -family=>'arial',
   -weight=>'bold',
  -size=>int(-18*18/14));

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

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


$topframe->Label( -textvariable => \$info,
                  -background => 'black',
                  -foreground =>'yellow',
		  -font =>'big',                  
                  -padx=>40,
		  -relief=>'raised',
		  )->pack(-fill =>'both',-expand =>1);


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

my $midframe = $mw->Frame( -width =>150, 
                            -background=>'black',
			    )->pack(-side => "left", -anchor => "n",
			             -fill=>'y', 
				     -expand=>0,
				     );

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

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

# an HList dir selector in left frame
my $hlistd = $leftframe->Scrolled(
    'HList',
    drawbranch => 1,                   # yes, draw branches
    separator  => '/',                 # filename separator
    indent     => 15,                  # pixels
    background       => 'White',
    selectmode       => 'single',
    selectbackground => 'lightyellow',
    selectforeground => 'red',
    command    => \&show_or_hide_dir
);
$hlistd->pack( -fill => 'both', -expand => 1 );

my $open_folder_bitmap = $mw->Photo(-data => 
'R0lGODlhFgAWAIUAAAT+BGRmnLSCBLyKBLR+BPzubPzybPzydPz2fMSOBMSSBMyaBLR6BPzuX
PzuZPz2hPz6hPz6jPz+lPz+nPzmTPzqVPzqXPzyfKx6BPziRPzmVMyWBKx2BPzeNPziPLyGBMS
KBKxyBPzaJPzaLLyCBPzWFPzeLKRyBPzSDPzSFPzWHPzmRKRuBPzOBPzSBKRqBJxmBAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABY
AAAbXQIBwSCwaj8aAMkBkIodOoRIwfT6XVuTSKRAMBtktk1AwHBDfhGK9aC+OjIajcDg8IBHJZ
D95GxkUFRYOZhcPERF8fkUYGYEaBYRnhxISG0ccHRkeFBQWHx8gCaMKGxtubiEiIx0eGSQaFQ4
OdQiUfBMbISWrJgSuFBqDdLa3bycoKSocrK4rscOTEX4sLS4cyquanJ5ydJdCLy3VKCglKqsjG
Y7CDgpEL9Ut8+UqKiMmrY4JRTDz//TO3csHpt+LeCxChODAgQEBAgJIfMhCsaLFi0jsBAEAIf5
oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxO
Tk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==');

my $closed_folder_bitmap = $mw->Photo(-data => 
'R0lGODlhEAAQAIMAAPwCBNSeBJxmBPz+nMzOZPz+zPzSBPz2nAQC/PzqnAAAAAAAAAAAAAAAA
AAAAAAAACH5BAEAAAAALAAAAAAQABAAAARTEMhJ6wwYC3uH98FmBURpElkmBUXrvsVgbOxwHB7
yeTPA3gdEcCC89X5AhBJ4OBZuSl3USCskkkugM3EVerVV7jXIbNIM6LQ6LRK433A4Z06n+yMAI
f5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5Nyw
xOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==');


$hlistd->Subwidget("yscrollbar")->configure(
               -background => 'lightgreen', 
               -activebackground => 'seagreen',
	       -troughcolor => 'lightyellow',
	       );

# canvas for midframe to hold thumbnails
my $ct = $midframe->Scrolled('Canvas',
                           -width => 110,
                           -background => 'black',
			   -scrollbars => 'w',
			  )->pack(-side => "left", -anchor => "n",
			           -fill => 'y', 
				   -expand => 1
				   );

$ct->Subwidget("yscrollbar")->configure(
               -background => 'lightsteelblue', 
	       -activebackground => 'steelblue',
               -troughcolor => 'mistyrose',
	       );

#fill mainframe with default screen 
setup_pane();

$mw->waitVisibility;

# Start with the current directory
show_or_hide_dir(".");

MainLoop;
#########################################################################
sub setup_pane{

my $pane = $mainframe->Scrolled('Pane', Name => 'Main Display',
               -width => 600,
	       -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,
		      );

# el cheapo clipboard, since clipboard dosn't work well on Tk 
$photo->bind("<ButtonPress>", sub { 
             my (@parts) = split /\s+/ ,$info;    
             my $abs_path = File::Spec->rel2abs( $parts[0] );
	     $textbox->clipboardClear;
	    
	     $textbox->delete('1.0','end');
	     $textbox->insert('end', $abs_path);
	     $textbox->selectAll;	     
             #this line must come after the selectAll	
	     $textbox->delete('end - 1 chars','end');
	     $textbox->clipboardColumnCopy;
	     print chr(07); #beep
	     });
}
############################################################## 
sub browseThis {

  my @tags = $ct->gettags( $ct->find(qw|withtag current|) );
   @tags = grep { $_ ne 'temp' } @tags;
   @tags = grep { $_ ne 'current' } @tags;

   my $pic = $info{ $tags[0]  }{'pic'} || '';

   $image->blank;
   $image->read($pic);
  
   $photo->configure(-image => $image );
  
   #update label
   $info = $info{ $tags[0] }{'info'};
}

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

sub load_thumbs{

#clean up last display -------------------------

$ct->delete( $ct->find(qw|withtag temp|) );     

foreach my $key(keys %thumbs){
        $thumbs{$key}->blank;  #reuse thumbnail objects
     }

foreach( keys %info ){ 
        $info{$_}{'pic'} = '';
	$info{$_}{'info'} = '';
	$info{$_}{'thumbnail'} = '';
        delete $info{$_}{'pic'};
	delete $info{$_}{'info'};
	delete $info{$_}{'thumbnail'};
        delete $info{$_};
	} 
%info = ();

#-----------------------------------------------

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

my $picref = shift;
my @pics = @$picref;
my @slots = sort {$a<=>$b} keys %thumbs; 

my $slot_prev = -1;
my $scrollreg = (scalar @pics) * 130;

$ct->configure(-scrollregion =>[0,0,100,$scrollreg]);

foreach my $pic (@pics){    
          my ($basename,$path,$suffix) = fileparse($pic,@exts);
            	    
           $info{$basename}{'pic'} = $pic; #full path to image 
	   
	   #get image info
	   my ($width, $height, $size, $format) = $im->Ping($pic);
           $info{$basename}{'info'} = "$pic $width x $height  $size";
    	  
	   # Create smaller version
           $im->Read($pic);
           $im->Scale( geometry => '100x100' );
    	   $info{$basename}{'thumbnail'} = $im->ImageToBlob();

           undef @$im; # blank $im object 
           
	   #reuse slots for thumbnails to avoid memory gain
           my $slot = shift(@slots);
	   $slot ||= -1;
	   if($slot == -1){ $slot = $slot_prev + 1 }
 	   	   
           &add_key( $basename, $slot ); 
           
           $slot_prev = $slot;	       
           $mw->update; 
  }

undef @$im;

$ct->bind("temp","<Button-1>", sub { &browseThis  });

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

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

#print "$key $slot\n";

	#Tk needs data images base64 encoded
        my $content = encode_base64( $info{$key}{'thumbnail'} );
        
	if(ref $thumbs{$slot} eq 'Tk::Photo'){       
              $thumbs{$slot}->put($content)
	   }else{
	      $thumbs{$slot} = $mw->Photo(-data => $content  );
             }

    my $y = $slot * 130;	     

    $ct->createText( 50,$y + 10,  
           -tags => ['temp', $key],
	   -fill => 'yellow',
	   -text => $key,
#	   -font => 'medium',
	  );	     
    
    $ct->createImage( 0, $y +20 , 
           -image =>$thumbs{$slot} , 
	   -tags => ['temp', $key],
	   -anchor => 'nw' 
	   );	     
    
    
    $ct->createLine( 0,$y,130,$y,  
            -tags => ['temp', $key],
	   -fill => 'white',
	   -width => 5,
	   -dash => [6,4],
	  );	     

}
#############################################################

sub show_or_hide_dir {    # Called when an entry is double-clicked
    my $path = $_[0];
    return if ( !-d $path );    # Not a directory.
    if ( $hlistd->info( 'exists', $path ) ) {

        # Toggle the directory state.
        # We know that a directory is open if the next entry is a
        # a substring of the current path
    my $next_entry = $hlistd->info( 'next', $path );
        if ( !$next_entry || ( index( $next_entry, "$path/" ) == -1 ) ) {

    # Nope. open it
    $hlistd->entryconfigure( $path, -image => $open_folder_bitmap );
            add_dir_contents($path);
        }
        else {

            # Yes. Close it by changing the icon, and deleting its children
            $hlistd->entryconfigure( $path, -image => $closed_folder_bitmap );
            $hlistd->delete( 'offsprings', $path );
        }
    }
    else {
        die "'$path' is not a directory\n" if ( !-d $path );
        $hlistd->add(
            $path,
            -itemtype => 'imagetext',
            -image    => $open_folder_bitmap,
            -text     => $path
        );
        add_dir_contents($path);
    }
}
##########################################################################
sub add_dir_contents {
    my $path      = $_[0];
    my $oldcursor = $mw->cget('cursor');    # Remember current cursor, and
    $mw->configure( -cursor => 'watch' );   # change cursor to watch
    $mw->update();
 
   #my @files = glob "$path/*";
   # use File::Glob ':glob';
   # my @files = bsd_glob( "$path/*"); # forspaces in names 

   #this decode utf8 routine is used so filenames with extended 
   # ascii characters (unicode) in filenames, will work properly 
   use Encode;
   opendir my $dh, $path or warn "Error: $!";
   my @files = grep !/^\.\.?$/, readdir $dh;
   closedir $dh;
   @files = map { decode( 'utf8', "$path/".$_  ) } sort @files;

    my @thumbs=();
    
    foreach my $file (@files) {
        $file =~ s|//|/|g;
       (my $text = $file ) =~ s|^.*/||g;
        if ( -d $file ) {
            $hlistd->add(
                $file,
                -itemtype => 'imagetext',
                -image    => $closed_folder_bitmap,
                -text     => $text
            );
        }
        else {
          if( $file =~ /.*\.(png|jpg|gif)$/ ){ push @thumbs, $file }
             }
    }
    $mw->configure( -cursor => $oldcursor );

#print "@thumbs\n";
load_thumbs( \@thumbs );

}

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