aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm122
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__