aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm132
1 files changed, 112 insertions, 20 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 57f5923..66738da 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -30,7 +30,8 @@ use Tk::Balloon;
my ($itemstyle, $groupstyle, $step);
my (%result_tl, $result_fm, $search_tl, $helptree_tl, %coords_tl, %transfo_tl,
- $helpcoords_tl, $searchtree_tl, $tree_tl, %alloptions_tl, $tree);
+ $helpcoords_tl, $searchtree_tl, $tree_tl, %alloptions_tl, $tree,
+ $cursorxy_tl, $cursorxy);
my $showitemflag;
my ($x0, $y0);
my ($help_print, $imagecounter, $saving) = (0, 0, 0);
@@ -132,7 +133,7 @@ sub init {
my $fm2 = $control_tl->Frame()->pack(-side => 'left', -padx => 20);
my $fm3 = $control_tl->Frame()->pack(-side => 'left', -padx => 0);
- for (qw(zn findenclosed findoverlap tree item id snapshot)) {
+ for (qw(zn findenclosed findoverlap tree item id snapshot cursorxy)) {
$button{$_} = $fm1->Checkbutton(-image => $bitmaps->{$_},
-indicatoron => 0,
-foreground => 'gray20')->pack(-side => 'left');
@@ -168,7 +169,7 @@ sub init {
# findenclosed mode
$on_command{findenclosed} = sub {
- &savebindings($selectedzinc);
+ &saveDragAndDropBindings($selectedzinc);
$button{findenclosed}->{Value} = 1;
$selectedzinc->Tk::bind("<ButtonPress-1>",
[\&startrectangle, 'simple', 'Enclosed',
@@ -180,12 +181,12 @@ sub init {
};
$off_command{findenclosed} = sub {
$button{findenclosed}->{Value} = 0;
- &restorebindings($selectedzinc);
+ &restoreDragAndDropBindings($selectedzinc);
$selectedzinc->remove("zincdebugrectangle", "zincdebuglabel");
};
# findoverlap mode
$on_command{findoverlap} = sub {
- &savebindings($selectedzinc);
+ &saveDragAndDropBindings($selectedzinc);
$button{findoverlap}->{Value} = 1;
$selectedzinc->Tk::bind("<ButtonPress-1>", [\&startrectangle, 'mixed',
'Overlap', 'sienna']);
@@ -196,22 +197,35 @@ sub init {
};
$off_command{findoverlap} = sub {
$button{findoverlap}->{Value} = 0;
- &restorebindings($selectedzinc);
+ &restoreDragAndDropBindings($selectedzinc);
$selectedzinc->remove("zincdebugrectangle", "zincdebuglabel");
};
# item mode
$on_command{item} = sub {
- &savebindings($selectedzinc);
+ &saveDragAndDropBindings($selectedzinc);
$button{item}->{Value} = 1;
$selectedzinc->Tk::bind("<ButtonPress-1>", [\&findintree]);
};
$off_command{item} = sub {
$button{item}->{Value} = 0;
- &restorebindings($selectedzinc);
+ &restoreDragAndDropBindings($selectedzinc);
};
+ # cursor device position mode
+ $on_command{cursorxy} = sub {
+ &saveMotionBinding($selectedzinc);
+ $button{cursorxy}->{Value} = 1;
+ &cursorxyOpen;
+ $selectedzinc->Tk::bind("<Motion>", [\&cursorxy]);
+ };
+ $off_command{cursorxy} = sub {
+ $button{cursorxy}->{Value} = 0;
+ &cursorxyClose;
+ &restoreMotionBinding($selectedzinc);
+ };
+
# move mode
$on_command{move} = sub {
- &savebindings($selectedzinc);
+ &saveDragAndDropBindings($selectedzinc);
$button{move}->{Value} = 1;
my ($x0, $y0);
$selectedzinc->Tk::bind('<ButtonPress-1>', sub {
@@ -227,14 +241,14 @@ sub init {
};
$off_command{move} = sub {
$button{move}->{Value} = 0;
- &restorebindings($selectedzinc);
+ &restoreDragAndDropBindings($selectedzinc);
};
# zn mode
$on_command{zn} = sub {
$button{zn}->{Value} = 1;
for my $zinc (&instances) {
$zinc->remove("zincdebugrectangle", "zincdebuglabel");
- &savebindings($zinc);
+ &saveDragAndDropBindings($zinc);
my $r;
$zinc->Tk::bind("<ButtonPress-1>", sub {
$zinc->update;
@@ -255,11 +269,11 @@ sub init {
$off_command{zn} = sub {
$button{zn}->{Value} = 0;
for my $zinc (&instances) {
- &restorebindings($zinc);
+ &restoreDragAndDropBindings($zinc);
}
};
- my @but = qw(findenclosed findoverlap item move zn);
+ my @but = qw(findenclosed findoverlap item move zn cursorxy);
for my $name (@but) {
$button{$name}->configure(-command => sub {
if ($button{$name}->{Value} == 1) {
@@ -313,7 +327,7 @@ sub init {
$button{close}->configure(-command => sub {
$button{close}->update;
&Tk::Zinc::Debug::iconify;
- &restorebindings($selectedzinc);
+ &restoreDragAndDropBindings($selectedzinc);
for my $name (@but) {
&{$off_command{$name}};
}
@@ -356,6 +370,41 @@ sub snapshot {
#---------------------------------------------------------------------------
#
+# Functions related to cursor position
+#
+#---------------------------------------------------------------------------
+sub cursorxy {
+
+ my $ev = shift->XEvent;
+ $cursorxy = $ev->x.", ".$ev->y;
+
+} # end cursorxy
+
+
+sub cursorxyOpen {
+
+ if (Tk::Exists($cursorxy_tl)) {
+ $cursorxy_tl->raise;
+ return;
+ }
+ $cursorxy_tl = $control_tl->Toplevel;
+ $cursorxy_tl->Label(-text => "Cursor device position")->pack;
+ $cursorxy_tl->Label(-textvariable => \$cursorxy)->pack;
+ $cursorxy_tl->minsize(150, 40);
+ $cursorxy_tl->raise;
+
+} # end cursorxyOpen
+
+
+sub cursorxyClose {
+
+ $cursorxy_tl->destroy if Tk::Exists($cursorxy_tl);
+
+} # end cursorxyClose
+
+
+#---------------------------------------------------------------------------
+#
# Functions related to items tree
#
#---------------------------------------------------------------------------
@@ -2517,6 +2566,22 @@ static unsigned char balloon_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
EOF
+ $bitmaps->{cursorxy} = $zinc->toplevel->Bitmap(-data => <<EOF);
+#define balloon_width 29
+#define balloon_height 29
+static unsigned char balloon_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00,
+ 0x00, 0x06, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00, 0x7c, 0x00, 0x00,
+ 0x00, 0x1c, 0x00, 0x00, 0x00, 0x28, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00,
+ 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x02, 0x00,
+ 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x30, 0x06, 0x8c, 0x01, 0x70, 0x07, 0x8c, 0x01, 0x60, 0x03, 0x8c, 0x01,
+ 0xc0, 0x01, 0xd8, 0x00, 0xc0, 0x01, 0xd8, 0x00, 0x60, 0xe3, 0xd8, 0x00,
+ 0x70, 0x66, 0x70, 0x00, 0x30, 0x66, 0x70, 0x00, 0x00, 0x30, 0x60, 0x00,
+ 0x00, 0x30, 0x30, 0x00, 0x00, 0x00, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
+EOF
+
return $bitmaps;
} # end createBitmaps
@@ -2615,31 +2680,56 @@ sub instances {
} # end instances
-sub savebindings {
+sub saveMotionBinding {
+
+ my ($zinc) = @_;
+ for my $seq ('Motion') {
+ $userbindings{$zinc}->{$seq} = $zinc->Tk::bind('<'.$seq.'>')
+ unless defined $userbindings{$zinc}->{$seq};
+ $userbindings{$zinc}->{$seq} = "" unless defined $userbindings{$zinc}->{$seq};
+ $zinc->Tk::bind('<'.$seq.'>', "");
+ }
+
+} # end saveMotionBinding
+
+
+sub restoreMotionBinding {
+
+ my ($zinc) = @_;
+ for my $seq ('Motion') {
+ next unless defined $userbindings{$zinc}->{$seq};
+ $zinc->Tk::bind('<'.$seq.'>', $userbindings{$zinc}->{$seq});
+ delete $userbindings{$zinc}->{$seq};
+ }
+
+} # end restoreMotionBinding
+
+
+sub saveDragAndDropBindings {
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";
+ #print "saveDragAndDropBindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n";
$zinc->Tk::bind('<'.$seq.'>', "");
}
-} # end savebindings
+} # end saveDragAndDropBindings
-sub restorebindings {
+sub restoreDragAndDropBindings {
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";
+ #print "restoreDragAndDropBindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n";
delete $userbindings{$zinc}->{$seq};
}
-} # end restorebindings
+} # end restoreDragAndDropBindings
sub newinstance {
@@ -2671,6 +2761,7 @@ sub deiconify {
$tree_tl->deiconify if Tk::Exists($tree_tl);
$search_tl->deiconify if Tk::Exists($search_tl);
$searchtree_tl->deiconify if Tk::Exists($searchtree_tl);
+ $cursorxy_tl->deiconify if Tk::Exists($cursorxy_tl);
$control_tl->raise();
} # end deiconify
@@ -2690,6 +2781,7 @@ sub iconify {
$tree_tl->withdraw if Tk::Exists($tree_tl);
$search_tl->withdraw if Tk::Exists($search_tl);
$searchtree_tl->withdraw if Tk::Exists($searchtree_tl);
+ $cursorxy_tl->withdraw if Tk::Exists($cursorxy_tl);
$control_tl->withdraw();
} # end iconify