zimg -- Perl/Gtk2 quick slideshow
zentara
created: 2006-01-05 12:08:07
This script will display all pictures readable by Gtk2, and will optionally recurse into subdirectories. It dosn't show thumbnails, it is more of a "flip-through". Right arrow ( or space ) is forward, left arrow is back. Esc or q to quit. It contains alot of little snippets useful if you want to display images with Perl/Gtk2.

It is quite fast, and it is better than Tk, since it dosn't need to base64 encode images.

#!/usr/bin/perl
use strict;
use warnings;
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';
use File::Find;
use File::Basename;

# any commandline arg will make this recurse into subdirs 
my $recursive;
if($ARGV[0]){ $recursive = 1 }

#try to find all format extensions which Pixbuf recognizes 
my @formats = Gtk2::Gdk::Pixbuf->get_formats();

my @exts;
my @files;
#go thru Pixbuf formats and grab extensions  
foreach my $format ( @formats ) {
    foreach my $key ( keys( %$format ) ) {
           next unless $key eq 'extensions';
           foreach my $elem ( @{ $format->{ $key } } ) {
                push @exts, $elem;
            }
      }
 }
@exts = grep { $_ ne 'svg' } @exts;  #svg dosn't work for me yet 
                                     #although it is in formats 

#if recursive, use File::Find to recurse, else use a glob 
if($recursive){
    find( sub {
           my $file = $File::Find::name;
           my ($name, $path, $extension) = fileparse($file,'\..*');
           substr $extension, 0, 1, ''; #remove leading .  

            if( grep {$_ eq $extension}  @exts ){
                push @files, $file ;
           }

    }, '.' );
}else{
  @exts = map { $_ = "*.$_" } @exts;   #map to setup the glob below 
  #print "@exts\n"; #uncomment to see extensions 
  @files = <@exts>; #non recursive 
}

if(scalar @files == 0){ die "No photo files found\n" }

#print "@files\n"; 

my $mw = Gtk2::Window->new;
$mw->set_size_request( 400, 400 );

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

my $vp = Gtk2::Viewport->new( undef, undef );
my $sw = Gtk2::ScrolledWindow->new(undef, undef );
$sw->set_policy( 'automatic', 'automatic' );
$sw->add( $vp );

#set to last file, so first is next 
unshift(@files,pop (@files));
my $image = &load_image(1); #1 for forward, -1 for back 

#--------------------------- 
my $hbox= Gtk2::HBox->new( FALSE, 6 );
$hbox->set_border_width(2);

my $font = Gtk2::Pango::FontDescription->from_string("Sans Bold 14");
my $lab1 = Gtk2::Label->new('Next ->');
$lab1->modify_font($font);

$hbox->pack_end( $lab1, 1, 1, 1 );

my $lab2 = Gtk2::Label->new('<- Back');
$lab2->modify_font($font);

$hbox->pack_end( $lab2, 1, 1, 1 );

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

$mw->add($vbox);
$mw->show_all();

$mw->signal_connect( 'destroy', sub { Gtk2->main_quit } );
$mw->signal_connect('key-press-event' => \&proc_key);

Gtk2->main;

########################################################### 
sub load_image {

    my $mode = shift;

    if($mode > 0){
    push (@files,shift(@files)); #rotate files by 1 
     } else {unshift(@files,pop (@files)) } #go back 1 


# It would seem that it would be better to load the 
# image from file, but it is actually faster to  
# use the PixbufLoader shown below 
# It is really noticable when you hold down the 
# forward key 
# 
#  my $image = Gtk2::Image->new_from_file ( $files[0] ); 
#  my $pb = $image->get_pixbuf; 
#  my ( $x, $y ) = ( $pb->get_width, $pb->get_height ); 

#----faster and/or if you want to load an image from a scalar ------ 
   my $image_data;
   open( FH, "< $files[0]" );
   read( FH, $image_data, -s FH );
   close FH;

   my $loader = Gtk2::Gdk::PixbufLoader->new;
   $loader->write( $image_data );
   $loader->close;
   my $pixbuf = $loader->get_pixbuf;
   my $image = Gtk2::Image->new_from_pixbuf( $pixbuf );
   my ( $x, $y ) = ( $pixbuf->get_width, $pixbuf->get_height );
#------------------------------------------------------ 

   $vp->add( $image );

# if you want to adjust scrollbars ------------- 
#   my $hadj = $sw->get_hadjustment; 
#   my $vadj = $sw->get_vadjustment; 
#   $hadj->set_value($x/4); 
#   $vadj->set_value($y/4); 
#---------------------------------------------- 
   $mw->show_all();
   $mw->set_title( "$files[0] ${x}x${y}" );
  return $image;
}

