PerlTK and “activating” multiple canvas items
What I was looking for was every row and every column to be “lit up” wherever I put my mouse cursor. I started with the base code snippet:
#!/usr/bin/perl -w
use strict;
use Tk;
my ($x, $y);
my $iconSize = 20;
my ($width, $height) = (3, 3);
my ($canvasWidth, $canvasHeight) = ($iconSize+$width*$iconSize,
$iconSize+$height*$iconSize);
my $MW = MainWindow->new;
my $MF = $MW->Frame->pack;
my $c = $MF->Canvas( -width => $canvasWidth,
-height => $canvasHeight )->pack;
for ($y = $iconSize; $y < $canvasHeight; $y+=$iconSize)
{
for ($x = $iconSize; $x < $canvasWidth; $x+=$iconSize)
{
$c->createRectangle ($x, $y,
$x+$iconSize, $y+$iconSize,
-fill => '#AFAFAF',
-activefill => '#CFCFCF' );
}
}
MainLoop
And posted to comp.lang.perl.tk for help. I received two solutions.
Zentara was first to reply, who wrote:
The secret to using the Canvas is tags. Read the perldoc Tk::Canvas for everything on tags, and search groups.google.com for "Perl Tk canvas tags" for many examples. It's kind of an art, to see which tag juggling technique to use, but generally you bind to motion or a tag, then find the current item, then addtags or deltags, etc. You can get very clever and make things very efficient. For instance, in the following script, I do it the clunky way, by itemconfiguring a bunch of items returned by find. But you could also define a tag called "lit' (or something), and addtag lit to all rows and cols on enter, then deltags lit on leaving.
Second to reply was Jack D. He altered Zentara’s solution making it more compact.
#!/usr/bin/perl -w
use strict;
use Tk;
my ($x, $y);
my $iconSize = 20;
my ($width, $height) = (10, 10);
my ($canvasWidth, $canvasHeight) = ($iconSize+$width*$iconSize,
$iconSize+$height*$iconSize);
my $MW = MainWindow->new;
my $MF = $MW->Frame->pack;
my $c = $MF->Canvas( -width => $canvasWidth,
-height => $canvasHeight )->pack;
for ($y = $iconSize; $y < $canvasHeight; $y+=$iconSize)
{
for ($x = $iconSize; $x < $canvasWidth; $x+=$iconSize)
{
$c->createRectangle ($x, $y,
$x+$iconSize, $y+$iconSize,
-fill => '#AFAFAF',
-activefill => '#CFCFCF',
-tags=>['rect',"row.$y", "col.$x"] );
}
}
$c->bind('rect', '<Enter>', \&enter );
$c->bind("rect", "<Leave>", \&leave );
MainLoop;
sub findtag {
my ($canv) = @_;
my $id = $canv->find('withtag', 'current');
my @tags = $canv->gettags($id);
my ($row) = ( grep /^row\d*/, @tags );
my ($col) = ( grep /^col\d*/, @tags );
return ($row,$col);
}
sub enter {
my ($canv) = @_;
my ($r,$c) = findtag($canv);
$canv->itemconfigure($r, -fill=>$canv->itemcget($r,-activefill));
$canv->itemconfigure($c, -fill=>$canv->itemcget($c,-activefill));
}
sub leave{
my ($canv) = @_;
$canv->itemconfigure('rect', -fill=>'#AFAFAF');
}
__END__
And it certainly gets the job done. I’m interested in that particular trick for a game I’m currently programming. I call it Piksahl and I’ll release more details as the game sees more progress.
Categories: General Programming active, activefill, canvas, fill, multiple, perl, PerlTK, Piksahl, tk







