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

好的，我刚刚删除了椭圆形单击回调，并检查是否在画布单击回调中的现有椭圆形内部或外部单击。

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