Perl Tk привязка к элементам холста

Question

В моем приложении, если щелкнуть один раз, на холсте будет нарисован круг.Если дважды щелкнуть мышью, то недавно добавленные точки будут соединены с многоугольником.

Мне нужно настроить новое положение круга в центре нажатой (и существующей) точки.То есть, если я щелкну внутри существующей точки, то новая точка будет соответствовать этой существующей точке.

Я попытался установить отдельные обратные вызовы для щелчка по кругу и по всему холсту, но они вызывались один за другим.И обратный вызов для щелчка по кругу также вызывается после двойного щелчка ...

Есть ли способ остановить распространение события?

 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($countries->[-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;

Answer 1

Обработка событий для элементов холста полностью отделена от обработки событий для окон (ОК, есть ссылка, но она не на том уровне, которым вы можете манипулировать).Вы должны сделать блокировку самостоятельно, например, имея переменную, которая является общей для привязок.

Answer 2

Хорошо, я просто удалил овальный щелчок-обратный вызов и проверил, щелкнул ли он внутри или снаружи существующего овала в 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;