캔버스 항목에 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

캔버스 항목에 대한 이벤트의 처리는 창 (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;