Re: Determine canvas object under click (Tk)

[thundergnat]

I can think of a few possible ways to do that... though they all require a few contortions. Easiest is probably to use addtag. The canvas addtag method has a few nice search options; (nearest, overlapping. enclosed) that should be useful. Add a tag 'current' (or whatever) to the item, use that tag to process it, then delete the 'current' tag.

Like so:

#!/usr/bin/perl

use Tk;
my $mw = MainWindow->new;
my $c  = $mw->Canvas(
    qw/-width 20c -height 15c -relief sunken
      -borderwidth 2/
);
$c->pack(qw/-expand yes -fill both/);

$c->createPolygon(
    qw/5c 4c 5c 7c 5c 1c 6c 1c 7c 4c 8c 1c 9c 1c
      9c 4c 5c 4c -smooth on -tags item1/, -fill => 'red'
);
$c->createRectangle(
    qw/1c 9.5c 4c 12.5c/,
    -outline => 'red',
    qw/-width 3m -tags item2/
);
$c->createLine(
    qw/1c 1c 3c 1c 1c 4c 3c 4c -width 2m/,
    -fill => 'blue',
    qw/-cap butt -join miter -tags item3/
);

$c->createLine(
    qw/1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c
      -cap round -join round -tags item4/
);

$c->createLine(
    qw/1c 4c 1.5c 1c 3.5c 1c 4c 4c -smooth on/,
    -fill => $blue,
    qw/-tags item5/
);
$c->createLine(
    qw/11.5c 1c 15.5c 1.5c 11.5c 4.5c 15.5c 4c -smooth on
      -arrow both -width 3 -tags item6/
);

$c->createPolygon(
    qw/8c 8.0c 9.5c 8.75c 11c 8.0c 10.25c 9.5c 11c 11.0c
      9.5c 10.25c 8c 11.0c 8.75c 9.5c -tags item7/,
    -fill => 'green'
);

$c->createOval(
    qw/5.5c 8.5c 4.5c 6.5c/,
    -fill => 'green',
    qw/-tags item8/
);

$c->CanvasBind(
    '<1>' => sub {
        my ($c) = @_;
        print get_current( $c, $Tk::event->x, $Tk::event->y ), "\n";
    }
);

MainLoop;

sub get_current {
    my ( $c, $x, $y ) = @_;
    $c->addtag( qw/current closest/, $x, $y );
    my @tags = grep {$_ ne 'current'} $c->gettags(qw/current/);
    $c->dtag(qw/current current/);
    return @tags;
}