Gtk2-thumbnail-previewer
zentara
created: 2006-03-16 15:53:42
Well I made a Tk version at [id://535837]. Here is the same thing using Gtk2. A screenshot . There are some notable differences. The Gtk2 version dosn't need ImageMagick to make the thumbnails, as it can use it's internal image scaling. The Gtk2 version uses it's cool animated treeview to select directories. The Gtk2 version shows how you can use a mixed Pango markup in the information label. (I made the filename a smaller font size, to accomodate the long filenames in the wpclipart collection.
#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 '-init';
use Glib qw/TRUE FALSE/; 
use Gnome2::Canvas;

#automatically put full file path to clipboards
#to paste menu
my $clipboard =  Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD);
#to mouse
my $clipboard1 =  Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_PRIMARY);

my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_border_width(5);
$window->set_default_size(600,400);

my $vbox = Gtk2::VBox->new(0,1);

#create a hbox to pack the information label
   my $hbox0 = Gtk2::VBox->new(FALSE,1);
   my $label_info = Gtk2::Label->new();
   $label_info->set_markup( &make_label('Filename','Dimensions','Size'));

 $hbox0->pack_start($label_info,FALSE,FALSE,1);	
 $vbox->pack_start($hbox0,0,0,0);

my $hbox = Gtk2::HBox->new(0,5);
#these vboxs will return the bulk of the gui
my $tbox = &ret_tree();  #the dir selector
$hbox->pack_start($tbox,0,0,0);

my ($cbox,$can) = &ret_can(); #thumbnail canvas
$hbox->pack_start($cbox,0,0,0);

my ($zbox,$can1) = &ret_can1(); #main image canvas
$hbox->pack_start($zbox,1,1,1);

$vbox->pack_start($hbox,1,1,0);

#add and show the vbox
$window->add($vbox);
$window->show_all();

#our main event-loop
Gtk2->main();
###################################################################
sub make_label{
my ($name, $dimensions, $size) = @_;
return  
" $name  ".
" $dimensions  ".
" $size  ";
}
#################################################################
sub ret_tree {
my $vbox = Gtk2::VBox->new(FALSE,5);
	#create a scrolled window that will host the treeview
	my $sw = Gtk2::ScrolledWindow->new (undef, undef);
    		$sw->set_shadow_type ('etched-out');
		$sw->set_policy ('automatic','always');
		$sw->set_placement('top-right');
		$sw->set_size_request (200, 300);
        	$sw->set_border_width(0);

       	my $tree_store = Gtk2::TreeStore->new(qw/Glib::String/);

        my $treeref = hashdir('.');
        my %tree;
        $tree{'.'} = $treeref;

	#fill it with data
	foreach my $key (sort keys %tree ) {
		#the iter is a pointer in the treestore. We
		#use to add data.
                my $iter = $tree_store->append(undef);
		$tree_store->set ($iter,0 => $key);
		
                #need recursive sub here to nest subdirs
                &recurse($tree_store, $tree{$key} , $iter );
         }

            #this will create a treeview, specify $tree_store as its model
	    my $tree_view = Gtk2::TreeView->new($tree_store);
		
	    #create a Gtk2::TreeViewColumn to add to $tree_view
	    my $tree_column = Gtk2::TreeViewColumn->new();
		
	    $tree_column->set_title('Select');
			
	   #create a renderer that will be used to display info
	   #in the model
	   my $renderer = Gtk2::CellRendererText->new;
	   #add this renderer to $tree_column. This works like a Gtk2::Hbox
	   # so you can add more than one renderer to $tree_column			
	   $tree_column->pack_start ($renderer, FALSE);
		
	   # set the cell "text" attribute to column 0   
	   #- retrieve text from that column in treestore 
	   # Thus, the "text" attribute's value will depend on the row's value
	   # of column 0 in the model($treestore),
	   # and this will be displayed by $renderer,
	   # which is a text renderer
	  $tree_column->add_attribute($renderer, text => 0);
	
	   #add $tree_column to the treeview
	  $tree_view->append_column ($tree_column);
	
	 $sw->add($tree_view);

         $tree_view->get_selection->signal_connect(
                changed =>\&cell_selected,$tree_store ); 

         #$tree_view->expand_all;
	 # expand only first level
	 $tree_view->expand_row (Gtk2::TreePath->new(0),0);
         
$vbox->pack_start($sw,1,1,0);
$vbox->show_all();
return $vbox;
}
######################################################################
sub ret_can {
 
  my $vbox = Gtk2::VBox->new(FALSE,5);
	#create a scrolled window that will host the treeview
	my $sw = Gtk2::ScrolledWindow->new (undef, undef);
    		$sw->set_shadow_type ('etched-out');
		$sw->set_policy ('automatic', 'always');
		$sw->set_placement('top-right');
		$sw->set_size_request (130, 300);
        	$sw->set_border_width(0);

        my $canvas   = Gnome2::Canvas->new_aa;
        $canvas->set_scroll_region( 0,0,10,2000);

        my $black = Gtk2::Gdk::Color->new (0x0000,0x0000,0x0000);
        $canvas->modify_bg('normal',$black);
	$canvas->set_center_scroll_region (FALSE);
  
        $sw->add($canvas);

   $vbox->pack_start($sw,TRUE,TRUE,0);
   $vbox->show_all();
return ($vbox,$canvas);
}
######################################################################
sub ret_can1{
 
  my $vbox = Gtk2::VBox->new(TRUE,5);
	#create a scrolled window that will host the thumb canvas
	my $sw = Gtk2::ScrolledWindow->new (undef, undef);
    		$sw->set_shadow_type ('etched-out');
		$sw->set_policy ('always', 'always');
		$sw->set_placement('top-right');
		$sw->set_size_request (300, 300);
        	$sw->set_border_width(0);

        my $canvas   = Gnome2::Canvas->new_aa;
        $canvas->set_scroll_region( 0,0,2000,2000);

        my $black = Gtk2::Gdk::Color->new (0x0000,0x0000,0x0000);
        $canvas->modify_bg('normal',$black);
	$canvas->set_center_scroll_region (FALSE);

    $sw->add($canvas);

$vbox->pack_start($sw,TRUE,TRUE,0);
$vbox->show_all();
return ($vbox,$canvas);
}
######################################################################
sub recurse{            
  my ( $tree_store, $hashref , $iter ) = @_;
  
     my %hash = %{$hashref};
  
     foreach my $key (sort keys %hash ){	
        
       my $iter_child = $tree_store->append($iter);                    
       if( scalar (keys %hash == 0 ) ){  
	     $tree_store->set ($iter_child,0 => $key );
	 }else{
	    $tree_store->set ($iter_child,0 => $key );
	   &recurse($tree_store, $hash{$key}, $iter_child);
	 }
   }
}
###################################################################

