Correction du trac� de la bbox.

Cr�ation d'un bouton 'treset' pour chaque item; il permet de visualiser
l'item d�barass� de ces transformations. Selon que -render vaut 1 ou 0,
on aura ou non une animation sous forme de fondu enchain� entre les 2
�tats.

1 files changed, 119 insertions, 8 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index b50acf0..f831c58 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -15,8 +15,6 @@ use Carp;
 use English;
 require Exporter;
 use File::Basename;
-use Tk;
-use Tk::Zinc;
 use Tk::LabFrame;
 use Tk::Pane;
 use Tk::Dialog;
@@ -27,9 +25,9 @@ use Tk::ItemStyle;
 @EXPORT = qw(finditems snapshot tree);
 @EXPORT_OK = qw(finditems snapshot tree);
 
-my ($itemstyle, $groupstyle);
+my ($itemstyle, $groupstyle, $step);
 my (%help_tl, $result_tl, $result_fm, $search_tl, $helptree_tl, $coords_tl,
-    $searchtree_tl, $tree_tl, $tree);
+    $searchtree_tl, $tree_tl, $tree, $transfo_tl);
 my $showitemflag;
 my ($x0, $y0);
 my ($help_print, $imagecounter, $saving) = (0, 0, 0);
@@ -53,6 +51,7 @@ my @instances;
 my %cmdoptions;
 my $initobjectfunction;
 
+
 sub BEGIN {
     # test if ZincDebug is loaded using the -M perl option
     $preload = 1 if (caller(2))[2] == 0;
@@ -67,10 +66,13 @@ sub BEGIN {
 	       );
     # save current Tk::Zinc::InitObject function; it will be invoked in
     # overloaded one (see below)
+    use Tk;
+    use Tk::Zinc;
     $initobjectfunction = Tk::Zinc->can('InitObject');
 	
 }
 
+
 # Hack to capture the instance of zinc. ZincDebug functions are invoked here.
 # Note that created bindings might be overloaded by the application.
 sub Tk::Zinc::InitObject {
@@ -103,9 +105,11 @@ sub Tk::Zinc::InitObject {
     push (@options, -verbosity => $cmdoptions{verbosity}) if $cmdoptions{verbosity};
     push (@options, -basename => $cmdoptions{basename}) if $cmdoptions{basename};
     &snapshot($zinc, @options);
+      
 }
 
 
+
 #---------------------------------------------------------------------------
 # tree : display items hierarchy
 #---------------------------------------------------------------------------
@@ -810,6 +814,7 @@ sub showotheroptions {
 } # end showotheroptions
 
 
+
 sub showdevicecoords {
     my ($zinc, $item) = @_;
     &showcoords($zinc, $item, 1);
@@ -934,11 +939,18 @@ sub showgroupattributes {
 		-height => 2,
 		-text => 'Content',
 		)->grid(-row => $r, -col => 1, -sticky => 'nswe');
+    # bounding box
     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]);
+    # transformations
+    my $btn = $fm->Button(-text => "treset")
+	->grid(-row => $r++, -col => 1, -sticky => 'nswe', -columnspan => 2);
+    $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]);
+    $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]);
+    $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]);
 
     # parent group
     $fm->Label(-text => 'Parent group', -relief => 'ridge')
@@ -1068,7 +1080,7 @@ sub showgroupcontent {
   				   -ipadx => 10,
 				   -expand => 1,
   				   -fill => 'both');
-    &showattributes($zinc, $fm, \@items);
+    &showattributes($zinc, $fm, [@items]);
 
 } # end showgroupcontent
 
@@ -1083,10 +1095,8 @@ sub showbbox {
 	    my $i = -2;
 	    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],
 			   [$bbox[0] + $i, $bbox[1] + $i,
-			    $bbox[2] - $i, $bbox[3] + $i],
+			    $bbox[2] - $i, $bbox[3] - $i],
 			   -linecolor => $_,
 			   -linewidth => 1,
 			   -tags => ['zincdebugbbox']);
@@ -1120,6 +1130,19 @@ sub highlightitem {
 
 } # end highlightitem
 