##################################################### 
sub proc_key {
  my ($widget,$event,$parameter)= @_;
  my $key_val = $event->keyval();
#  print "$key_val\n"; 

  #right arrow or space 
  if(($key_val == 32) || ($key_val == 65363)){
            $image->clear;
            $vp->remove($image);
            $image = &load_image(1);
            return TRUE;
            }

  #left arrow 
   if($key_val == 65361){
            $image->clear;
            $vp->remove($image);
            $image = &load_image(-1);
            return TRUE;
     }

  # catch Esc or q to exit 
  if( ($key_val == 113) || ($key_val == 65307) )
      { &delete_event  }

  #good practice to let the event propagate, should we need it somewhere else 
  return FALSE;
}


##################################### 
sub delete_event {
Gtk2->main_quit;
return FALSE;
}

Re: zimg -- Perl/Gtk2 quick slideshow
created: 2006-01-06 16:30:40
Here is an improved, but more complex version. It includes an autoscan feature, adjustable time delay, and a keyboard accelerator, which toggles the autoscan checkbutton with the 'a' key. This is handy for mouse-less operation. The autoscan will turn itself off, with any key-press, so you can quickly stop the scan if you see something good. :-) Just hit 'a' to restart it, or use the mouse.
#!/usr/bin/perl
use strict;
use warnings;
use Glib qw/TRUE FALSE/;
use Gtk2 '-init';
use File::Find;
use File::Basename;

# any commandline arg will make this recurse into subdirs 
my $recursive;
if($ARGV[0]){ $recursive = 1 }

#try to find all format extensions which Pixbuf recognizes 
my @formats = Gtk2::Gdk::Pixbuf->get_formats();

my $timer;
my @exts;
my @files;
#go thru Pixbuf formats and grab extensions  
foreach my $format ( @formats ) {
    foreach my $key ( keys( %$format ) ) {
           next unless $key eq 'extensions';
           foreach my $elem ( @{ $format->{ $key } } ) {
                push @exts, $elem;
            }
      }
 }
@exts = grep { $_ ne 'svg' } @exts;  #svg dosn't work for me yet 
                                     #although it is in formats 

#if recursive, use File::Find to recurse, else use a glob 
if($recursive){
    find( sub {
           my $file = $File::Find::name;
           my ($name, $path, $extension) = fileparse($file,'\..*');
           substr $extension, 0, 1, ''; #remove leading .  

            if( grep {$_ eq $extension}  @exts ){
                push @files, $file ;
           }

    }, '.' );
}else{
  @exts = map { $_ = "*.$_" } @exts;   #map to setup the glob below 
  #print "@exts\n"; #uncomment to see extensions 
  @files = <@exts>; #non recursive 
}

if(scalar @files == 0){ die "No photo files found\n" }

#print "@files\n"; 

my $mw = Gtk2::Window->new;
$mw->set_size_request( 400, 400 );

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

my $vp = Gtk2::Viewport->new( undef, undef );
my $sw = Gtk2::ScrolledWindow->new(undef, undef );
$sw->set_policy( 'automatic', 'automatic' );
$sw->add( $vp );

#set to last file, so first is next 
unshift(@files,pop (@files));
my $image = &load_image(1); #1 for forward, -1 for back 

