* &showattributes

  utilisation de ->contour pour connaitre le nombre de contour;
    cela �vite un eval avec test des erreurs
  traitement des types de points (point de controle... de curve)
    � l'affichage de toutes les coordonn�es
* &showcoords
  affichage du type de point
* &showgroupattributes :
  utilisation de coords plutot que coords0, inutile pour les
    coordonn�es d'un groupe.
  A priori, il y a du code inutile (faire une recherche de
    "we should not go through this case")
  l'option -clip semble valoir "" avec le nouveau zinc
* &surrounditem
  suppression d'une ligne inutile
* &surrounditem
  utilisation de coords plutot que coords0, inutile pour les
    coordonn�es d'un groupe.

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,