Perl Tkのキャンバスアイテムへのバインド

Question

私のアプリケーションでは、一度クリックすると、キャンバスに円が描画されます。ダブルクリックすると、最近追加されたポイントがポリゴンに接続されます。

新しい円の位置を、クリックした（存在する）ポイントの中心に合わせる必要があります。つまり、既存の点の内部をクリックすると、新しい点がこの既存の点に一致します。

円をクリックして全体のキャンバスに別々のコールバックを設定しようとしましたが、1つずつ呼び出されました。また、円をクリックするコールバックは、ダブルクリック後に呼び出されます。

イベントの伝播を停止する方法はありますか？

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

キャンバスアイテムのイベントの処理が窓（OK、そこのリンクだが、それはあなたが操作できるレベルではありません）のためのイベントの処理から完全に分離されています。バインディング間で共有される変数を使用するなど、インターロックを自分で行う必要があります。

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;