From: ian <ian>
Date: Fri, 22 Oct 2004 11:07:44 +0000 (+0000)
Subject: signed segments
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=b1a41a94fde3acfd33167a27dc1f38a5342a63b4;p=trains.git

signed segments
---

diff --git a/layout/informat.txt b/layout/informat.txt
index 902a863..5be48f8 100644
--- a/layout/informat.txt
+++ b/layout/informat.txt
@@ -33,9 +33,10 @@ Commands
   Defines loc T: start at loc F, go forward L, translate right R,
   turn left A (defaults are all 0).
 
- segment [K*] [S0 D0 ...] Sn
+ segment [K*] [[-]S0 D0 ...] [-]Sn
   Specifies that arcs and lines in layer kind K are part of subsegment
-  Sn.
+  Sn.  `-' preceding the segment indicates that the Q rail is on the
+  left as the line is drawn; without `-' the T rail is on the left.
 
   If additional Di and Si are provided then each Si apart from the
   last is followed by a distance Di saying how much track it applies
diff --git a/layout/layout b/layout/layout
index c5e43b0..7d58e27 100755
--- a/layout/layout
+++ b/layout/layout
@@ -142,7 +142,7 @@ our $psu_sleeperlen= 17;
 our $psu_sleeperlw= 15;
 our $psu_raillw= 1.0;
 our $psu_thinlw= 1.0;
-our $psu_subseglw= 2.0;
+our $psu_subseglw= 10.0;
 
 our $lmu_marklw= 4;
 our $lmu_marktpt= 11;
@@ -197,6 +197,7 @@ our $allwidthmin= allwidth(undef);
 #                         #   = $drawchrs_we_should_use_due_to_obj_etc
 #  $ctx->{SegName}        # initial segment name (at start of object or file)
 #                         #  or nonexistent if in object in unknown segment
+#                         #  may have leading `-'
 #  $ctx->{SavedSegment}   # exists iff segment command used, is a $csss
 #  $ctx->{Layer}{Level}
 #  $ctx->{Layer}{Kind}
@@ -210,6 +211,7 @@ our $allwidthmin= allwidth(undef);
 #  $eopts[]{DrawMods}     # modifier chars for drawing
 #
 #  @segments= ( $csss0, $dist0, $csss1, $dist1, ..., $csssn )
+#                         # here each csss may have preceding `-'
 #
 #  $subsegcmap{$csss} = "$green $blue"
 #                         # $csss is canonical subseg spec; always has '/'