#--------------------------- 
my $hbox= Gtk2::HBox->new( FALSE, 6 );
$hbox->set_border_width(2);

my $font = Gtk2::Pango::FontDescription->from_string("Sans Bold 14");
my $lab1 = Gtk2::Label->new('Next ->');
$lab1->modify_font($font);

$hbox->pack_end( $lab1, 1, 1, 1 );

my $lab2 = Gtk2::Label->new('<- Back');
$lab2->modify_font($font);

$hbox->pack_end( $lab2, 1, 1, 1 );

#-------- autoscan control --------------------------------------------- 
# the leading _a will underline the a 
my $checkbutton = Gtk2::CheckButton->new('_autoscan');
$hbox->pack_start( $checkbutton, FALSE, FALSE, 0 );
$checkbutton->signal_connect( clicked => \&check_button_callback,'AutoScan' );

my $dlabel = Gtk2::Label->new('Delay :');
$dlabel->set_alignment( 0.0, 0.5 );    # left halignment, middle valignment  
$hbox->pack_start( $dlabel, FALSE, TRUE, 0 );
$dlabel->set_sensitive(0);

# 250 milliseconds increments, start at 4 ( 1 second ) up to 10 seconds 
my $adj = Gtk2::Adjustment->new( 4.0, 1.0, 40.0, 1.0, 5.0, 0.0 );
my $spinner = Gtk2::SpinButton->new( $adj, 0, 0 );
$spinner->set_wrap(TRUE);
$hbox->pack_start( $spinner, FALSE, TRUE, 0 );
$spinner->signal_connect( 'value_changed' => \&spinner_callback );
$spinner->set_sensitive(0);
#------------------------------------------------------------------- 

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

$mw->add($vbox);
$mw->show_all();

$mw->signal_connect( 'destroy', sub { Gtk2->main_quit } );
$mw->signal_connect('key-press-event' => \&proc_key);


#setup keyboard accelerator 'a' for autoscan--------- 
my @accels = (
          { key => 'a', mod => [], func => \&key_toggle },
          );

my $accel_group = Gtk2::AccelGroup->new;

use Gtk2::Gdk::Keysyms;
foreach my $a (@accels) {
  $accel_group->connect ($Gtk2::Gdk::Keysyms{$a->{key}},
                            $a->{mod},'visible',$a->{func});
        }
$mw->add_accel_group ($accel_group);
#---------------------------------------------------- 

Gtk2->main;

########################################################### 
sub load_image {

    my $mode = shift;

    if($mode > 0){
    push (@files,shift(@files)); #rotate files by 1 
     } else {unshift(@files,pop (@files)) } #go back 1 

# It would seem that it would be better to load the 
# image from file, but it is actually faster to  
# use the PixbufLoader shown below 
# It is really noticable when you hold down the 
# forward key 
# 
#  my $image = Gtk2::Image->new_from_file ( $files[0] ); 
#  my $pb = $image->get_pixbuf; 
#  my ( $x, $y ) = ( $pb->get_width, $pb->get_height ); 

#----faster and/or if you want to load an image from a scalar ------ 
   my $image_data;
   open( FH, "< $files[0]" );
   read( FH, $image_data, -s FH );
   close FH;

   my $loader = Gtk2::Gdk::PixbufLoader->new;
   $loader->write( $image_data );
   $loader->close;
   my $pixbuf = $loader->get_pixbuf;
   my $image = Gtk2::Image->new_from_pixbuf( $pixbuf );
   my ( $x, $y ) = ( $pixbuf->get_width, $pixbuf->get_height );
#------------------------------------------------------ 

   $vp->add( $image );

# if you want to adjust scrollbars ------------- 
#   my $hadj = $sw->get_hadjustment; 
#   my $vadj = $sw->get_vadjustment; 
#   $hadj->set_value($x/4); 
#   $vadj->set_value($y/4); 
#---------------------------------------------- 
   $mw->show_all();
   $mw->set_title( "$files[0] ${x}x${y}" );
  return $image;
}