+
+sub showtransfo {
+    my ($btn, $zinc, $item, $level) = @_;
+
+    my $anim = &highlighttransfo($zinc, $item, $level);
+
+    $btn->bind('<ButtonRelease>', [\&undohighlighttransfo, $zinc, $anim]) if $btn;
+
+} # end showtransfo
+
+
+
+
 sub itemisoutside {
     my $zinc = shift;
     my @bbox = @_;
@@ -1207,6 +1230,86 @@ sub itemisoutside {
 } # end itemisoutside
 
 
+sub highlighttransfo {
+    my ($zinc, $item, $level) = @_;
+    $zinc->remove("zincdebug");
+    my $g = $zinc->add('group', 1);
+    my $g0 = $zinc->add('group', $g, -alpha => 0);
+    my $g1 = $zinc->add('group', $g);
+    # clone item and reset its transformation
+    my $clone0 = $zinc->clone($item, -visible => 1, -tags =>['zincdebug']);
+    $zinc->treset($clone0);
+    # clone item and preserve its transformation
+    my $clone1 = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']);
+    # move clones is dedicated group
+    $zinc->chggroup($clone0, $g0, 1);
+    $zinc->chggroup($clone1, $g1, 1);
+    # create a rectangle around 
+    my @bbox0  = $zinc->bbox($g);
+    if (scalar @bbox0 == 4) {
+	my @bbox = $zinc->transform(1, $g, [@bbox0]);
+	# If item is visible, rectangle is drawm surround it.
+	# Else, a warning is displayed.
+	unless (&itemisoutside($zinc, @bbox0)) {
+	    my $r = $zinc->add('Rectangle', $g,
+			       [$bbox[0] - 10, $bbox[1] - 10,
+				$bbox[2] + 10, $bbox[3] + 10],
+			       -filled => 1,
+			       -linewidth => 0,
+			       -tags => ['zincdebug'],
+			       -fillcolor => "gray90");
+	    $zinc->itemconfigure($r, -fillcolor => "gray50") if $level == 1;
+	    $zinc->itemconfigure($r, -fillcolor => "gray20") if $level == 2;
+	    my $i = 0;
+	    for ('white', 'green', 'white') {
+		$zinc->add('rectangle', $g,
+			   [$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i,
+			    $bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i],
+			   -linecolor => $_,
+			   -linewidth => 1,
+			   -tags => ['zincdebug']);
+		$i++;
+	    }
+	}
+    }
+    # raise
+    $zinc->raise('zincdebug');
+    $zinc->raise($clone0);
+    $zinc->raise($clone1);
+    # animation
+    my $anim;
+    if ($zinc->cget(-render) == 0) {
+	$anim = $zinc->after(150, [sub {
+	    $zinc->itemconfigure($g1, -visible => 0);
+	    $zinc->itemconfigure($g0, -visible => 1);
+	}]);
+    } else {
+	my $maxsteps = 5;
+	$step = $maxsteps;
+	$anim = $zinc->repeat(150, [sub {
+	    return if $step < 0;
+	    $zinc->itemconfigure($g1, -alpha => ($step)*100/$maxsteps);
+	    $zinc->itemconfigure($g0, -alpha => ($maxsteps-$step)*100/$maxsteps);
+	    $zinc->update;
+	    $step--;
+	}]);
+
+
+    }
+    return $anim;
+
+} # end highlighttransfo
+
+
+sub undohighlighttransfo {
+    my ($btn, $zinc, $anim) = @_;
+    $btn->bind('ReleaseButton', '');
+    $zinc->remove('zincdebug');
+    $zinc->afterCancel($anim);
+
+} # end undohighlightitem
+
+
 # draw a rectangle arround the selected item
 sub surrounditem {
     my ($zinc, $item, $level) = @_;
@@ -1241,6 +1344,7 @@ sub surrounditem {
 		my $r = $zinc->add('Rectangle', $topgroup,
 				   [$bbox[0] - 10, $bbox[1] - 10,
 				    $bbox[2] + 10, $bbox[3] + 10],
+				   -linewidth => 0,
 				   -filled => 1,
 				   -tags => ['zincdebug'],
 				   -fillcolor => "gray20");
@@ -1317,6 +1421,12 @@ sub showattributes {
     &showbanner($fm, $i++);
     for my $item (@$items) {
 	my $type = $zinc->type($item);
+	# transformations
+	my $btn = $fm->Button(-text => 'treset')
+	    ->grid(-row => $i, -col => 0, -sticky => 'nswe', -ipadx => 5);
+	$btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]);
+	$btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]);
+	$btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]);
 	# id
 	my $idbtn =
 	    $fm->Button(-text => $item,
@@ -1422,6 +1532,7 @@ sub showattributes {
 	$fm->Label(-text => join("\n", @tags),
 		   -relief => 'ridge')
 	    ->grid(-row => $i, -col => 10, -sticky => 'nswe', -ipadx => 5);
+	# other options
 	$fm->Button(-text => 'Other options',
 		    -command => [\&showotheroptions, $zinc, $item, $fm])
 	    ->grid(-row => $i, -col => 11, -sticky => 'nswe', -ipadx => 5);