Perl Tk绑定到canvas项目

时间:2011-04-08 13:46:33

标签: perl canvas bind tk

在我的应用程序中,如果单击一次,则将在画布上绘制圆圈。如果双击,则最近添加的点将连接到多边形。

我需要将新的圆圈位置调整到点击(和现有)点的中心。也就是说,如果我在现有点内单击,那么新点将匹配此现有点。

我尝试为点击圈子和整个画布设置单独的回调,但是他们逐个调用。双击后也会调用点击圈子的回调...

有没有办法阻止事件传播?

 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;

2 个答案:

答案 0 :(得分:1)

好的,我只是删除了ovot-click-callback并检查是否在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;

答案 1 :(得分:1)

画布项目的事件处理与窗口事件的处理完全分开(好的,有一个链接,但它不在你可以操作的级别)。你必须自己做联锁,例如,通过在绑定之间共享一个变量。