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

my $mw = MainWindow->new();

# first create a canvas widget 
my $canvas = $mw->Canvas(width => 300, height => 200)->pack();

my $one = $canvas->createOval(55, 20, 200, 190,
                      -fill => 'blue',
                      -outline=>'blue',
                      -tags => ['blue'],
                      );

my $two = $canvas->createOval(105, 20, 250, 190,
                      -fill => 'red',
                      -outline=>'red',
                      -tags => ['red'],
                      );


my $ebutton = $mw->Button(-text => 'Exit',
                  -command => 'Tk::exit')->pack();


$canvas->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

MainLoop();

sub print_xy {
  my ($canv, $x, $y) = @_;


#trick to simulate a 1 point rectangular area 
my (@current) = $canvas->find('overlapping', $x, $y, $x, $y);

foreach my $id(@current){
    print $canvas->gettags($id),' ';
}
print "\n";
}
__END__
[download]

So a way to get around this, in Tk, is to use a transparent stipple. This is still clunky compared to semi-transparency allowed in Zinc or perl-gtk. I thru in a balloon too, to make it seem like a party. :-)

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::CanvasBalloon;

# the -stipple=>'transparent' option will still 
# allow the bindings to work, but you can see the overlap 
# See Chapter 17 of Mastering Perl/Tk 

my $mw = MainWindow->new();

# first create a canvas widget 
my $canvas = $mw->Canvas(width => 300, height => 200)->pack();

#create a balloon 
my $msg = '';
my $balloon = $mw->CanvasBalloon(
            -initwait        => 0,
    );

my $one = $canvas->createOval(55, 20, 200, 190,
                      -fill => 'blue',
                      -outline=>'blue',
                      -tags => ['blue'],
                      -stipple => 'transparent',
                      );

my $two = $canvas->createOval(105, 20, 250, 190,
                      -fill => 'red',
                      -outline=>'red',
                      -tags => ['red'],
                      -stipple => 'transparent',
                      );

$balloon->attach($canvas, ['blue','red'],
           -balloonmsg => $msg,
        );

my $ebutton = $mw->Button(-text => 'Exit',
                  -command => 'Tk::exit')->pack();

$canvas->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

MainLoop();

sub print_xy {
  my ($canv, $x, $y) = @_;
  my @tags =();
#trick to find overlapping objects, just use x1 = x and y1 = y 
#to get a rectangular region of 1 point 
my (@current) = $canvas->find('overlapping', $x, $y, $x, $y);

foreach my $id(@current){
    push @tags, $canvas->gettags($id);
}

$msg = join ' ', @tags;
$balloon->Popup($msg);

}
__END__
[download]