diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 122 |
1 files changed, 55 insertions, 67 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 82f6358..c2433bc 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -166,14 +166,14 @@ sub init { $on_command{findenclosed} = sub { &savebindings($selectedzinc); $button{findenclosed}->{Value} = 1; - $selectedzinc->Tk::bind("<1>",[\&startrectangle, 'simple', 'Enclosed', + $selectedzinc->Tk::bind("<ButtonPress-1>", + [\&startrectangle, 'simple', 'Enclosed', 'sienna']); $selectedzinc->Tk::bind("<B1-Motion>", \&resizerectangle); - $selectedzinc->Tk::bind("<B1-ButtonRelease>", + $selectedzinc->Tk::bind("<ButtonRelease-1>", [\&stoprectangle, 'enclosed', 'Enclosed search']); }; $off_command{findenclosed} = sub { - &savebindings($selectedzinc); $button{findenclosed}->{Value} = 0; &restorebindings($selectedzinc); $selectedzinc->remove("zincdebugrectangle", "zincdebuglabel"); @@ -182,10 +182,10 @@ sub init { $on_command{findoverlap} = sub { &savebindings($selectedzinc); $button{findoverlap}->{Value} = 1; - $selectedzinc->Tk::bind("<1>", [\&startrectangle, 'mixed', 'Overlap', + $selectedzinc->Tk::bind("<ButtonPress-1>", [\&startrectangle, 'mixed', 'Overlap', 'sienna']); $selectedzinc->Tk::bind("<B1-Motion>", \&resizerectangle); - $selectedzinc->Tk::bind("<B1-ButtonRelease>", + $selectedzinc->Tk::bind("<ButtonRelease-1>", [\&stoprectangle, 'overlapping', 'Overlap search']); }; $off_command{findoverlap} = sub { @@ -197,7 +197,7 @@ sub init { $on_command{item} = sub { &savebindings($selectedzinc); $button{item}->{Value} = 1; - $selectedzinc->Tk::bind("<1>", [\&findintree]); + $selectedzinc->Tk::bind("<ButtonPress-1>", [\&findintree]); }; $off_command{item} = sub { $button{item}->{Value} = 0; @@ -208,7 +208,7 @@ sub init { &savebindings($selectedzinc); $button{move}->{Value} = 1; my ($x0, $y0); - $selectedzinc->Tk::bind('<1>', sub { + $selectedzinc->Tk::bind('<ButtonPress-1>', sub { my $ev = $selectedzinc->XEvent; ($x0, $y0) = ($ev->x, $ev->y); }); @@ -230,7 +230,7 @@ sub init { $zinc->remove("zincdebugrectangle", "zincdebuglabel"); &savebindings($zinc); my $r; - $zinc->Tk::bind("<1>", sub { + $zinc->Tk::bind("<ButtonPress-1>", sub { $zinc->update; my ($w, $h) = ($zinc->cget(-width), $zinc->cget(-height)); $zinc->tsave(1, 'transfoTopgroup', 1); @@ -241,7 +241,7 @@ sub init { $zinc->raise($r); $selectedzinc = $zinc; }); - $zinc->Tk::bind("<B1-ButtonRelease>", sub { + $zinc->Tk::bind("<ButtonRelease-1>", sub { $zinc->remove($r); }); } @@ -348,62 +348,6 @@ sub snapshot { } # end snapshot - - - - - - - - - - - - - -sub savebindings { - - my ($zinc) = @_; - for my $seq ('1', 'B1-Motion', 'B1-ButtonRelease') { - $userbindings{$zinc}->{$seq} = $zinc->Tk::bind('<'.$seq.'>') - unless defined $userbindings{$zinc}->{$seq}; - $zinc->Tk::bind('<'.$seq.'>', ""); - } - -} # end savebindings - - -sub restorebindings { - - my ($zinc) = @_; - for my $seq ('1', 'B1-Motion', 'B1-ButtonRelease') { - next unless defined $userbindings{$zinc}->{$seq}; - $zinc->Tk::bind('<'.$seq.'>', $userbindings{$zinc}->{$seq}); - delete $userbindings{$zinc}->{$seq}; - } - -} # end restorebindings - - -sub newinstance { - - my $zinc = shift; - return if $instances{$zinc}; - $zinc->toplevel->Tk::bind('<Key-Escape>', sub { - $button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn}); - $control_tl->deiconify(); - $control_tl->raise(); - }); - $instances{$zinc} = 1; - push(@instances, $zinc); - $zinc->Tk::focus; - $selectedzinc = $zinc; - -} # end newinstance - - - - #--------------------------------------------------------------------------- # # Functions related to items tree @@ -540,7 +484,7 @@ sub findintree { # tree is rebuilded unless path exists unless ($tree->info('exists', $path)) { $tree_tl->destroy; - print "path=$path rebuild tree\n"; + #print "path=$path rebuild tree\n"; &showtree($zinc); } $tree->see($path); @@ -1701,7 +1645,6 @@ sub hidecontour { # display contours points (one rectangle per point) sub showcontourpts { - print "showcontourpts\n"; my ($widget, $zinc, $color, $item, $contourcoords, $deviceflag) = @_; my $i = 0; for my $coords (@$contourcoords) { @@ -2680,6 +2623,51 @@ sub instances { } # end instances +sub savebindings { + + my ($zinc) = @_; + for my $seq ('ButtonPress-1', 'B1-Motion', 'ButtonRelease-1') { + $userbindings{$zinc}->{$seq} = $zinc->Tk::bind('<'.$seq.'>') + unless defined $userbindings{$zinc}->{$seq}; + $userbindings{$zinc}->{$seq} = "" unless defined $userbindings{$zinc}->{$seq}; + #print "savebindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n"; + $zinc->Tk::bind('<'.$seq.'>', ""); + } + +} # end savebindings + + +sub restorebindings { + + my ($zinc) = @_; + for my $seq ('ButtonPress-1', 'B1-Motion', 'ButtonRelease-1') { + next unless defined $userbindings{$zinc}->{$seq}; + $zinc->Tk::bind('<'.$seq.'>', $userbindings{$zinc}->{$seq}); + #print "restorebindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n"; + delete $userbindings{$zinc}->{$seq}; + } + +} # end restorebindings + + +sub newinstance { + + my $zinc = shift; + return if $instances{$zinc}; + $zinc->toplevel->Tk::bind('<Key-Escape>', sub { + $button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn}); + $control_tl->deiconify(); + $control_tl->raise(); + }); + $instances{$zinc} = 1; + push(@instances, $zinc); + $zinc->Tk::focus; + $selectedzinc = $zinc; + +} # end newinstance + + + 1; __END__ |