From 6e508fd3534c921677aaa3c0ac5a8dccf28d0b57 Mon Sep 17 00:00:00 2001
From: etienne
Date: Tue, 30 Jul 2002 15:25:00 +0000
Subject: Prise en compte des transformations des ancetres d'un item pour un
 clonage "parfait" lors de la mise en evidence d'un item. L'encadr� subit
 egalement les transformations.

---
 Perl/Zinc/Debug.pm | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

(limited to 'Perl')

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index a4fbde5..0c915b5 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -116,6 +116,7 @@ sub finditems {
     #
     $zinc->toplevel->Tk::bind('<'.$searchKey.'>', \&searchentry);
 
+    
 } # end finditems
 
 
@@ -702,29 +703,42 @@ sub highlightitem {
 } # end highlightitem
 
 
-
 sub surrounditem {
     my ($zinc, $item) = @_;
     $zinc->remove("zincdebug");
     my @coords = $zinc->coords($item);
+    # get item ancestors
+    my @itemancestors = reverse($zinc->find('ancestors', $item));
+    # skip group 1
+    shift(@itemancestors);
+    # create item's tree with good transformations
+    my $topgroup = 1;
+    for my $g (@itemancestors) {
+	my $gc = $zinc->add('group', $topgroup, -tags => ['zincdebug']);
+	$zinc->tsave($g, "mytrans");
+	my @c = $zinc->coords($g);
+	$zinc->trestore($gc, "mytrans");
+	$zinc->coords($gc, [@c]);
+	$zinc->tdelete("mytrans");
+	$topgroup = $gc;
+    }
     # cloning
     my $clone = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']);
     # move in group 1 
-    $zinc->chggroup($clone, 1);
-    $zinc->coords($clone, [$zinc->transform(scalar $zinc->group($item), 1, [@coords])]);
-    # apply transformation
-    #$zinc->tsave($item, "trans");
-    ##$zinc->trestore($clone, "trans");
+    $zinc->chggroup($clone, $topgroup);
+    $zinc->coords($clone, [@coords]);
     # create a rectangle around 
     my @bbox  = $zinc->bbox($clone);
     if (scalar @bbox == 4) {
+	@bbox = $zinc->transform(1, $topgroup, [@bbox]);
 	my $i = 0;
 	for ('white', 'red', '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 => ['zincdebug']);
+	    my $r = $zinc->add('rectangle', $topgroup,
+			       [$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++;
 	}
     }
-- 
cgit v1.1