Dans la fenetre Attribut, il est possible de visualiser l'ensemble des

coordonn�es d'un item, eventuellement multi-contour.
Correction d'un bug concernant le clonage d'un item Curve multi-contour.

1 files changed, 151 insertions, 9 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 0c915b5..49b0835 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -23,6 +23,8 @@ use Tk::Tree;
 @EXPORT = qw(finditems snapshot tree);
 
 my ($help_tl0, $help_tl, $result_tl, $result_fm, $search_tl, $showitemflag);
+my $coords_tl;
+my $devicecoords_tl;
 my ($text_id, $rectangle_id);
 my ($x0, $y0);
 my ($help_print, $imagecounter, $saving) = (0,0);
@@ -401,7 +403,6 @@ sub searchentry {
 
 # test and set $zinc variable
 sub setwidget {
-    
     my $widget = shift;
     if ($zinc) {
 	if ($zinc ne $widget) {
@@ -457,7 +458,6 @@ sub compatseq {
 # display in a toplevel the result of search ; a new toplevel destroyes the
 # previous one
 sub showresult {
-    print "*** showresult\n";
     my ($label, $zinc, @items) = @_;
     # toplevel (re-)creation
     $result_tl->destroy if Tk::Exists($result_tl);
@@ -497,6 +497,7 @@ sub showotheroptions {
     my $tl = $zinc->Toplevel;
     my $title = "Other options of item $item";
     $tl->title($title);
+    my $background = $tl->cget(-background);
     my $fm = $tl->LabFrame(-labelside => 'acrosstop',
 			   -label => $title,
 			   )->pack(-padx => 10, -pady => 10,
@@ -511,10 +512,15 @@ sub showotheroptions {
     my @options = $zinc->itemconfigure($item);
     my $i = 2;
     for my $elem (@options) {
-	my ($option, $value) = (@$elem)[0,4];
+	my ($option, $type, $value) = (@$elem)[0,1,4];
+	#print "option=$option type=$type\n";
 	next if ($option eq '-visible' or $option eq '-sensitive' or
 		 $option eq '-tags' or $option eq '-position' or
 		 $option eq '-priority');
+	if ($type eq 'gradient') {
+	    my ($gradient) = $zinc->gname($value);
+	    #print "value=$value gradient=$gradient\n";
+	}
 	$fm->Label(-text => $option, -relief => 'ridge')
 	    ->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
 	$fm->Label(-text => $value, -relief => 'ridge')
@@ -527,6 +533,91 @@ sub showotheroptions {
 } # end showotheroptions
 
 
+sub showdevicecoords {
+    my ($zinc, $item) = @_;
+    &showcoords($zinc, $item, 1);
+
+}
+
+
+sub showcoords {
+    my ($zinc, $item, $deviceflag) = @_;
+    my $bgcolor = 'ivory';
+    $coords_tl->destroy if Tk::Exists($coords_tl);
+    $coords_tl = $zinc->Toplevel();
+    my $title = "Zinc Debug";
+    if ($deviceflag) {
+	$title .= " - Coords of item $item";
+    } else {
+	$title .= " - Device coords of item $item";
+    }
+    $coords_tl->title($title);
+    $coords_tl->geometry('+10+20');
+    $coords_tl->Button(-text => 'Close',
+		       -command => sub {
+			   $coords_tl->destroy;
+		       })->pack(-side => 'bottom');
+    # scrolled pane creation
+    my $heightmax = 500;
+    my $height = 100 + 50;
+    $height = $heightmax if $height > $heightmax;
+    my $coords_fm = $coords_tl->Scrolled('Pane',
+				      -scrollbars => 'se',
+				      -width => scalar $coords_tl->screenwidth,
+				      -height => $height,
+				      );
+    $coords_fm->pack(-padx => 10, -pady => 10,
+		     -ipadx => 10,
+		     -fill => 'both',
+		     -expand => 1,
+		     );
+    my @contour;
+    my $i = 0;
+    while ( 1 ) {
+	my @coords;
+	eval '@coords = $zinc->coords($item, $i)';
+	last unless  @coords;
+	if ($deviceflag) {
+	    @coords = $zinc->transform(scalar $zinc->group($item), 1,
+				       [@coords]);
+	}
+	for (my $j=0; $j < @coords; $j += 2) {
+	    push(@{$contour[$i]}, [$coords[$j], $coords[$j+1]]);
+	}
+	$i++;
+    }
+    my $row = 1;
+    my $col = 1;
+    for (my $i=0; $i < @contour; $i++) {
+	$col = 1;
+	$coords_fm->Label(-text => "Contour $i",
+			  -background => $bgcolor,
+			  -relief => 'ridge')->grid(-row => $row,
+						    -col => $col++,
+						    -ipadx => 5,
+						    -ipady => 5,
+						    -sticky => 'nswe');
+	for my $coords (@{$contour[$i]}) {
+	    if ($col > 10) {
+		$col = 2;
+		$row++;
+	    }
+	    $coords->[0] =~ s/\.(\d\d).*/\.$1/;
+	    $coords->[1] =~ s/\.(\d\d).*/\.$1/;
+	    $coords_fm->Label(-text => sprintf('%s, %s', $coords->[0], $coords->[1]),
+			      -width => 15,
+			      -relief => 'ridge')->grid(-row => $row,
+							-ipadx => 5,
+							-ipady => 5,
+							-col => $col++,
+							-sticky => 'nswe');
+	}
+	$row++;
+    }
+
+} # end showcoords
+
+
 # display in a toplevel group's attributes
 sub showgroupattributes {
     my ($zinc, $item) = @_;
@@ -703,6 +794,8 @@ sub highlightitem {
 } # end highlightitem
 
 
+
+# draw a rectangle arround the selected item
 sub surrounditem {
     my ($zinc, $item) = @_;
     $zinc->remove("zincdebug");
@@ -724,11 +817,13 @@ sub surrounditem {
     }
     # cloning
     my $clone = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']);
-    # move in group 1 
+    # move in topgroup  
     $zinc->chggroup($clone, $topgroup);
-    $zinc->coords($clone, [@coords]);
     # create a rectangle around 
+    my @bbox1  = $zinc->bbox($item);
     my @bbox  = $zinc->bbox($clone);
+    my @c = $zinc->coords($clone);
+    #print "clone_id=$clone | bbox_item=@bbox1 | bbox_clone=@bbox | coords_clone=@c | clone_type=", $zinc->type($clone) ,"\n";
     if (scalar @bbox == 4) {
 	@bbox = $zinc->transform(1, $topgroup, [@bbox]);
 	my $i = 0;
@@ -748,6 +843,41 @@ sub surrounditem {
 } # end surrounditem
 
 
+# not used
+# draw a rectangle arround the selected item
+# without cloning all the hierarchy
+sub surrounditem2 {
+    my ($zinc, $item) = @_;
+    $zinc->remove("zincdebug");
+    my @coords = $zinc->coords($item);
+    # cloning
+    my $clone = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']);
+    # move in group 1, with transformation adjustment
+    my $topgroup = 1;
+    $zinc->chggroup($clone, $topgroup, 1);
+    # create a rectangle around 
+    my @bbox1  = $zinc->bbox($item);
+    my @bbox  = $zinc->bbox($clone);
+    my @c = $zinc->coords($clone);
+    if (scalar @bbox == 4) {
+	@bbox = $zinc->transform(1, $topgroup, [@bbox]);
+	my $i = 0;
+	for ('white', 'red', 'white') {
+	    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++;
+	}
+    }
+    # raise
+    $zinc->raise('zincdebug');
+
+} # end surrounditem2
+
+
 
 sub undohighlightitem {
     my ($btn, $zinc, $items2delete, $group, $visibility) = @_;
@@ -882,8 +1012,14 @@ sub showattributes {
 	    my $n = @coords/2 - 1;
 	    $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
 	}
-	$fm->Label(-text => $coords, -relief => 'ridge')
-	    ->grid(-row => $i, -col => 7, -sticky => 'nswe', -ipadx => 5);
+	if ($type eq 'curve' and @coords > 4) {
+	    $fm->Button(-text => $coords,
+			-command => [\&showcoords, $zinc, $item])
+		->grid(-row => $i, -col => 7, -sticky => 'nswe', -ipadx => 5);
+	} else {
+	    $fm->Label(-text => $coords, -relief => 'ridge')
+		->grid(-row => $i, -col => 7, -sticky => 'nswe', -ipadx => 5);
+	}
 	# device coords
 	@coords = $zinc->transform(scalar $zinc->group($item), 1, [@coords]);
 	if (@coords == 2) {
@@ -904,8 +1040,14 @@ sub showattributes {
 	    my $n = @coords/2 - 1;
 	    $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
 	}
-	$fm->Label(-text => $coords, -relief => 'ridge')
-	    ->grid(-row => $i, -col => 8, -sticky => 'nswe', -ipadx => 5);
+	if ($type eq 'curve' and @coords > 4) {
+	    $fm->Button(-text => $coords,
+			-command => [\&showdevicecoords, $zinc, $item])
+		->grid(-row => $i, -col => 8, -sticky => 'nswe', -ipadx => 5);
+	} else {
+	    $fm->Label(-text => $coords, -relief => 'ridge')
+		->grid(-row => $i, -col => 8, -sticky => 'nswe', -ipadx => 5);
+	}
 	# bounding box
 	my @bbox = $zinc->bbox($item);
 	$fm->Label(-text => "($bbox[0], $bbox[1]), ($bbox[2], $bbox[3])",