Possibilit� de visualiser la bounding box de tout item.

Capacit� d'�dition de la plupart des attributs d'un item (hors position,
tags, clip, ...)

1 files changed, 160 insertions, 75 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 19adf50..d086e63 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -33,7 +33,7 @@ my $coords_tl;
 my $devicecoords_tl;
 my ($text_id, $rectangle_id);
 my ($x0, $y0);
-my ($help_print, $imagecounter, $saving) = (0,0);
+my ($help_print, $imagecounter, $saving) = (0, 0, 0);
 my $searchEntryValue;
 my $searchTreeEntryValue;
 my $tree_tl;
@@ -48,10 +48,11 @@ my $tree;
 my @keys;
 my @seq;
 my $helptree_tl;
-my $wwidth;
-my $wheight;
+my $wwidth = 0;
+my $wheight = 0;
 my $preload;
 my %run;
+my %defaultoptions;
 
 sub BEGIN {
     # test if ZincDebug is loaded using the -M perl option
@@ -63,6 +64,7 @@ sub BEGIN {
 sub Tk::Zinc::InitObject {
     Tk::Widget::InitObject(@_);
     return unless $preload;
+    return if $zinc;
     $zinc = $_[0];
     &tree($zinc);
     &finditems($zinc);
@@ -250,21 +252,20 @@ sub showtree {
 			       -command => sub {
 				   my $path = shift;
 				   my $item = (split(/\./, $path))[-1];
-				   $zinc->remove("zincdebug");
 				   &showresult("", $zinc, $item);
+				   $zinc->after(100, sub {$zinc->remove("zincdebug")});
 			       },
 			       );
     $tree->bind('<1>', [sub {
 	my $path = $tree->nearest($_[1]);
 	my $item = (split(/\./, $path))[-1];
-	print "item=$item\n";
 	&highlightitem($tree, $zinc, $item, 0);
 		       
     }, Ev('y')]);
     
     $tree->bind('<2>', [sub {
 	my $path = $tree->nearest($_[1]);
-	return if $path == 1;
+	return if $path eq 1;
 	$tree->selectionClear;
 	$tree->selectionSet($path);
 	$tree->anchorSet($path);
@@ -275,7 +276,7 @@ sub showtree {
 
     $tree->bind('<3>', [sub {
 	my $path = $tree->nearest($_[1]);
-	return if $path == 1;
+	return if $path eq 1;
 	$tree->selectionClear;
 	$tree->selectionSet($path);
 	$tree->anchorSet($path);
@@ -447,7 +448,7 @@ sub scangroup {
 
 #---------------------------------------------------------------------------
 #
-# FIND PRIVATE FUNCTIONS
+# AREA SEARCH PRIVATE FUNCTIONS
 #
 #---------------------------------------------------------------------------
 # begin to draw rectangular area for search
@@ -594,9 +595,6 @@ sub setwidget {
     } else {
 	$zinc = $widget;
     }
-    $zinc->update;
-    my $geom = $zinc->geometry =~ /(\d+)x(\d+)+/=~ /(\d+)x(\d+)+/;
-    ($wwidth, $wheight) = ($1, $2);
     # binding for help screen
     $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp);
 	    
@@ -640,6 +638,11 @@ sub compatseq {
 } # end compatkey
 
 
+#---------------------------------------------------------------------------
+#
+# RESULTS DISPLAY PRIVATE FUNCTIONS
+#
+#---------------------------------------------------------------------------
 
 # display in a toplevel the result of search ; a new toplevel destroyes the
 # previous one
@@ -699,14 +702,24 @@ sub showotheroptions {
 			   )->pack(-padx => 10, -pady => 10,
 				   -ipadx => 10,
 				   -fill => 'both');
+    my $btn1 = $fm->Button(-text => 'Show Item',)
+	->grid(-row => 1, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+    $btn1->bind('<1>', [\&highlightitem, $zinc, $item, 0]);
+    $btn1->bind('<2>', [\&highlightitem, $zinc, $item, 1]);
+    $btn1->bind('<3>', [\&highlightitem, $zinc, $item, 2]);
+    my $btn2 = $fm->Button(-text => 'Bounding Box')
+	->grid(-row => 1, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+    $btn2->bind("<1>", [\&showbbox, $zinc, $item]);
+    $btn2->bind("<ButtonRelease-1>", [\&hidebbox, $zinc]);
+
     my $bgcolor = 'ivory';
     $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge')
-	->grid(-row => 1, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+	->grid(-row => 2, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
     $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge')
-	->grid(-row => 1, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+	->grid(-row => 2, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
 
     my @options = $zinc->itemconfigure($item);
-    my $i = 2;
+    my $i = 3;
     for my $elem (@options) {
 	my ($option, $type, $value) = (@$elem)[0,1,4];
 	#print "option=$option type=$type\n";
@@ -719,7 +732,7 @@ sub showotheroptions {
 	}
 	$fm->Label(-text => $option, -relief => 'ridge')
 	    ->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
-	$fm->Label(-text => $value, -relief => 'ridge')
+	&entryoption($fm, $item, $zinc, $option)
 	    ->grid(-row => $i, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
 	$i++;
     }
@@ -733,7 +746,7 @@ sub showdevicecoords {
     my ($zinc, $item) = @_;
     &showcoords($zinc, $item, 1);
 
-}
+} # end showdevicecoords
 
 
 sub showcoords {
@@ -811,7 +824,8 @@ sub showcoords {
 	    $coords->[0] =~ s/\.(\d\d).*/\.$1/;
 	    $coords->[1] =~ s/\.(\d\d).*/\.$1/;
 	    my $pointtype = (defined $coords->[2]) ? " ".$coords->[2] : "";
-	    $coords_fm->Label(-text => sprintf('%s, %s%s', $coords->[0], $coords->[1],$pointtype),
+	    $coords_fm->Label(-text => sprintf('%s, %s%s', $coords->[0], $coords->[1],
+					       $pointtype),
 			      -width => 15,
 			      -relief => 'ridge')->grid(-row => $row,
 							-ipadx => 5,
@@ -839,8 +853,15 @@ sub showgroupattributes {
     my $r = 1;
     # content
     $fm->Button(-command => [\&showgroupcontent, $zinc, $item],
+		-height => 2,
 		-text => 'Content',
-		)->grid(-row => $r++, -col => 1, -columnspan => 2, -sticky => 'nswe');
+		)->grid(-row => $r, -col => 1, -sticky => 'nswe');
+    my $btn = $fm->Button(-height => 2,
+			  -text => 'Bounding Box',
+			  )->grid(-row => $r++, -col => 2, -sticky => 'nswe');
+    $btn->bind("<1>", [\&showbbox, $zinc, $item]);
+    $btn->bind("<ButtonRelease-1>", [\&hidebbox, $zinc]);
+
     # parent group
     $fm->Label(-text => 'Parent group', -relief => 'ridge')
 	->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
@@ -919,13 +940,17 @@ sub showgroupattributes {
 	my ($option, $value) = (@$elem)[0,4];
 	$fm->Label(-text => $option, -relief => 'ridge')
 	    ->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+	my $w;
 	if ($option and $option eq '-tags') {
 	    $value = join("\n", @$value);
+	    $w = $fm->Label(-text => $value, -relief => 'ridge');
 	} elsif ($option and $option eq '-clip' and $value and $value > 0) {
 	    $value .= " (". $zinc->type($value) .")";
+	    $w = $fm->Label(-text => $value, -relief => 'ridge');
+	} else {
+	    $w = &entryoption($fm, $item, $zinc, $option);
 	}
-	$fm->Label(-text => $value, -relief => 'ridge')
-	    ->grid(-row => $r, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
+	$w->grid(-row => $r, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
 	$r++;
     }
     $tl->Button(-text => 'Close',
@@ -967,6 +992,36 @@ sub showgroupcontent {
 
 } # end showgroupcontent
 
+# display the bbox of a group item
+sub showbbox {
+    my ($btn, $zinc, $item) = @_;
+    my @bbox  = $zinc->bbox($item);
+    if (scalar @bbox == 4) {
+	# If item is visible, rectangle is drawm surround it.
+	# Else, a warning is displayed.
+	unless (&itemisoutside(@bbox)) {
+	    my $i = 0;
+	    for ('white', 'blue', 'white') {
+		$zinc->add('rectangle', 1,
+			   [$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i,
+			    $bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i],
+			   -linecolor => $_,
+			   -linewidth => 1,
+			   -tags => ['zincdebugbbox']);
+		$i++;
+	    }
+	}
+    }
+    $zinc->raise('zincdebugbbox');
+
+} # end showgroupbbox
+
+
+sub hidebbox {
+    my ($btn, $zinc) = @_;
+    $zinc->remove("zincdebugbbox");
+
+} # end hidegroupbbox
 
 
 # highlight an item (by cloning it and hiding other found items)
@@ -986,6 +1041,7 @@ sub highlightitem {
 sub itemisoutside {
     my @bbox = @_;
     my $outflag;
+    $WARNING = 0;
     if ($bbox[2] < 0) {
 	if ($bbox[1] >  $wheight) {
 	    $outflag = 'left+bottom';
@@ -1097,7 +1153,7 @@ sub surrounditem {
 	# If item is visible, rectangle is drawm surround it.
 	# Else, a warning is displayed.
 	unless (&itemisoutside(@bbox0)) {
-	    if ($level > 0) {
+	    if (defined($level) and $level > 0) {
 		my $r = $zinc->add('Rectangle', $topgroup,
 				   [$bbox[0] - 10, $bbox[1] - 10,
 				    $bbox[2] + 10, $bbox[3] + 10],
@@ -1167,6 +1223,11 @@ sub showbanner {
 # display in a grid the values of most important attributes 
 sub showattributes {
     my ($fm, $items) = @_;
+    unless ($wwidth > 1) {
+        $zinc->update;
+	my $geom = $zinc->geometry =~ /(\d+)x(\d+)+/=~ /(\d+)x(\d+)+/;
+	($wwidth, $wheight) = ($1, $2);
+    }
     my $bgcolor = 'ivory';
     my $i = 1;
     &showbanner($fm, $i++);
@@ -1196,16 +1257,13 @@ sub showattributes {
 		    -command => [\&showgroupattributes, $zinc, $group])
 	    ->grid(-row => $i, -col => 3, -sticky => 'nswe', -ipadx => 5);
 	# priority
-	$fm->Label(-text => scalar $zinc->itemcget($item, -priority),
-		   -relief => 'ridge')
+	&entryoption($fm, $item, $zinc, -priority)
 	    ->grid(-row => $i, -col => 4, -sticky => 'nswe', -ipadx => 5);
 	# sensitiveness
-	$fm->Label(-text => scalar $zinc->itemcget($item, -sensitive),
-		   -relief => 'ridge')
+	&entryoption($fm, $item, $zinc, -sensitive)
 	    ->grid(-row => $i, -col => 5, -sticky => 'nswe', -ipadx => 5);
 	# visibility
-	$fm->Label(-text => scalar $zinc->itemcget($item, -visible),
-		   -relief => 'ridge')
+	&entryoption($fm, $item, $zinc, -visible)
 	    ->grid(-row => $i, -col => 6, -sticky => 'nswe', -ipadx => 5);
 	# coords
 	my @coords = $zinc->coords($item);
@@ -1266,9 +1324,11 @@ sub showattributes {
 	}
 	# bounding box
 	my @bbox = $zinc->bbox($item);
-	$fm->Label(-text => "($bbox[0], $bbox[1]), ($bbox[2], $bbox[3])",
-		   -relief => 'ridge')
+	my $btn = $fm->Button(-text => "($bbox[0], $bbox[1]), ($bbox[2], $bbox[3])")
 	    ->grid(-row => $i, -col => 9, -sticky => 'nswe', -ipadx => 5);
+	$btn->bind('<1>', [\&showbbox, $zinc, $item]);
+	$btn->bind('<ButtonRelease-1>', [\&hidebbox, $zinc]) ;
+
 	# tags
   	my @tags = $zinc->gettags($item);
 	$fm->Label(-text => join("\n", @tags),
@@ -1339,7 +1399,7 @@ sub showErrorWhilePrinting {
 
 #---------------------------------------------------------------------------
 #
-# HELP FUNCTION
+# HELP FUNCTIONS
 #
 #---------------------------------------------------------------------------
 # display complete help screen
@@ -1417,48 +1477,6 @@ sub showgeneralhelp {
 } # end showgeneralhelp
 
 
-sub showgeneralhelp_old {
-    my $text;
-    if ($enclosedModBtn) {
-	my $eseq = $enclosedModBtn->[0]."-Button".$enclosedModBtn->[1];
-	my $oseq = $overlapModBtn->[0]."-Button".$overlapModBtn->[1];
-	$text .= "With <".$oseq."> sequence, create ".
-	         "a rectangular area to search items ".
-		 "which overlap it.\n".
-		 "With <".$eseq."> sequence, create ".
-		 "a rectangular area to search items ".
-	         "which are enclosed in it.\n".
-		 "With <".$searchKey."> sequence, search a specific ".
-		 "item id using an entry field.\n\n";
-    }
-    if ($treeKey) {
-	my $tseq = $treeModBtn->[0]."-Button".$treeModBtn->[1];
-	$text .= "With <".$treeKey."> sequence, you build and display ".
-	         "the items tree.\n".
-		 "With <".$tseq."> sequence, select a particular item ".
-		 "in the application window and see its position in the".
-	         "tree.\n\n";
-    }
-    if ($snapKey) {
-	$text .= "With <".$snapKey."> sequence you can acquire " .
-	         "a snapshot of the full zinc window. ".
-		 "It will be saved in the current directory ".
-		 "with the name zincsnapshot<n>.png ".
-		 "The ImageMagic package must be installed.\n\n";
-    }
-    $text .= "Strike <Escape> key to display this help message again.";
-    
-    $help_tl->destroy if $help_tl and Tk::Exists($help_tl);
-    $help_tl = $zinc->Dialog(-title => 'Zinc Debug info',
-			     -text => $text,
-			     -bitmap => 'info',
-			     );
-    $help_tl->after(300, sub {$help_tl->grabRelease});
-    $help_tl->Show();
-
-} # end showgeneralhelp
-
-
 # display help about tree
 sub showHelpAboutTree {
     $helptree_tl->destroy if $helptree_tl and Tk::Exists($helptree_tl);
@@ -1515,14 +1533,26 @@ sub showHelpAboutAttributes {
 				  -foreground => 'gray10',
 				  );
     $text->tagConfigure('keyword', -foreground => 'darkblue');
+    $text->tagConfigure('title', -foreground => 'ivory',
+			-background => 'gray60');
 
     
+    $text->insert('end', " To highlight a specific item\n", 'title');
     $text->insert('end',
-		  "First column contains items identifiers buttons you can press to ".
+		  "\nFirst column contains items identifiers buttons you can press to ".
 		  "highlight corresponding items in the application.\n");
     &infoAboutHighlighting($text);
     $text->insert('end', "\n\nThird column contains groups identifiers buttons you can ".
-		  "press to display groups content and attributes.");
+		  "press to display groups content and attributes.\n\n");
+    $text->insert('end', " To display the bounding box of an item\n", 'title');
+    $text->insert('end', "\nUse the buttons of the column labeled ".
+		  "'Bounding Box'.\n\n");
+    $text->insert('end', " To change the value of attributes\n", 'title');
+    $text->insert('end', "\nMost of information fields are editable. A simple ".
+		  "colored feedback shows which attributes have changed. Use <");
+    $text->insert('end', "Control-z", "keyword");
+    $text->insert('end', "> sequence to restore the initial value\n");
+
     $text->configure(-state => 'disabled');
     
     $helptree_tl->Button(-command => sub {$helptree_tl->destroy},
@@ -1550,6 +1580,61 @@ sub infoAboutHighlighting {
 } # end infoAboutHighlighting
 
 
+#---------------------------------------------------------------------------
+#
+# EDITION FUNCTION
+#
+#---------------------------------------------------------------------------
+sub entryoption {
+    my ($fm, $item, $zinc, $option) = @_;
+    my $def = $zinc->itemcget($item, $option);
+    my $i0;
+    my $e;
+    if ($def =~ /\n/) {
+	$e = $fm->Text(-height => 1, -width => 1, -wrap => 'word');
+	$i0 = '0.0';
+    } else {
+	$e = $fm->Entry();
+	$i0 = 0;
+    }
+    my $len = length($def);
+    $len = 50 if $len > 50;
+    $e->configure(-width => $len);
+    if ($defaultoptions{$item}->{$option} and
+	$def ne $defaultoptions{$item}->{$option}) {
+	$e->configure(-foreground => 'blue');
+    }
+    
+    $e->insert($i0, $def);
+    $e->bind('<Control-z>', sub {
+	return unless $defaultoptions{$item}->{$option};
+	my $bg = $e->cget(-background);
+	$zinc->itemconfigure($item, $option => $defaultoptions{$item}->{$option});
+	$e->delete($i0, 'end');
+	$e->insert($i0, $defaultoptions{$item}->{$option});
+	$e->configure(-background => 'ivory');
+	$e->after(80, sub {$e->configure(-background => $bg, -foreground => 'black')});
+    });
+    $e->bind('<Key-Return>',
+	     sub {my $val = $e->get;
+		  my $bg = $e->cget(-background);
+		  $e->configure(-background => 'ivory');
+		  if ($def ne $val) {
+		      $defaultoptions{$item}->{$option} = $def
+			  unless $defaultoptions{$item}->{$option};
+		  }
+		  my $fg = ($val ne $defaultoptions{$item}->{$option}) ?
+		      'blue' : 'black';
+		  $e->after(80, sub {
+		      $e->configure(-background => $bg, -foreground => $fg);
+		  });
+		  $zinc->itemconfigure($item, $option => $val);
+	      });
+
+    return $e;
+
+} # end entryoption
+
 
 1;
 
@@ -1588,7 +1673,7 @@ B<zincdebug()> function invokes all the previous specific functions with default
     
 Press B<Escape> key in the main window of the application to have some help about available input sequences.
 
-If you load ZincDebug using the -M perl option, nothing needs to be added to your code. In this mode, all the previous specific functions are invoked with default options.
+B<If you load ZincDebug using the -M perl option, nothing needs to be added to your code>. In this mode, all the previous specific functions are invoked with default options.
 
 
 =head1 FUNCTIONS