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

# 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();

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',
		      );


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

my $cbutton = $mw->Button(-text => 'Clear',
                  -command => sub{$canvas->delete('all')})->pack();


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

MainLoop();

sub print_xy {
  my ($canv, $x, $y) = @_;
#  print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";

#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){ 
    print $canvas->gettags($id),' ';
}

print "\n";

}