in reply to Break event chain in Tk::Canvas
#!/usr/bin/perl use strict; use warnings; use Tk; my $inpoint = 0; my $mw = MainWindow->new(); my $canvas = $mw->Canvas(-width => 300, -height => 300, -closeenough = +> 5); $mw->bind($canvas, '<1>', \&add_point); $canvas->bind('point', '<Enter>', sub{ $inpoint = 1 }); $canvas->bind('point', '<Leave>', sub{ $inpoint = 0 }); $canvas->bind('point', '<1>', \&toggle); $canvas->pack(); MainLoop(); sub add_point { ### adding a point... return if $inpoint; my ($canvas) = @_; my $e = $canvas->XEvent; my ($x, $y) = ($e->x, $e->y); my $id = $canvas->createOval( $x - 10, $y - 10, $x + 10, $y + 10, -fill => 'blue', -tags => ['point'] ); ### new point created: "$id => [$x, $y]" return; } ## end sub add_point sub toggle { ### toggle point... my ($canvas) = @_; my $item_id = $canvas->find('withtag', 'current')->[0]; ### item id: $item_id my $current_color = $canvas->itemcget($item_id, 'fill'); my $next_color = $current_color eq 'red' ? 'blue' : 'red'; $canvas->itemconfigure($item_id, -fill => $next_color); Tk->break(); # Try to break, but with little luck... return; } ## end sub toggle
|
|---|