Added a new mode to display the X cursor device coordinates.

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