diff options
| -rw-r--r-- | Perl/Zinc/Debug.pm | 36 |
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++; } } |