##################################################### 
sub proc_key {
  my ($widget,$event,$parameter)= @_;
  my $key_val = $event->keyval();
#  print "$key_val\n"; 

  # catch Esc or q to exit 
  if( ($key_val == 113) || ($key_val == 65307) )
      { &delete_event  }

  #turn off autoscan if running on any keypress 
   if( defined $timer){
      $checkbutton->set_active(0);
      return TRUE;  #return and go on manual 
   }

  #right arrow or space 
  if(($key_val == 32) || ($key_val == 65363)){
            $image->clear;
            $vp->remove($image);
            $image = &load_image(1);
            return TRUE;
            }

  #left arrow 
   if($key_val == 65361){
            $image->clear;
            $vp->remove($image);
            $image = &load_image(-1);
            return TRUE;
     }


  #good practice to let the event propagate, should we need it somewhere else 
  return FALSE;
}
############################################ 
sub check_button_callback {
  my ($button,$number) = @_;
     if ($button->get_active) {
        # if control reaches here, the check button is down 
#        print "$number on\n"; 
        $spinner->set_sensitive(1);
        $dlabel->set_sensitive(1);

        my $delay = $spinner->get_value() * 250;

        $timer = Glib::Timeout->add( $delay ,
                sub {
                     $image->clear;
                     $vp->remove($image);
                     $image = &load_image(1);
                     return TRUE
                   }
        );
     } else {
# if control reaches here, the check button is up 
#     print "$number off\n"; 
#     warn "uninstalling timer $timer"; 
     Glib::Source->remove ($timer);
     $timer = undef;

     $checkbutton->set_active(0);
     $spinner->set_sensitive(0);
     $dlabel->set_sensitive(0);

     }
  }
##################################### 
sub spinner_callback{
  my $sb = shift;
  my $new_delay = $sb->get_value();
#  print "$new_delay\n"; 
  #restart timer thru checkbutton callbacks stop and start 
  $checkbutton->set_active(0);
  $checkbutton->set_active(1);

  return FALSE;
}
###################################### 
sub key_toggle{
   if( $checkbutton->get_active() )
      { $checkbutton->set_active(0);
      }else{ $checkbutton->set_active(1);
      }

}
####################################### 
sub delete_event {
Gtk2->main_quit;
return FALSE;
}


I'm not really a human, but I play one on earth. flash japh
Re: zimg -- Perl/Gtk2 quick slideshow
created: 2006-10-27 03:58:32
This is awesome, but it's possible to decrease the delay to a point where load_image is called more often than gtk can update the screen. This results in the title changing, but the image displayed not changing. Is there a method to call in gtk that will wait until it has finished updating the screen? I tried searching the docs on
http://gtk2-perl.sourceforge.net/doc/pod/index.html
but came up empty.
Re^2: zimg -- Perl/Gtk2 quick slideshow
created: 2006-10-27 05:31:58
Just about everything in Gtk2 is event-driven, so if you add an event-watcher to the $image, as it's being loaded, it emits an "expose event" when displayed.
sub load_image {
   ...
   .... 
   .... 
    $vp->add( $image );

# add event watcher
   $image->signal_connect(
      event => sub {
         my ( $item, $event ) = @_;
         warn "event " . $event->type . "\n";
         return 0;    #return 1 prevents window from closing

# return 0 lets the signal thru
      }
   );
  ..... 
  .....
}

Now, it would seem that you could just wait until the expose event occurs before proceeding. What the best way to do that is probably a resettable flag $is_image_exposed, and go into a non-blocking delay until it is 1.

I havn't tested that, and there may be other ways. Read "perldoc Gtk2::Widget" and look for things like "$widget->has_screen" ( and others).

The docs for Gtk2 are pretty meager, and require alot of experimentation to get the right code.

But if you ask me, just set the delay slower. :-)


I'm not really a human, but I play one on earth. Cogito ergo sum a bum

perlmonks.org content © perlmonks.org and Anonymous Monk, zentara

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

v 0.03