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.

Leave a Reply

 

Staypressed theme by Themocracy