@@ -413,11 +415,12 @@ sub cva_idstr ($) {
 sub cva_subsegspec ($) {
     my ($sp)=@_;
     die "invalid subsegment spec" unless
-	$sp =~ m,^([0-9A-Za-z_]*)(?:/(?:([A-Za-z_]+)(\d+))?)?$,;
-    my ($segname,$movfeat,$movconf)=($1,$2,$3);
+	$sp =~ m,^(\-?)([0-9A-Za-z_]*)(?:/(?:([A-Za-z_]+)(\d+))?)?$,;
+    my ($sign,$segname,$movfeat,$movconf)=($1,$2,$3,$4);
     $segname= exists $ctx->{SegName} ?
-	$ctx->{SegName}.$segname
+	$sign.$ctx->{SegName}.$segname
 	    : '';
+    $segname =~ s/^\-(.*)\-/$1/;
     return $segname.'/'.
 	(defined $movfeat ? sprintf "%s%d", $movfeat, $movconf : '');
 }
@@ -641,26 +644,31 @@ sub parametric_segment ($$$$$) {
 print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     $draw= current_draw();
     if ($draw =~ m/G/) {
-	my ($pt,$going,$red);
+	my ($pt,$going,$red,$csegbare);
 	$going=0;
+	o("% segments @segments\n");
 	o("    $psu_subseglw setlinewidth\n");
 	$param=$p0;
 	$pt= &$calcfn;
 	for (;;) {
+	    $csegbare= $segments[0];
+	    $csegbare =~ s/^\-//;
 	    if ($subsegcmapreq) {
-		if (!exists $subsegcmap{$segments[0]}) {
-		    print "$segments[0]\n" or die $!;
-		    $subsegcmap{$segments[0]}++;
+		if (!exists $subsegcmap{$csegbare}) {
+		    print "$csegbare\n" or die $!;
+		    $subsegcmap{$csegbare}++;
 		}
-	    } elsif (exists $subsegcmap{$segments[0]}) {
+	    } elsif (exists $subsegcmap{$csegbare}) {
 		$red= $pt->{A} / (2*$pi);
 		$red *= 64;
+		$red += 128;
+		$red += 32 if $segments[0] =~ m/^\-/;
 		$red %= 64;
 		$red /= 64.0;
 		$red= sprintf("%f", $red);
-		o("    $red $subsegcmap{$segments[0]} setrgbcolor\n");
+		o("    $red $subsegcmap{$csegbare} setrgbcolor\n");
 	    } else {
-		die "unknown subsegment colour for $segments[0]\n";
+		die "unknown subsegment colour for $csegbare\n";
 	    }
 	    o_path_begin();
 	    parametric__o_pt($pt);
@@ -1216,7 +1224,7 @@ sub cmd__obj ($) {
     } else {
 	$ctx->{InRunObj}= $ctx_save->{InRunObj}."${obj_id}::";
     }
-    $ctx->{SegName}= $1 if $segments[0] =~ m,^(.+)/,;
+    $ctx->{SegName}= $1 if $segments[0] =~ m,([^-]+)/,;
     $ctx->{DrawMap}= sub {
 	my ($i) = @_;
 	$i= &{ $ctx_save->{DrawMap} }($i);
diff --git a/layout/ours.m4 b/layout/ours.m4
index b488f3f..1381446 100644
--- a/layout/ours.m4
+++ b/layout/ours.m4
@@ -27,6 +27,9 @@ defobj demos
   part dualjn_tr ^dualjn_peco_r ib -right
 enddef
 
+# positive segment direction is anticlockwise, since T rail is
+# on the inside (see informat.txt)
+
 #---------- main line figure-of-8
 
 layer 0
@@ -34,12 +37,14 @@ layer 0
 abs midx_x_m 930 700 90
 part midx_x cross_peco_s m
 
-segment X1 200 X3
+segment -X1 200 X3
 extend midx_x_tr -top_0rm_b parallel demos!right_main_up 315
 
 segment X7
 part top_0rm ^pt_main_r b
 
+segment /
+
 extend midx_x_tl -top_0lm_b parallel demos!-right_main_down -315
 part top_0lm pt_main_r b
 rel top_0lm_c top_2lk 0 -37
diff --git a/layout/parts.i4 b/layout/parts.i4
index f89acb3..d6836b3 100644
--- a/layout/parts.i4
+++ b/layout/parts.i4
@@ -6,6 +6,12 @@ dnl OBJNAME-EXCLUDING-L
  enddef
 ')
 
+# Conventionally, points' toes are c, the straight through is a
+# and the curve is b.  Segments run from c towards a and b.
+#
+# Crossings (including slips) run `vertically' and have
+# tl, tr, bl, br.  Segments run from b* to t*.
+
 define(`def_point_ord',`
 dnl OBJNAME-EXCLUDING-PT-L ANGLE STRAIGHT-L CURVE-LONGER CURVE-DIVERGE-Y MIN-R
  defpart pt_$1l
@@ -54,9 +60,11 @@ dnl OBJNAME-EXCLUDING-CROSS HALF-ANG HALF-LENGTH
   rel m mr 0 0 -$2
   segment F
   extend mr tr len $3
+  segment -F
   extend mr bl len -$3
   segment B
   extend ml tl len $3
+  segment -B
   extend ml br len -$3
  enddef
 ')
@@ -138,9 +146,11 @@ dnl OBJNAME-EXCLUDING-SLIP2 HALF-LEN HALF-ANG
   rel m mr 0 0 -$3
   segment /S2
   extend ml tl len $2
+  segment -/S2
   extend ml br len -$2
   segment /S1
   extend mr tr len $2
+  segment -/S1
   extend mr bl len -$2
   segment /S0
   join bl tl 500