PerlTk - No Events for members of Canvas group ?

Author

No Events for members of Canvas group ?

Tom

2006-08-16, 6:59 pm

Hi all,

the Canvas createGroup() method comes very handy for manipulating
several objects in one shot.
However i have no success preserving Event processing for individual
members; it seems the group is eating up the events and the original
object is not triggered any more.

The following piece of code demonstrates the difference between a
grouped and a not-grouped object. While there is a balloon opening for
$circ1, there is no balloon for $circ2.

Before i throw the nice group concept into the bin, is there someone
who can tell how $circ2 can have its balloon ?

Thanks,

- Tom

-----------------
use Tk;
use Tk::Balloon;

my $mw = MainWindow->new;

$canv = $mw->Canvas->pack(-fill => both, -expand => 1);
$circ1 = $canv->createOval(100,100,110,110);

$rect = $canv->createRectangle(0,0,20,20);
$circ2 = $canv->createOval(150,150,160,160);
$balloon = $mw->Balloon();
$group = $canv->createGroup([0,0], -members => [$rect,$circ2]);

$balloon->attach($canv, -balloonposition => 'mouse', -msg => {$circ1
=>'Circ1',$circ2 => 'Circ2' } );

MainLoop;

QoS@domain.invalid.com

2006-08-16, 6:59 pm

"Tom" <tom23@web.de> wrote in message-id:
<1155765376.749660.183250@75g2000cwc.googlegroups.com>
>
>Hi all,
>
>the Canvas createGroup() method comes very handy for manipulating
>several objects in one shot.
>However i have no success preserving Event processing for individual
>members; it seems the group is eating up the events and the original
>object is not triggered any more.
>
>The following piece of code demonstrates the difference between a

>grouped and a not-grouped object. While there is a balloon opening for
>$circ1, there is no balloon for $circ2.
>
>Before i throw the nice group concept into the bin, is there someone
>who can tell how $circ2 can have its balloon ?
>
>Thanks,
>
> - Tom
>
>-----------------
>use Tk;
>use Tk::Balloon;
>
>my $mw = MainWindow->new;
>
>$canv = $mw->Canvas->pack(-fill => both, -expand => 1);
>$circ1 = $canv->createOval(100,100,110,110);
>
>$rect = $canv->createRectangle(0,0,20,20);
>$circ2 = $canv->createOval(150,150,160,160);
>$balloon = $mw->Balloon();
>$group = $canv->createGroup([0,0], -members => [$rect,$circ2]);
>
>
>$balloon->attach($canv, -balloonposition => 'mouse', -msg => {$circ1
>=>'Circ1',$circ2 => 'Circ2' } );
>
>MainLoop;

One approach may be to use the canvas tags, tag the object and bind
a subroutine to the tag.. this subroutine could perhaps raise a label
in leiu of the balloon.

This is just one possibility and likely not the best, just off the top
of my head. If I get a chance tonight i'll try some other ways.

Here is a little code snippet somewhat depecting the above concept.

$cv1->bind("$tag $mday", "<Leave>", sub {
my $imagedata = &load_image($mp, $limg);
my $image = $mw->Photo(
-format => 'gif',
-data => $imagedata
);
undef $imagedata;
$cv1->itemconfigure("$tag $mday",
-image => $image);
$mw->update;
});

Tom

2006-08-17, 3:58 am

QoS@domain.invalid.com schrieb:

>
> This is just one possibility and likely not the best, just off the top
> of my head. If I get a chance tonight i'll try some other ways.
>
> Here is a little code snippet somewhat depecting the above concept.
>
>
Thanks for the feedback.

Since i have > 100 "circles" on the canvas, i use the balloon to
display detail information without polluting the canvas. Using tags,
i'd have to use a different tag/bind per circle; sounds like much code.

Hopefully there is another way...

- Tom

zentara

2006-08-17, 7:58 am

On 17 Aug 2006 01:27:10 -0700, "Tom" <tom23@web.de> wrote:

>QoS@domain.invalid.com schrieb:
>
>Thanks for the feedback.
>
>Since i have > 100 "circles" on the canvas, i use the balloon to
>display detail information without polluting the canvas. Using tags,
>i'd have to use a different tag/bind per circle; sounds like much code.
>
>Hopefully there is another way...

Well the easiest way is to use tags. You just need to get used to adding
alot of tags when you create objects, then grepping for tags and doing
whatever depending on the results of the grep. Groups just are not seen
much in the plain Tk canvas, however they are in Tk::Zinc. But even in
Zinc, you need to rely on tags for certain operations.

Here is a little example I put together from a few old snippets posted
here by various people.

Look at how I did the tags, you can have many tags for any object.
If you plan it carefully, you can do quite complex things with very
little code, by just grepping the tags.

#!/usr/bin/perl
use strict;
use Tk;
use Tk::Balloon;

my $dx;
my $dy;
my $balloonhash = {};
my $statushash = {};

my $mw = tkinit;
my $c = $mw->Canvas->pack;
my $statusbar = $mw->Label->pack( -fill => 'x' );

my $b = $c->Balloon(
-initwait => 0,
-statusbar => $statusbar,
-balloonposition => 'mouse'
);

$b->attach(
$c,
-initwait => 75,
-balloonmsg => $balloonhash,
-statusmsg => $statushash,
-cancelcommand => \&checktag
);

for my $i ( 0 .. 4 ) {

my $item = $c->create(
'rect',
$i * 20, $i * 20, $i * 20 + 20,
$i * 20 + 20,
-fill => 'red',
-tags => ["TAF$i", 'group1', 'move']
);

$balloonhash->{$item} = "Balloon $i WITH tag";
$statushash->{$item} = "Status message $i WITH tag";

my $item2 = $c->create(
'rect', $i * 20 + 20,
$i * 20,
$i * 20 + 40,
$i * 20 + 20,
-fill => 'green',
-tags => ['group2','move']
);
$balloonhash->{$item2} = "Balloon $i with NO tag";
$statushash->{$item2} = "Status message $i NO tag";
}

$c->bind('move', '<1>', sub {&mobileStart();});
$c->bind('move', '<B1-Motion>', sub {&mobileMove();});
$c->bind('move', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;

sub checktag {
if ( grep /TAF/, $c->gettags('current') ) {
return 0;
}
else {
return 1;
}
}

sub mobileStart {
my $ev = $c->XEvent;
($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
$c->raise('current');
print "START MOVE-> $dx $dy\n";
}

sub mobileMove {
my $ev = $c->XEvent;

#you can drag individuals or whole groups
if ( grep /TAF/, $c->gettags('current') ) {
$c->move('current', $ev->x + $dx, $ev->y +$dy);
}else{
$c->move('group2', $ev->x + $dx, $ev->y +$dy);
}

($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
print "MOVING-> $dx $dy\n";
}

sub mobileStop{&mobileMove;}
__END__

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

Tom

2006-08-17, 6:58 pm

zentara schrieb:

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

Cool example.
So the suggestion is to stay away from the undocumented event-eating
Canvas Group and use tags.

Thanks!
- Tom

Sponsored Links