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;
}
#!/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;
}
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. :-)
perlmonks.org content © perlmonks.org and Anonymous Monk, zentara
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03