Perl image viewing with Tk 1

[keble]

I'd appreciate any help with using Perl/Tk (or anything else that's suitable) to create a screen saver, which will display a list of image files, one at a time with some defined delay between.
I've tried using Tk's Label. This will display one image OK, but then when I try to display the next it all gets a bit unpredictable!
I found some references to DoOneEvent but that didn't help.

 

[Kirsle]

what code do you have so far?

-------------
Cuvou.com | The NEW Kirsle.net

 

[keble]

Here's the story so far.
Notes: $tally is just a count of files; the code just tries to show 2 images, one after the other, with a delay between them (maybe the delay is the problem?)

use Tk;
use Tk::JPEG;
my $mw = MainWindow->new();
$num=int(rand($tally))+1;
$file=@file_list[$num];
my $image = $mw->Photo(-format=>'jpeg', -file=> $file);
$mw->Label(-image=>$image)->pack(-expand => 1, -fill => both);
DoOneEvent();
sleep $delay;

$num=int(rand($tally))+1;
$file=@file_list[$num];
print $file;
$mw->destroy;
my $mw = MainWindow->new();
my $image = $mw->Photo(-format=>'jpeg', -file=> $file);
$mw->Label(-image=>$image)->pack(-expand => 1, -fill => both);
DoOneEvent();

MainLoop;

 

[Kirsle]

Yeah, the delay is definitely the problem. Try this:

use Tk;
use Tk::JPEG;
my $mw = MainWindow->new();
    $num=int(rand($tally))+1;
    $file=@file_list[$num];
    my $image = $mw->Photo(-format=>'jpeg', -file=> $file);
    $mw->Label(-image=>$image)->pack(-expand => 1, -fill => both);    
    [COLOR=blue]wait ($delay);[/color]

    $num=int(rand($tally))+1;
    $file=@file_list[$num];
    print $file;
    $mw->destroy;
    my $mw = MainWindow->new();
    my $image = $mw->Photo(-format=>'jpeg', -file=> $file);
    $mw->Label(-image=>$image)->pack(-expand => 1, -fill => both);

    MainLoop;

[COLOR=blue]sub wait {
   my $for = shift;

   my $resume = time() + $for; # time to stop waiting

   while (time() < $resume) {
      # update mainwindow
      DoOneEvent();

      # sleep a fraction of a second
      select (undef,undef,undef,0.001);
   }

   # return
   return;
}[/color]

-------------
Cuvou.com | The NEW Kirsle.net

 

[keble]

Hi, that works! Many thanks.
Not sure why but I had to change the wait($delay) to wait_something($delay) otherwise I got a syntax error. Maybe wait is a reserved word.

 

[Kirsle]

Oh yeah, wait is a reserved word. I used a similar subroutine in a Tic-Tac-Toe game I programmed to add a delay before the computer would make its most. I called it using &wait() though, which implied I wanted to use my own sub and not the Perl function. ;-)

It's a bit of a side topic here, but if you're making a screen saver, it's not efficient to destroy and remake the MainWindow all the time. You can simply just reconfigure the label:

use Tk;
use Tk::JPEG;
my $mw = MainWindow->new();
    $num=int(rand($tally))+1;
    $file=@file_list[$num];
    my $image = $mw->Photo(-format=>'jpeg', -file=> $file);
    [COLOR=blue]my $lab =[/color] $mw->Label(-image=>$image)->pack(-expand => 1, -fill => both);    
    wait_something ($delay);

    $num=int(rand($tally))+1;
    $file=@file_list[$num];
    print $file;
    my $image2 = $mw->Photo(-format=>'jpeg', -file=> $file);
    [COLOR=blue]$lab->configure (-image => $image2);[/color]

    MainLoop;

sub wait_something {
   my $for = shift;

   my $resume = time() + $for; # time to stop waiting

   while (time() < $resume) {
      # update mainwindow
      DoOneEvent();

      # sleep a fraction of a second
      select (undef,undef,undef,0.001);
   }

   # return
   return;
}

You could also use an array of Tk:hoto objects...

my @images = ();
foreach my $file (@file_list) {
   push (@images, $mw->Photo (-file => $file, -format => 'jpeg'));
}

#example
$lab->configure (-image => $images[1]);

There are a lot of ways you could optimize your code like this but I'll let you have the fun of figuring them out yourself. ;-)

-------------
Cuvou.com | The NEW Kirsle.net

 

[keble]

Thanks again - I'll try those.

I came across another useful thing for a screen saver: you can get rid of the normal window bars with this:

my $mw = MainWindow->new();
$mw->overrideredirect(1);

... but it doesn't leave the user a way to kill the window, so apparently you can use a bind to a key such as Escape - that didn't work for me yet!

 

[Kirsle]

I've made screensavers before with Perl Tk (caution: compiling a Tk program into an EXE guarantees a minimum file size of about 3 MB), I just bind <Motion> to the mainwindow (mouse movements) and KeyPresses, and other events...

$mw->bind ("<Motion>", \&close);
$mw->bind ("<ButtonPress>", \&close); # mouse clicks
$mw->bind ("<KeyPress>", \&close); # keys

sub close {
  exit(0);
}

But for testing purposes, you'd just want to bind <Escape>.

