passage aux gradients nouvzaux (>> 3.2.6h)

1 files changed, 95 insertions, 2 deletions

diff --git a/Perl/t/test-methods.pl b/Perl/t/test-methods.pl
index 0573289..88a0d10 100644
--- a/Perl/t/test-methods.pl
+++ b/Perl/t/test-methods.pl
@@ -18,7 +18,7 @@ my @testsList = (
 		 2 => 'test_forbidden_operations_on_root_group (quick)',
 		 3 => 'test_errors (quick)',
 		 4 => 'test_bboxes (quick)',
-#		 5 => 'test_coords (quick)',
+		 5 => 'test_gradient_coding (quick)',
 		 );
 my %testsHash;
 { my @tests = @testsList;
@@ -111,6 +111,82 @@ my $zinc = $mw->Zinc(-width => 500, -height => 500,
 
 &setZincLog($zinc);
 
+sub test_gradient_coding {
+    &log (0, "#----  Start of test_gradient_coding ----\n");
+    my $log_level = 2 ;
+    ### CM to be done!
+
+    ### first testing legal gradient
+    foreach (0..2) {
+	my $i=0;
+	foreach my $g ("red", "bLue","#ff00ff","rgb:12/34/56","CIEXYZ:1.2/0.9/3.4",
+		       "CIEuvY:0.5/.4/0.9", "CIExyY:.52/0.1/0.8", "CIELab:99.1/43./56.1",
+		       "CIELuv:88/-1/-2.1", "TekHVC:345/1.2/100",
+		       ) {
+	    ## first simple color, with different X legal coding
+	    &test_eval ($log_level, "gname", $g,"grad".$i);
+	    $i++;
+	    ## the same color with transparency
+	    my $transparency = ($i * 4) % 101;
+	    &test_eval ($log_level, "gname", "$g;$transparency","grad".$i);
+	    $i++;	
+	}
+
+	## different axial gradient without the gradient type at the beginning
+	foreach my $g ("red|blue", "red |blue", "red | blue",
+		       "red|green|blue", "red |green|blue", "red |green |blue", "red | green|blue"
+		       , "red |green| blue", "red |green | blue", "red | green | blue") {
+	    ## first simple color, with different X legal coding
+	    &test_eval ($log_level, "gname", $g,"grad".$i);
+	    $i++;
+	}
+	## different axial gradient with explicit gradient type at the beginning
+	## and different angle value!
+	foreach my $angle qw(0 12 90 271 360) {
+	    foreach my $g ("=axial $angle |red|blue",
+			   "=axial $angle | red|blue",
+			   "=axial $angle | red |blue",
+			   "=axial $angle | red | blue",
+			   "=axial $angle | red|green|blue",
+			   "=axial $angle |red |green|blue",
+			   "=axial $angle |red |green |blue",
+			   "=axial $angle |red | green|blue",
+			   "red |green| blue",
+			   "red |green | blue",
+			   "red | green | blue",
+			   ) {
+		## first simple color, with different X legal coding
+		&test_eval ($log_level, "gname", $g,"grad".$i);
+		$i++;
+	    }
+	}
+	# and now deleting unused named gradient
+	foreach my $j (0..$i-1) {
+	    &test_eval ($log_level, "gdelete", "grad".$j);
+	}
+    }
+
+    ### and now testing illegal gradient
+    my $i=-1;
+    &test_no_eval ("X color name with blank inside",
+		   $log_level, "gname", "navy blue","grad".$i++);
+    &test_no_eval ("bad gradient type",
+		   $log_level, "gname", "=badtype 1 |red|blue","grad".$i++);
+    &test_no_eval ("axial gradient with excessive parameters",
+		   $log_level, "gname", "=axial 67 1 |red|blue","grad".$i++);
+    &test_no_eval ("radial gradient with excessive parameters",
+		   $log_level, "gname", "=radial 30 32 1 |red|blue","grad".$i++);
+    &test_no_eval ("path gradient with excessive parameters",
+		   $log_level, "gname", "=path 30 32 1 |red|blue","grad".$i++);
+    ## testing bad types for gradient type
+    # to be done
+    foreach my $j (0..$i-1) {
+	&test_eval ($log_level, "gdelete", "grad".$j);
+    }
+    
+    &log (0, "#----  End of test_gradient_coding  -----\n");
+} # end of test_gradient_coding
+    
 ## TkZinc bbox method doesn't return correct values for bbox. This test
 # function tries to find out in which cases these bbox are wrong
 sub test_bboxes {
@@ -311,6 +387,19 @@ sub test_errors {
 
     &creating_items;
 
+    ## add method with bad argument
+    # In a curve, it is an error to have more than two succcessive control points
+    # or to start or finish a curve with a control point.
+    &test_no_eval ("having more than two succcessive control points",
+		   $log_level, "add", 'curve', 1,
+		   [ [10,20], [30,40,'c'], [50,60,'c'], [70,80,'c'], [90,100] ]);
+    &test_no_eval ("starting a curve with a control point",
+		   $log_level, "add", 'curve', 1,
+		   [ [30,40,'c'], [50,60], [70,80], [90,100] ]);
+    &test_no_eval ("finishing a curve with a control point",
+		   $log_level, "add", 'curve', 1,
+		   [ [30,40,], [50,60,'c'], [70,80], [90,100,'c'] ]);
+    
     # Text indices
     # sel.first Refers to the first character of the selection in the item.
     # If the selection is not in the item, this form returns an error.
@@ -447,7 +536,7 @@ sub creating_items {
     $zinc->add('arc', 1, [10,10 , 50,50], -tags => ['arc']);
     $zinc->add('curve', 1, [30,0 , 150,10, 100,110, 10,100, 50,140], -tags => ['curve']);
     $zinc->add('triangles', 1, [200,200 , 300,200 , 300,300, 200,300],
-		-colors => ["blue:50", "red:20", "green:80"], -tags => ['triangles']);
+		-colors => ["blue;50", "red;20", "green;80"], -tags => ['triangles']);
     $zinc->add('window', 1, -tags => ['window']);
     foreach my $tag qw(group track waypoint tabular text icon reticle map
 			rectangle arc curve triangles window) {
@@ -566,6 +655,10 @@ if ($tests{4}) {
     &test_bboxes;
 }
 
+if ($tests{5}) {
+    &test_gradient_coding;
+}
+
 ### we should also test multicontour curves
 if ($tests{5}) {
 #    &test_coords;