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 somewhe +re else return FALSE; } ##################################### sub delete_event { Gtk2->main_quit; return FALSE; }

Replies are listed 'Best First'.
Re: zimg -- Perl/Gtk2 quick slideshow
by zentara (Cardinal) on Jan 06, 2006 at 21:30 UTC
    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,'Auto +Scan' ); my $dlabel = Gtk2::Label->new('Delay :'); $dlabel->set_alignment( 0.0, 0.5 ); # left halignment, middle valig +nment $hbox->pack_start( $dlabel, FALSE, TRUE, 0 ); $dlabel->set_sensitive(0); # 250 milliseconds increments, start at 4 ( 1 second ) up to 10 second +s 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 somewhe +re 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
by Anonymous Monk on Oct 27, 2006 at 07:58 UTC
    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.
      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