overrideredirect is a useful tool. It can also be used to skin your Tk windows, or scale them to sizes the window manager normally won't allow. Check out this use for it:

http://www.cuvou.com/?module=poc

-------------
Cuvou.com | The NEW Kirsle.net

 

[travs69]

Are you guys using activestate TK or something else?

 

[Kirsle]

Tk is cross platform. I use ActivePerl because I use Windows (and because I can't figure out how to manually install Tk for Linux ;-) )

-------------
Cuvou.com | The NEW Kirsle.net

 

[keble]

I'm using Active too - on a Mac. Likewise, installing Tk on the Mac seemed to be just too much hassle.

 

[keble]

Things are getting better, but I have a couple of niggles if anyone can help

1) I tried the Keypress addition to stop the script, as mentioned by Kirsle:

$mw->bind ("<Motion>", \&close);
$mw->bind ("<ButtonPress>", \&close); # mouse clicks
$mw->bind ('<KeyPress-Escape>', \&close);

Curiously, Motion and ButtonPress work fine, but Keypress (with or without specific keys) does not.

I tried a key "demonstrator" program (at

http://www.oreilly.com/catalog/mastperltk/chapter/ch15.html)

and that worked.

So I'm wondering what it is that stops the program from responding to KeyPress. A few experiments failed to shed light on the matter!

2) This one is rather more important, but I have solved it. The timer in my loop:

sub wait_time {
my $t=time();
my $for = shift;
my $resume = time() + $for; # time to stop waiting
while (time() < $resume) {
DoOneEvent(); # update mainwindow
select (undef,undef,undef,0.001); # sleep a fraction of a second
}
return;
}

.. doesn't actually run unless the mouse cursor is in motion!

I found that removing the DoOneEvent(); line fixed that.

Not sure why - maybe it's time to buy the book!

 

[Kirsle]

Try replacing DoOneEvent with $mw->update;

KeyPress should work... I've used it in a test screensaver I wrote:

#!/usr/bin/perl -w

# Notes:
# Values inside @ARGV:
#   /p;593118  - The preview window for Display Properties tries showing the saver
#   /c:3411052 - The "Settings" button was clicked
#   /s         - The "Preview" button was clicked OR the saver started on its own

use Tk;
use Tk::CursorControl;

# Load from config
my $txt = 'Screen Saver';
if (-e "C:/perlss.txt") {
	open (TEXT, "C:/perlss.txt");
	$txt = <TEXT>;
	close (TEXT);
}

if (@ARGV && $ARGV[0] =~ /^\/c/i) {
	my $main = MainWindow->new (
		-title => 'Configure',
	);
	$main->Label (-text => 'Text:')->pack;

	$main->Entry (
		-textvariable => \$txt,
	)->pack;

	my $blab = $main->Frame ()->pack (-side => 'bottom', -fill => 'x');

	$blab->Button (
		-text => 'Ok',
		-command => sub {
			open (WRITE, ">C:/perlss.txt");
			print WRITE $txt;
			close (WRITE);
			exit(0);
		},
	)->pack (-side => 'left');

	$blab->Button (
		-text => 'Cancel',
		-command => sub {
			exit(0);
		},
	)->pack (-side => 'left');

	$main->bind ('<Destroy>', sub {
		exit(0);
	});

	MainLoop;
}
elsif (@ARGV && $ARGV[0] =~ /^\/p/i) {
	exit(0);
}

my $main = MainWindow->new (-background => 'black');
$main->overrideredirect(1);
$main->geometry (join('x', $main->screenwidth, $main->screenheight));
$main->MoveToplevelWindow(0,0);
$main->focusForce;

my $env = $main->Label (
	-text => 'env vars',
	-background => 'black',
	-foreground => '#CCCCCC',
	-font => [
		-family => 'Courier New',
		-size   => 8,
	],
	-justify => 'left',
)->place (-x => 0, -y => 0, -anchor => 'nw');

my @envs = ();
foreach (keys %ENV) {
	push (@envs, "$_ = $ENV{$_}");
}
push (@envs, "\@ARGV = " . join(";",@ARGV));
$env->configure (-text => join ("\n",@envs));

my $cursor = $main->CursorControl;
$cursor->hide ($main);

$main->bind ('<Motion>', sub {
	exit(0);
});
$main->bind ('<KeyPress>', sub {
	exit(0);
});
$main->bind ('<Button>', sub {
	exit(0);
});

my $lab = $main->Label (
	-text => $txt,
	-background => 'black',
	-foreground => 'yellow',
	-font => [
		-family => 'Arial',
		-size   => 36,
		-weight => 'bold',
	],
)->place (-x => 0, -y => 0);

my $now = time();
while (1) {
	$main->update;
	select (undef,undef,undef,0.1);

	if (time() - $now >= 2) {
		my $color = (qw(limegreen cyan yellow white orange skyblue pink))[ int(rand(7)) ];
		$lab->configure (-foreground => $color);
		my $x = int(rand($main->screenwidth - $lab->width));
		my $y = int(rand($main->screenheight - $lab->height));
		$lab->place (-x => $x, -y => $y);
		$now = time();
	}
}

-------------
Cuvou.com | The NEW Kirsle.net