Perl Tk binding to canvas items

In my application if click once then circle will be drawed on canvas. If double click then recently added points will be connected to polygon.

I need to adjust new circle position to the center of clicked (and existing) point. That is if I click inside existing point then new point will match this existing point.

I tried to set separate callbacks for click on circle and on whole canvas but they called one-by-one. And callback for click on circle is also called after double-click...

Is there a way to stop event propagation?

 use strict;
use Tk;

my $countries = [];
push(@$countries, []);

my $mw = MainWindow->new;
$mw->title("Graph colorer");
$mw->minsize(600, 600);
$mw->resizable(0, 0);

my $canvas = $mw->Canvas(-background => 'white')->pack(-expand => 1,
                                                       -fill => 'both');
$canvas->bind('point', "<Button-1>", [ \&smart_point, Ev('x'), Ev('y') ]);
$canvas->Tk::bind("<Button-1>", [ \&append_point, Ev('x'), Ev('y') ]);
$canvas->Tk::bind("<Double-Button-1>", [ \&draw_last_country ]);

sub append_point {
    my ($canv, $x, $y) = @_;
    my $last_country = $countries->[-1];
    my ($canvx, $canvy) = ($canv->canvasx($x), $canv->canvasy($y));
    push(@$last_country, $canvx, $canvy);
    $canv->createOval($canvx-5, $canvy-5, $canvx+5, $canvy+5, -tags => 'point',
                      -fill => 'green');
    print "pushed (x,y) = ", $canvx, ", ", $canvy, "\n";
}

sub draw_last_country {
    my $canv = shift;
    $canv->createPolygon($开发者_如何学JAVAcountries->[-1]);
    push(@$countries, []);
}

sub smart_point {
    my $canv = shift;
    my $id = $canv->find('withtag', 'current');
    my ($x1, $y1, $x2, $y2) = $canv->coords($id);
    print "clicked (x,y) = ", ($x2-$x1)/2, ", ", ($y2-$y1)/2, "\n";
}

MainLoop;

The processing of events for canvas items is completely separate from the processing of events for windows (OK, there's a link, but it's not at a level that you can manipulate). You have to do the interlock yourself, e.g., by having a variable that's shared between the bindings.

Ok, I've just remove oval-click-callback and check if clicked inside or outside of an existing oval in canvas-click-callback.

# algorithm mado-williams

use strict;
use Tk;

my $RADIUS = 6;

my $countries = [];
push(@$countries, []);

my $mw = MainWindow->new;
$mw->title("Graph colorer");
$mw->minsize(600, 600);
$mw->resizable(0, 0);

my $canvas = $mw->Canvas(-background => 'white')->pack(-expand => 1,
                                                       -fill => 'both');

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

sub append_point {
    # Append new point to the last country. If clicked into existing point then
    # adjust position of new point to this existing point.

    my ($canv, $x, $y) = @_;
    my ($canvx, $canvy) = ($canv->canvasx($x), $canv->canvasy($y));
    # find nearest existing point (find_nearest return undef when wi clicked
    # outside any existing point)
    my $nearest = find_nearest($canvx, $canvy);
    if (defined $nearest) {
        # if we clicked into existing point then adjust position to this point
        ($canvx, $canvy) = point_center($nearest);
    }
    # append new point to the last country
    my $last_country = $countries->[-1];
    push(@$last_country, $canvx, $canvy);
    # draw new point
    $canv->createOval($canvx-$RADIUS, $canvy-$RADIUS, $canvx+$RADIUS, $canvy+$RADIUS,
                      -tags => 'point', -fill => 'green');
    print "pushed (x,y) = ", $canvx, ", ", $canvy, "\n";
}

sub find_nearest {
    # Find nearest point to specified position.
    # Return its id or undef if clicked outside.
    my ($px, $py) = @_;
    my @points = $canvas->find('withtag', 'point');
    # sort existing points by ascending distance from specified position
    my @points = sort {distance($a, $px, $py)  distance($b, $px, $py)} @points;
    if (distance($points[0], $px, $py) coords($pid);
    my $cx = $px1 + ($px2 - $px1) / 2, my $cy = $py1 + ($py2 - $py1) / 2;
    return ($cx, $cy);
}

sub draw_last_country {
    # draws last country
    my $canv = shift;
    $canv->createPolygon($countries->[-1]);
    push(@$countries, []);
}

MainLoop;