PERL Beginners - PerlTK and updating a canvas

Author

PerlTK and updating a canvas

2004-04-27, 10:35 pm

Hi,

I'm using ActivePerl w/ the Tk module on a Win2kPro system.
I'm stumped in how to get the canvas updating at a
reasonable speed. Right now, I use <canvasvar>->update(),
but it takes a big chunk of the CPU cycles.

Is there another way to update the canvas? Right now,
I have a perlTk script which should open a canvas
and display a changing text, depending on what is being
typed:

#!/usr/bin/perl

my $mwin = MainWindow->new;

my $cv = $mwin->Canvas(-width => 500, -height => 500);
$cv->createText(200,200,-text => "test", -tags => ['txt']);

while (<STDIN> ){
my ($w) = $cv->find('withtag','txt');

if($w){
$cv->itemconfigure($w,-text => $_);
$cv->update();
}
}

MainLoop();

The input is coming from the command prompt
window.

Another problem relates to the fact that the
window that's created isn't even 500x500.

However, when I move the MainLoop(); before
the while loop, the canvas is in the proper
dimensions and that the word "test" is displayed.
But anything after MainLoop() is ignored,
which is to be expected.

Can someone point out how I might be able to
fix this?

Thanks

Zentara

2004-04-28, 10:39 am

On Wed, 28 Apr 2004 09:28:13 +0800, cc@belfordhk.com (Cc) wrote:

>I'm using ActivePerl w/ the Tk module on a Win2kPro system.
>I'm stumped in how to get the canvas updating at a
>reasonable speed. Right now, I use <canvasvar>->update(),
>but it takes a big chunk of the CPU cycles.
>
>Is there another way to update the canvas? Right now,
>I have a perlTk script which should open a canvas
>and display a changing text, depending on what is being
>typed:

I'm using linux, but you have a couple of "showstopper" bugs
in your script. One, you didn't pack the Canvas, so it won't
be displayed. Two, you are trying to read STDIN, as if it were
providing non-blocking i/o.
>
>#!/usr/bin/perl
>
>my $mwin = MainWindow->new;
>
>my $cv = $mwin->Canvas(-width => 500, -height => 500);
my $cv = $mwin->Canvas(-width => 500, -height => 500)->pack;

>$cv->createText(200,200,-text => "test", -tags => ['txt']);

>while (<STDIN> ){
> my ($w) = $cv->find('withtag','txt');
>
> if($w){
> $cv->itemconfigure($w,-text => $_);
> $cv->update();
> }
>}

STDIN never closes by itself, so this will wait forever, and
block the gui from working.

Tk has Tk::fileevent and Tk::After to deal with these kind of
situations. However, fileevent has alot of trouble with STDIN,
because it's always readable. So here is an example that works.
Your mouse must be over the xterm which launches the program
so the keystrokes get sent to STDIN. And remember, STDIN dosn't send
it's data until you hit enter.

#!/usr/bin/perl
use warnings;
use Tk;
require 'sys/ioctl.ph';

my $mwin = MainWindow->new;
$mwin->geometry("600x600+10+10");

my $cv = $mwin->Canvas(-width => 500, -height => 500,
-bg=>'yellow')->pack;

my $data = 'test';
$cv->createText(200,200,-text => $data, -tags => ['txt']);

my $id = Tk::After->new($mwin,100,'repeat',\&refresh);

MainLoop;

sub refresh{
my ($w) = $cv->find('withtag','txt');

my $size = pack("L", 0);
ioctl(STDIN, FIONREAD(), $size) or die "Couldn't call ioctl: $!\n";
$size = unpack("L", $size);

print "$size\n";

if($size > 0){
sysread STDIN,$data,$size;
}

$cv->itemconfigure($w,-text => $data);
$cv->update();
}
__END__

########################################
####################

Just for jollies, look at how this next script works. It reads STDIN 1
char at a time.

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

my $mwin = MainWindow->new;
$mwin->geometry("600x600+10+10");

my $cv = $mwin->Canvas(-width => 500, -height => 500,
-bg=>'yellow')->pack;

my $data = 'test';
$cv->createText(200,200,-text => $data, -tags => ['txt']);

my $id = Tk::After->new($mwin,100,'repeat',\&refresh);

MainLoop;

sub refresh{
my ($w) = $cv->find('withtag','txt');

sysread STDIN,$data,1;

$cv->itemconfigure($w,-text => $data);
$cv->update();
}
__END__

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Sponsored Links