segment labelling work-in-progress - yet to do are labels and graph colouring

[trains.git] / layout / layout

diff --git a/layout/layout b/layout/layout
index d47a57c9b6f068e636f4cca5e02febc34c4124d8..c8df20a3c5cf69d0cface18d9f424afecad0c696 100755 (executable)
--- 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);