Contours of curves can be displayed and explored.

1 files changed, 240 insertions, 20 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 271dcd3..49d1f1a 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -30,7 +30,7 @@ use Tk::FBox;
 
 my ($itemstyle, $groupstyle, $step);
 my (%help_tl, $result_tl, $result_fm, $search_tl, $helptree_tl, $coords_tl,
-    $searchtree_tl, $tree_tl, $tree, $transfo_tl);
+    $helpcoords_tl, $searchtree_tl, $tree_tl, $tree, $transfo_tl);
 my $showitemflag;
 my ($x0, $y0);
 my ($help_print, $imagecounter, $saving) = (0, 0, 0);
@@ -1055,10 +1055,15 @@ sub showcoords {
     }
     $coords_tl->title($title);
     $coords_tl->geometry('+10+20');
-    $coords_tl->Button(-text => 'Close',
-		       -command => sub {
-			   $coords_tl->destroy;
-		       })->pack(-side => 'bottom');
+    my $coords_fm0 = $coords_tl->Frame()->pack(-side => 'bottom');
+    $coords_fm0->Button(-text => 'Help',
+			-command => [\&showHelpAboutCoords, $zinc]
+			)->pack(-side => 'left', -padx => 40, -pady => 10);
+    $coords_fm0->Button(-text => 'Close',
+			-command => sub {
+			    &hidecontour($zinc);
+			    $coords_tl->destroy;
+			})->pack(-side => 'left', -padx => 40, -pady => 10);
     # scrolled pane creation
     my $coords_fm = $coords_tl->Scrolled('Pane',
 					 -scrollbars => 'oe',
@@ -1096,13 +1101,42 @@ sub showcoords {
     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');
+	my $lab = $coords_fm->Label(-text => "Contour $i",
+				    -background => $bgcolor,
+				    -relief => 'ridge')->grid(-row => $row,
+							      -col => $col,
+							      -ipadx => 5,
+							      -ipady => 5,
+							      -sticky => 'nswe');
+	$lab->bind('<1>', [\&showcontour, $zinc, 'black', $item, $contour[$i],
+			   $deviceflag]);
+	$lab->bind('<2>', [\&showcontour, $zinc, 'white', $item, $contour[$i],
+			   $deviceflag]);
+	$lab->bind('<3>', [\&showcontour, $zinc, 'red', $item, $contour[$i],
+			   $deviceflag]);
+	$lab->bind('<ButtonRelease-1>', sub { &hidecontour($zinc); });
+	$lab->bind('<ButtonRelease-2>', sub { &hidecontour($zinc); });
+	$lab->bind('<ButtonRelease-3>', sub { &hidecontour($zinc); });
+	if (@{$contour[$i]} >= 10) {
+	    my $lab1 = $coords_fm->Label(-text => scalar(@{$contour[$i]})." points",
+					 -background => $bgcolor,
+					 -relief => 'ridge')->grid(-row => $row+1,
+								   -col => $col,
+								   -ipadx => 5,
+								   -ipady => 5,
+								   -sticky => 'nswe');
+	    $lab1->bind('<1>', [\&showcontourpts, $zinc, 'black', $item, $contour[$i],
+				$deviceflag]);
+	    $lab1->bind('<2>', [\&showcontourpts, $zinc, 'white', $item, $contour[$i],
+				$deviceflag]);
+	    $lab1->bind('<3>', [\&showcontourpts, $zinc, 'red', $item, $contour[$i],
+				$deviceflag]);
+	    $lab1->bind('<ButtonRelease-1>', sub { &hidecontour($zinc); });
+	    $lab1->bind('<ButtonRelease-2>', sub { &hidecontour($zinc); });
+	    $lab1->bind('<ButtonRelease-3>', sub { &hidecontour($zinc); });
+	}
+	$col++;
+	my @lab;
 	for my $coords (@{$contour[$i]}) {
 	    if ($col > 10) {
 		$col = 2;
@@ -1118,19 +1152,150 @@ sub showcoords {
 	    } else {
 		@opt = (-text => sprintf('%s, %s', @{$coords}[0,1]));
 	    }
-	    $coords_fm->Label(@opt,
-			      -width => 15,
-			      -relief => 'ridge')->grid(-row => $row,
-							-ipadx => 5,
-							-ipady => 5,
-							-col => $col++,
-							-sticky => 'nswe');
+	    push (@lab, $coords_fm->Label(@opt,
+					  -width => 15,
+					  -relief => 'ridge')->grid(-row => $row,
+								    -ipadx => 5,
+								    -ipady => 5,
+								    -col => $col++,
+								    -sticky => 'nswe'));
 	}
 	$row++;
+	my $j = 0;
+	for (@lab) {
+	    $_->bind('<1>', [\&showcontourpt, $zinc, 'black',
+			     $item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
+	    $_->bind('<2>', [\&showcontourpt, $zinc, 'white',
+			     $item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
+	    $_->bind('<3>', [\&showcontourpt, $zinc, 'red',
+			     $item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
+	    $j++;
+    }
+
     }
 
+
 } # end showcoords
 
+sub showcontour {
+    my ($widget, $zinc, $color, $item, $contourcoords, $deviceflag) = @_;
+    if ($deviceflag) {
+	$zinc->add('curve', 1, $contourcoords,
+		   -filled => 0,
+		   -linecolor => $color,
+		   -tags => ['zincdebugcontour']);
+
+    } else {
+	$zinc->add('curve', 1, [$zinc->transform($item, 1, $contourcoords)],
+		   -filled => 0,
+		   -linecolor => $color,
+		   -tags => ['zincdebugcontour']);
+    }
+    
+} # end showcontour
+
+sub hidecontour {
+    my ($zinc) = @_;
+    $zinc->remove('zincdebugcontour');
+    
+} # end hidecontour
+
+sub showcontourpts {
+    my ($widget, $zinc, $color, $item, $contourcoords, $deviceflag) = @_;
+    my $i = 0;
+    for my $coords (@$contourcoords) {
+	my ($x, $y);
+	if ($deviceflag) {
+	    ($x, $y) = @$coords;
+	} else {
+	    ($x, $y) = $zinc->transform($item, 1, $coords);
+	}
+	if ($i == 0) {
+	    $zinc->add('arc', 1, [$x-10, $y-10, $x+10, $y+10],
+		       -filled => 0,
+		       -linewidth => 1,
+		       -linecolor => $color,
+		       -tags => ['zincdebugcontour']);
+	} elsif ($i == @$contourcoords -1) {
+	    $zinc->add('arc', 1, [$x-10, $y-10, $x+10, $y+10],
+		       -filled => 0,
+		       -linewidth => 1,
+		       -linecolor => $color,
+		       -tags => ['zincdebugcontour']);
+	    $zinc->add('arc', 1, [$x-13, $y-13, $x+13, $y+13],
+		       -filled => 0,
+		       -linewidth => 1,
+		       -linecolor => $color,
+		       -tags => ['zincdebugcontour']);
+	}
+	my $dx = 3;
+	if (@$coords > 2) {
+	    $zinc->add('rectangle', 1, [$x-$dx, $y-$dx, $x+$dx, $y+$dx],
+		       -filled => 0,
+		       -linewidth => 1,
+		       -linecolor => $color,
+		       -tags => ['zincdebugcontour']);
+	} else {
+	    $zinc->add('rectangle', 1, [$x-$dx, $y-$dx, $x+$dx, $y+$dx],
+		       -filled => 1,
+		       -linewidth => 1,
+		       -fillcolor => $color,
+		       -linecolor => $color,
+		       -tags => ['zincdebugcontour']);
+	}
+	$i++;
+    }
+    
+} # end showcontourpts
+
+
+sub showcontourpt {
+    my ($widget, $zinc, $color, $item, $index, $deviceflag, $labels, @contour) = @_;
+    $widget->focus;
+    if ($index < 0 or $index >= @contour) {
+	$widget->bell;
+	return;
+    }
+    &hidecontour($zinc);
+    my $bgcolor = ($labels->[0]->configure(-background))[3];
+    for (@$labels) {
+	$_->configure(-background => $bgcolor);
+    }
+    $labels->[$index]->configure(-background => 'bisque');
+    my @coords = @{$contour[$index]};
+    my ($x, $y);
+    if ($deviceflag) {
+	($x, $y) = @coords;
+    } else {
+	($x, $y) = $zinc->transform($item, 1, [@coords]);
+    }
+    my $dx = 3;
+    if (@coords > 2) {
+	$zinc->add('rectangle', 1, [$x-$dx, $y-$dx, $x+$dx, $y+$dx],
+		   -filled => 0,
+		   -linewidth => 1,
+		   -linecolor => $color,
+		   -tags => ['zincdebugcontour']);
+    } else {
+	$zinc->add('rectangle', 1, [$x-$dx, $y-$dx, $x+$dx, $y+$dx],
+		   -filled => 1,
+		   -linewidth => 1,
+		   -fillcolor => $color,
+		   -linecolor => $color,
+		   -tags => ['zincdebugcontour']);
+    }
+    $widget->bind('<Key-Down>', [\&showcontourpt, $zinc, $color,
+				 $item, $index+1, $deviceflag, $labels, @contour]);
+    $widget->bind('<Key-Right>', [\&showcontourpt, $zinc, $color,
+				 $item, $index+1, $deviceflag, $labels, @contour]);
+    $widget->bind('<Key-Up>', [\&showcontourpt, $zinc, $color,
+				$item, $index-1, $deviceflag, $labels, @contour]);
+    $widget->bind('<Key-Left>', [\&showcontourpt, $zinc, $color,
+				$item, $index-1, $deviceflag, $labels, @contour]);
+
+    
+} # end showcontourpt
+
 
 # display in a toplevel group's attributes
 sub showgroupattributes {
@@ -1927,7 +2092,7 @@ sub showinstancehelp {
 	$text->insert('end', " To generate perl code\n", 'title');
 	$text->insert('end', "\nUse the <");
 	$text->insert('end', $treeKey{$zinc}, 'keyword');
-	$text->insert('end', "> sequence. Then select a branch of the tree ");
+	$text->insert('end', "> sequence to display the item tree. Then select a branch of the tree ");
 	$text->insert('end', "and press on the ");
 	$text->insert('end', "Build code", 'keyword');
 	$text->insert('end', " button.\n\n");
@@ -2101,6 +2266,59 @@ sub showHelpAboutAttributes {
 
 } # end showHelpAboutAttributes
 
+sub showHelpAboutCoords {
+    my $zinc = shift;
+    $helpcoords_tl->destroy if $helpcoords_tl and Tk::Exists($helpcoords_tl);
+    $helpcoords_tl = $zinc->Toplevel;
+    $helpcoords_tl->title("Help about coordinates");
+
+    my $text = $helpcoords_tl->Scrolled('Text',
+				      -font => scalar $zinc->cget(-font),
+				      -wrap => 'word',
+				      -height => 30,
+				      -foreground => 'gray10',
+				      -scrollbars => 'oe',
+				      );
+    $text->tagConfigure('keyword', -foreground => 'darkblue');
+    $text->tagConfigure('title', -foreground => 'ivory',
+			-background => 'gray60',
+			-spacing1 => 3,
+			-spacing3 => 3);
+
+    
+    $text->insert('end', " To display a contour\n", 'title');
+    $text->insert('end', "Press button labeled ");
+    $text->insert('end', 'Contour i', 'keyword');
+    $text->insert('end', " (*). Release it to hide contour.");
+    $text->insert('end', "\n\n");
+    $text->insert('end', " To display all the points of a contour\n", 'title');
+    $text->insert('end', "Press button labeled ");
+    $text->insert('end', 'n points', 'keyword');
+    $text->insert('end', " (*). Release it to hide points. First plot is ".
+		  "particularized by a circle, last one by a double circle. ".
+		  "Non-filled plots represent control points of a Bezier curve.");
+    $text->insert('end', "\n\n");
+    $text->insert('end', " To navigate in the contour\n", 'title');
+    $text->insert('end', "Select first a point by clicking in the coordinates table ");
+    $text->insert('end', "(*). Th corresponding plot is displayed. Then use the ");
+    $text->insert('end', "Up/Down", 'keyword');
+    $text->insert('end', " (or ");
+    $text->insert('end', "Left/Right", 'keyword');
+    $text->insert('end', ") arrows keys to navigate in the contour");
+    $text->insert('end', "\n\n");
+    $text->insert('end', "\n\n");
+    $text->insert('end', "(*) The color of displayed elements depends on the mouse ".
+		  "button you press.");
+    $text->insert('end', "\n\n");
+    $text->configure(-state => 'disabled');
+    
+    $helpcoords_tl->Button(-command => sub {$helpcoords_tl->destroy},
+			 -text => 'Close')->pack(-side => 'bottom',
+						 -pady => 10);
+    $text->pack->pack(-side => 'top', -pady => 10, -padx => 10);
+
+} # end showHelpAboutCoords
+
 
 
 sub infoAboutHighlighting {
@@ -2345,6 +2563,8 @@ Daniel Etienne <etienne@cena.fr>
     
 =head1 HISTORY
 
+Oct 07 2003 : contours of curves can be displayed and explored.
+
 Sep 15 2003 : due to CPAN-isation, the ZincDebug module has been renamed Tk::Zinc::Debug
 
 May 20 2003 : perl code can be generated from the items tree, with some limitations concerning transformations and images.