aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
authoretienne2002-07-30 15:25:00 +0000
committeretienne2002-07-30 15:25:00 +0000
commit6e508fd3534c921677aaa3c0ac5a8dccf28d0b57 (patch)
tree3f3838da544ea5a1086a37dd14dea992f17bb261 /Perl
parent00f66d6a9732ca3828f7b47800744f07fc30ad33 (diff)
downloadtkzinc-6e508fd3534c921677aaa3c0ac5a8dccf28d0b57.zip
tkzinc-6e508fd3534c921677aaa3c0ac5a8dccf28d0b57.tar.gz
tkzinc-6e508fd3534c921677aaa3c0ac5a8dccf28d0b57.tar.bz2
tkzinc-6e508fd3534c921677aaa3c0ac5a8dccf28d0b57.tar.xz
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.
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm36
1 files changed, 25 insertions, 11 deletions
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++;
}
}