hill has asked for the wisdom of the Perl Monks concerning the following question:

Gentle People,

After posting an initial question wondering about a useful image viewer, I was vectored off to look at the Perl Tk and presented with an example script that worked a treat. However, in the search for a less capable (and therefore smaller and less complex) piece of code, I cobbled together the script shown below.

(This is a good place for a disclaimer—I know next to nothing about Perl Tk and still consider myself a Perl duffer even with a couple of years of medium intensity experience.)

In any case, this code isn’t quite there. I would like it to display an image then over write it with a subsequent image. This actually displays an image and writes the next image below the previous one (not behind the current image, below it on the monitor) with each subsequent image drawn, I suppose, further down and out of sight. This is running on a Windows machine using Active State Perl.

Many thanks, folks. 

#!/usr/local/bin/perl
use Tk;
use Tk::Photo;
$mw    = new MainWindow;
$mw -> geometry ("820x780");
@files = <*gif>;
for $image (@files)
{
   $shot = $mw->Photo(-file => "$image");
   $mw->Button(-image => $shot)->pack();
   $mw->update;
   select(undef, undef, undef, .1);
}
$mw->MainLoop;

[download]

Replies are listed 'Best First'.
Re: Image in Perl TK?
by zentara (Cardinal) on Dec 19, 2008 at 19:37 UTC
    You have a couple of problems. You are creating a Photo object for each image...this is very inefficient. Second, you are packing a new button for each image, so the window grows downward. Also you don't need to declare use Tk::Photo, BUT you do need Tk::PNG or Tk::JPEG if you want them. Gif is included in Tk by default.

    Here is how to do it. Note, you can also use a widget other than a button, and use the size getting methods of Tk::Photo to readjust the size of the display widget. It's kind of buggy when you have gifs of different sizes, and the widget(button) dosn't change size. But that would be a good learning exercise for you, to come up with a widget that can resize and center each image. 

    #!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw    = new MainWindow;
$mw -> geometry ("820x780");
my @files = <*gif>;

# make one Photo object and one Button and reuse them.
my $shot = $mw->Photo(-file => "$files[0]"); #get first one
my $button = $mw->Button(-image => $shot)->pack();

for my $image (@files)
{
   $shot->blank; #clear out old image
   $shot->read($image);
   $mw->update;
   select(undef, undef, undef, .1);
}
$mw->MainLoop;

    [download]
    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
[d/l]
Re: Image in Perl TK?
by hominid (Priest) on Dec 19, 2008 at 18:58 UTC
    Were you wanting something like this? 
    
#!/usr/local/bin/perl

use strict;
use warnings;

use Tk;
use Tk::Photo;

my $mw = new MainWindow;
$mw -> geometry ("820x780");
my @files = <*gif>;



for my $image (@files)
{
   my $shot = $mw->Photo(-file => "$image");
   my $btn = $mw->Button(-image => $shot)->pack();
   $btn->update;
   
   sleep(1);
   select(undef, undef, undef, .1);
   $btn->destroy;
}

$mw->MainLoop;

    [download]
    This gives a slideshow type effect by creating, updating and destroying the button for each image.
[reply]
[d/l]
      I havn't tested your script, but destroying widgets in Tk usually leads to memory gains as the program runs. It's better to reuse widgets, rather than using a create/destroy cycle.UPDATE: Just tested it, and your program gains memory. Tk is lousy about cleanup... Gtk2 is much better in that respect.
      I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
Re: Image in Perl TK?
by dk (Chaplain) on Dec 19, 2008 at 19:45 UTC
    Chances are this is too late already, since you use Tk, but possibly you should have a second look on Prima, in particular on Prima::Image and Prima::ImageViewer. There is also a full-fledged standalone image viewer fotofix based on these.
[reply]
      Not too late or me. Image viewer example worked out of the box. Impressive!
[reply]

Back to Seekers of Perl Wisdom