sub cell_selected{
       my ($tree_selection,$model ) = @_ ;

       my $sel = $tree_selection->get_selected_rows;
       my $value='';
       if( defined $sel ){
          my $path = $sel->to_string;
          my @path_ele = split /:/, $path;
        #reconstruct filesystem path from model path         
	 while( @path_ele ){
	    $path = join ':', @path_ele;
	    #print "path $path\n";
	    my $iter = $model->get_iter_from_string($path);
	    my $val = $model->get($iter,0);
	    $value = $val.'/'.$value;
	    pop @path_ele;
	   }
      }  
#print "$value\n";
add_dir_contents("./$value");

return FALSE;
}
#############################################################
sub hashdir {
    my $dir = shift || '.';
    opendir my $dh, $dir or die $!;

    my $tree = {}->{$dir} = {};

    while ( my $file = readdir($dh) ) {
        next if $file =~ m[^\.{1,2}$];

         my $path = $dir . '/' . $file;

      if(-d $path){ 
       $tree->{$file} = hashdir($path); 
      }else{ next }
    }

#$tree->{'.'} = {};

return $tree;
}
#########################################################
sub add_dir_contents {
    my $path   = $_[0];

  #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( $file =~ /.*\.(png|jpg|gif)$/ ){ push @thumbs, $file }
    }

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

}
###############################################################
sub load_thumbs{
my $thumbsref = shift; 

#clean out old thumbs 
foreach my $item ( @{$can->{'temp'}} ){ $item->destroy; }
@{$can->{'temp'}} =();

my $root = $can->root;
my $count = 0;

foreach my $file( @$thumbsref ){
        
        my $pixbuf_t = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($file,100,100,1);
	my $image = Gnome2::Canvas::Item->new ($root,
					       'Gnome2::Canvas::Pixbuf',
					       pixbuf => $pixbuf_t,
					       x      => 2.0,
					       y      => $count * 108,
					       width  => 100,
					       height => $pixbuf_t->get_height,
					       anchor => 'nw',
					       );
       
        $image->{'filepath'} = $file; #data rider to hold path

        $image->signal_connect (event => sub {
                my ($item, $event) = @_;
		if( $event->type eq 'button-press' ){
		     &display_image( $image->{'filepath'}  );
		   }
         });
         
       my $line = Gnome2::Canvas::Item->new ($root,
	       'Gnome2::Canvas::Line',
	        points => [0.0, $count * 108, 130.0, $count * 108],
            fill_color => '#ff0000',
            width_units => 6.0,
       );


   push @{$can->{'temp'}}, $image; #list to delete on refresh
   push @{$can->{'temp'}}, $line;
   $count++;
 }
#print @{$can->{'temp'}},"\n";
#display_image( ${$can->{'temp'}}[0]  );  #display first image in list
$can->set_scroll_region (0, 0, 10, $count * 108);
$can->scroll_to (0, 0); 
}
##############################################################
sub display_image{
  if( ref $can1->{'temp'} eq 'Gnome2::Canvas::Pixbuf' ){
                  $can1->{'temp'}->destroy}

  my $im = Gtk2::Gdk::Pixbuf->new_from_file( $_[0] );
  my $x = $im->get_width;
  my $y = $im->get_height;
  my $image = Gnome2::Canvas::Item->new ($can1->root,
				       'Gnome2::Canvas::Pixbuf',
                                           pixbuf => $im,
					   x      => 5.0,
					   y      => 5.0,
					   width  => $x,
					   height => $y,
					   anchor => 'nw',
					   );

 $can1->{'temp'} = $image;
 $can1->set_scroll_region (0, 0, $x + 10, $y + 10);
 $can1->scroll_to (0, 0); 

 # set to clipboard for menu or mouse paste
 $clipboard->clear;
 $clipboard1->clear;
 $clipboard->set_text($_[0]);
 $clipboard1->set_text($_[0]);

 my $filebase = substr ($_[0], rindex ($_[0], "/") + 1);
 $label_info->set_markup( &make_label( $filebase, "$x x $y" , (stat $_[0] )[7] ));
}
##################################################################


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

perlmonks.org content © perlmonks.org and zentara

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03