X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=blobdiff_plain;f=layout%2Flayout;h=c8df20a3c5cf69d0cface18d9f424afecad0c696;hb=8ea6aa74d86a71b7d53a5ddfd9cb956a5a0d96ac;hp=d47a57c9b6f068e636f4cca5e02febc34c4124d8;hpb=d2634ca20935e39ec619196b49a1a49c612e8cd0;p=trains.git

diff --git a/layout/layout b/layout/layout
index d47a57c..c8df20a 100755
--- a/layout/layout
+++ b/layout/layout
@@ -28,8 +28,9 @@ our @eopts;
 our @segments= ('/');
 our @ident_strings= ();
 our %subsegcmap;
+our %segcmap;
 
-our $drawers= 'arscldmnog';
+our $drawers= 'arqscldmnog';
 our %chdraw_emap= qw(A ARScgd
 		     R aRscgD
 		     S aRScgd
@@ -166,6 +167,7 @@ our $psu_thinlw= 1.0;
 our %psu_subseglw;
 $psu_subseglw{'e'}= 20.0;
 $psu_subseglw{'m'}= 15.0;
+$psu_subseglw{'q'}= 20.0;
 
 our $lmu_marklw= 4;
 our $lmu_marktpt= 11;
@@ -701,7 +703,7 @@ sub parametric_segment ($$$$$) {
     # $calcfn is invoked with $param set and should return a loc
     # (ie, ref to X =>, Y =>, A =>).
     my ($pa,$pb,@ends,$side,$ppu,$e,$v,$tick,$draw,$allwidth);
-    return unless $ctx->{Draw} =~ m/[ARSCG]/;
+    return unless $ctx->{Draw} =~ m/[ARSCGQ]/;
     $ppu= $psu_ulen/$lenperp;
     $allwidth= allwidth($minradius);
     my ($railctr)=($psu_gauge + $psu_raillw)*0.5;
@@ -711,11 +713,12 @@ sub parametric_segment ($$$$$) {
     my ($sleeperend)=($psu_sleeperlen*0.5);
 print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     $draw= current_draw();
-    if ($draw =~ m/G/) {
+    if ($draw =~ m/[QG]/) {
 	my ($pt,$going,$red,$csegbare,$movfeat,$movstroke);
 	my ($used_last,$me,$segsave);
+	o("gsave\n");
 	$segsave= segment_state_save();
-	foreach $me (qw(e m)) {
+	foreach $me ($draw =~ m/Q/ ? qw(q) : qw(e m)) {
 	    segment_state_restore($segsave);
 	    $going=0;
 	    o("% segments @segments\n");
@@ -732,27 +735,37 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
 			$subsegcmap{$csegbare}++;
 		    }
 		} else {
-		    $movfeat= $csegbare =~ s,(/\D+)(\d+)$,$1, ? $2 : 'f';
-		    die "unknown subsegment colour for $csegbare\n"
-			unless exists $subsegcmap{$csegbare};
-		    $red= $pt->{A} / (2*$pi);
-		    $red *= $subsegcmapangscale;
-		    $red += $subsegcmapangscale*2;
-		    $red += $subsegcmapangscale/2 if $segments[0] =~ m/^\-/;
-		    $red %= $subsegcmapangscale;
-		    $red += $subsegcmapangscale if $me eq 'e';
-		    $red= sprintf("%f", $red / 255.0);
-		    $movstroke=
-			("    $red $subsegcmap{$csegbare} setrgbcolor\n".
-			 "    $psu_subseglw{$me} setlinewidth stroke\n");
-		    if ($subsegmovfeatpos ne $movfeat ||
-			($me eq 'e' && $csegbare =~ m,^/,)) {
-			$movstroke= "%     no-stroke\n";
+		    if ($draw =~ m/Q/) {
+			$csegbare =~ m,^[^/]*,;
+#print STDERR "looking for \`$&' $me\n";
+			$movstroke= $segcmap{$&};
+			$movstroke= "%     no-colour    "
+			    unless defined $movstroke;
+		    } elsif ($draw =~ m/G/) {
+			$movfeat= $csegbare =~ s,(/\D+)(\d+)$,$1, ? $2 : 'f';
+			die "unknown subsegment colour for $csegbare\n"
+			    unless exists $subsegcmap{$csegbare};
+			$red= $pt->{A} / (2*$pi);
+			$red *= $subsegcmapangscale;
+			$red += $subsegcmapangscale*2;
+			$red += $subsegcmapangscale/2
+			    if $segments[0] =~ m/^\-/;
+			$red %= $subsegcmapangscale;
+			$red += $subsegcmapangscale if $me eq 'e';
+			$red= sprintf("%f", $red / 255.0);
+			$movstroke= "    $red $subsegcmap{$csegbare}".
+			            " setrgbcolor\n";
+			if ($subsegmovfeatpos ne $movfeat ||
+			    ($me eq 'e' && $csegbare =~ m,^/,)) {
+			    $movstroke= "%     no-stroke    ";
+			}
 		    }
+		    $movstroke .=
+			"    $psu_subseglw{$me} setlinewidth stroke\n";
 		}
 		o_path_begin();
 		parametric__o_pt($pt);
-	
+
 		$param += $ppu;
 		last if $param>=$p1;
 		$pt= &$calcfn;
@@ -767,6 +780,7 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
 	    parametric__o_pt($pt);
 	    o($movstroke);
 	}
+	o("grestore\n");
     }
     if ($draw =~ m/C/) {
 	my ($pt);
@@ -1233,6 +1247,12 @@ sub cmd__runobj ($) {
     }
 }
 
+sub cva_segment ($) {
+    my ($sp)=@_;
+    die "invalid segment" if $sp =~ m/[^0-9A-Za-z_]/;
+    return $sp;
+}
+
 sub cva_subsegspec ($) {
     my ($sp)=@_;
     die "invalid subsegment spec" unless
@@ -1314,6 +1334,17 @@ sub cmd_segmap {
     }
 }
 
+sub cmd_segend {
+    @al=();
+};
+
+sub cmd_segcmap {
+    my ($seg,$colour);
+    $seg= can(\&cva_segment);
+    $segcmap{$seg}= "@al";
+    @al= ();
+};
+
 sub layer_draw ($$) {
     my ($k,$l) = @_;
     my ($eo,$cc, $r);