aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm74
1 files changed, 44 insertions, 30 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 244e6dd..4dbcc1b 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -736,19 +736,29 @@ sub showcoords {
-expand => 1,
);
my @contour;
- my $i = 0;
- while ( 1 ) {
- my @coords;
- eval '@coords = $zinc->coords0($item, $i)';
- last unless @coords;
- if ($deviceflag) {
- @coords = $zinc->transform(scalar $zinc->group($item), 1,
- [@coords]);
+ my $contournum = $zinc->contour($item);
+ for (my $i=0; $i < $contournum; $i++) {
+ my @coords = $zinc->coords($item, $i);
+ if (!ref $coords[0]) {
+ ## The first item of the list is not a reference, so the
+ ## list is guarranted to be a flat list (x, y, ...)
+ ## normaly of only one pair of (x y)
+ @coords = $zinc->transform(scalar $zinc->group($item), 1, [@coords])
+ if $deviceflag;
+ for (my $j=0; $j < @coords; $j += 2) {
+ push(@{$contour[$i]}, [$coords[$j], $coords[$j+1]]);
+ }
}
- for (my $j=0; $j < @coords; $j += 2) {
- push(@{$contour[$i]}, [$coords[$j], $coords[$j+1]]);
+ else {
+ ## the first element is an array reference, as every
+ ## other elements of the list
+ for (my $j=0; $j < @coords; $j ++) {
+ my ($x,$y,$type) = @{$coords[$j]};
+ ($x,$y) = $zinc->transform(scalar $zinc->group($item), 1, [$x, $y])
+ if $deviceflag;
+ push(@{$contour[$i]}, [ $x , $y, $type]);
+ }
}
- $i++;
}
my $row = 1;
my $col = 1;
@@ -768,7 +778,8 @@ sub showcoords {
}
$coords->[0] =~ s/\.(\d\d).*/\.$1/;
$coords->[1] =~ s/\.(\d\d).*/\.$1/;
- $coords_fm->Label(-text => sprintf('%s, %s', $coords->[0], $coords->[1]),
+ my $pointtype = (defined $coords->[2]) ? " ".$coords->[2] : "";
+ $coords_fm->Label(-text => sprintf('%s, %s%s', $coords->[0], $coords->[1],$pointtype),
-width => 15,
-relief => 'ridge')->grid(-row => $row,
-ipadx => 5,
@@ -814,7 +825,7 @@ sub showgroupattributes {
-columnspan => 2); # coords
$fm->Label(-text => 'Coords', -relief => 'ridge')
->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
- my @coords = $zinc->coords0($item);
+ my @coords = $zinc->coords($item);
my $coords;
if (@coords == 2) {
my $x0 = int($coords[0]);
@@ -826,6 +837,7 @@ sub showgroupattributes {
my $x1 = int($coords[2]);
my $y1 = int($coords[3]);
$coords = "($x0, $y0, $x1, $y1)";
+ print "we should not go through this case (1)!\n";
} else {
my $x0 = int($coords[0]);
my $y0 = int($coords[1]);
@@ -833,6 +845,7 @@ sub showgroupattributes {
my $yn = int($coords[$#coords]);
my $n = @coords/2 - 1;
$coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
+ print "we should not go through this case (2d)!\n";
}
$fm->Label(-text => $coords, -relief => 'ridge')
->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
@@ -850,6 +863,7 @@ sub showgroupattributes {
my $x1 = int($coords[2]);
my $y1 = int($coords[3]);
$coords = "($x0, $y0, $x1, $y1)";
+ print "we should not go through this case (3)!\n";
} else {
my $x0 = int($coords[0]);
my $y0 = int($coords[1]);
@@ -857,6 +871,7 @@ sub showgroupattributes {
my $yn = int($coords[$#coords]);
my $n = @coords/2 - 1;
$coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
+ print "we should not go through this case (4)!\n";
}
$fm->Label(-text => $coords, -relief => 'ridge')
->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
@@ -874,7 +889,7 @@ sub showgroupattributes {
->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
if ($option and $option eq '-tags') {
$value = join("\n", @$value);
- } elsif ($option and $option eq '-clip' and $value > 0) {
+ } elsif ($option and $option eq '-clip' and $value and $value > 0) {
$value .= " (". $zinc->type($value) .")";
}
$fm->Label(-text => $value, -relief => 'ridge')
@@ -1026,7 +1041,6 @@ sub itemisoutside {
sub surrounditem {
my ($zinc, $item, $level) = @_;
$zinc->remove("zincdebug");
- my @coords = $zinc->coords0($item);
# get item ancestors
my @itemancestors = reverse($zinc->find('ancestors', $item));
# skip group 1
@@ -1036,7 +1050,7 @@ sub surrounditem {
for my $g (@itemancestors) {
my $gc = $zinc->add('group', $topgroup, -tags => ['zincdebug']);
$zinc->tsave($g, "mytrans");
- my @c = $zinc->coords0($g);
+ my @c = $zinc->coords($g);
$zinc->trestore($gc, "mytrans");
$zinc->coords($gc, [@c]);
$zinc->tdelete("mytrans");
@@ -1164,25 +1178,25 @@ sub showattributes {
-relief => 'ridge')
->grid(-row => $i, -col => 6, -sticky => 'nswe', -ipadx => 5);
# coords
- my @coords = $zinc->coords0($item);
+ my @coords = $zinc->coords($item);
my $coords;
- if (@coords == 2) {
+ if (!ref $coords[0]) {
my $x0 = int($coords[0]);
my $y0 = int($coords[1]);
$coords = "($x0, $y0)";
- } elsif (@coords == 4) {
- my $x0 = int($coords[0]);
- my $y0 = int($coords[1]);
- my $x1 = int($coords[2]);
- my $y1 = int($coords[3]);
- $coords = "($x0, $y0, $x1, $y1)";
} else {
- my $x0 = int($coords[0]);
- my $y0 = int($coords[1]);
- my $xn = int($coords[$#coords-1]);
- my $yn = int($coords[$#coords]);
- my $n = @coords/2 - 1;
- $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
+ my @points0 = @{$coords[0]};
+ my $n = $#coords;
+ my @pointsN = @{$coords[$n]};
+ my $x0 = int($points0[0]);
+ my $y0 = int($points0[1]);
+ my $xn = int($pointsN[0]);
+ my $yn = int($pointsN[1]);
+ if ($n == 1) { ## a couple of points
+ $coords = "($x0, $y0, $xn, $yn)";
+ } else {
+ $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
+ }
}
if ($type eq 'curve' and @coords > 4) {
$fm->Button(-text => $coords,