Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Thur Mar 16,2006 UPDATE 3 I ran into a problem with some filenames having extended ascii(unicode chars) in them. graff explained it, so I changed the glob to a readdir with a utf8 decode. Also I added a tag to the dashed lines separating the thumbnails, so they would work right with the callback.

Mon Mar 13, 2006 UPDATE 2 This can easily be extended to include jpg and gifs( as well as png ), So I made the few line changes, so you won't have to :-) Additionally switched to bsd_glob for allowing spaces in filenames

Sat Mar 11, 2006 UPDATE I found a way to copy the file path to the mouse clipboard, when you click on the main image, without the obnoxious extra "Tk phantom" newline. Handy. Also fixed bad sub name.

I saw this nice free png clipart collection at free wpclipart 170 Megs. It had some Python WxWidget Viewer, which I could not get to work, :-). So here is a general purpose Tk viewer. screenshot Just run it from the top level of your image directory.

It dosn't make any temp files, nor does it eat memory, so it might be instructive if you want to see how reusing Tk widgets, can prevent "memory leaks". 

#!/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+BPzubPzybPzydPz2fMSOBMSSBMyaBLR6B
+PzuX
PzuZPz2hPz6hPz6jPz+lPz+nPzmTPzqVPzqXPzyfKx6BPziRPzmVMyWBKx2BPzeNPziPLy
+GBMS
KBKxyBPzaJPzaLLyCBPzWFPzeLKRyBPzSDPzSFPzWHPzmRKRuBPzOBPzSBKRqBJxmBAAAA
+AAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAA
+WABY
AAAbXQIBwSCwaj8aAMkBkIodOoRIwfT6XVuTSKRAMBtktk1AwHBDfhGK9aC+OjIajcDg8I
+BHJZ
D95GxkUFRYOZhcPERF8fkUYGYEaBYRnhxISG0ccHRkeFBQWHx8gCaMKGxtubiEiIx0eGSQ
+aFQ4
OdQiUfBMbISWrJgSuFBqDdLa3bycoKSocrK4rscOTEX4sLS4cyquanJ5ydJdCLy3VKCglK
+qsjG
Y7CDgpEL9Ut8+UqKiMmrY4JRTDz//TO3csHpt+LeCxChODAgQEBAgJIfMhCsaLFi0jsBAE
+AIf5
oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5N
+ywxO
Tk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw=
+=');

my $closed_folder_bitmap = $mw->Photo(-data => 
'R0lGODlhEAAQAIMAAPwCBNSeBJxmBPz+nMzOZPz+zPzSBPz2nAQC/PzqnAAAAAAAAAAAA
+AAAA
AAAAAAAACH5BAEAAAAALAAAAAAQABAAAARTEMhJ6wwYC3uH98FmBURpElkmBUXrvsVgbOx
+wHB7
yeTPA3gdEcCC89X5AhBJ4OBZuSl3USCskkkugM3EVerVV7jXIbNIM6LQ6LRK433A4Z06n+
+yMAI
f5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk
+5Nyw
xOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AO
+w==');


$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 chi
+ldren
            $hlistd->entryconfigure( $path, -image => $closed_folder_b
+itmap );
            $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 );

}

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

[download]
I'm not really a human, but I play one on earth. flash japh

In reply to Tk-thumbnail-viewer by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2024-04-18 04:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found