From: ian Date: Fri, 22 Oct 2004 00:07:40 +0000 (+0000) Subject: generates a sensible-looking segcmapreq for a few segments X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=0b78d45df0bc6e41bd56693c23faefa87bc1136f;p=trains.git generates a sensible-looking segcmapreq for a few segments --- diff --git a/layout/informat.txt b/layout/informat.txt index f03004b..902a863 100644 --- a/layout/informat.txt +++ b/layout/informat.txt @@ -68,16 +68,19 @@ Commands M is the moveable feature name (alphabetic, nonempty) P is the moveable feature position (numeric, nonempty, 0-indexed) If N is empty and MP is omitted then / must be present. + Underscore (`_') counts as a letter. If a segment command occurs in a part or object, N is appended to - the N in force at the start of the part or object. (Note that it is - not usually a good idea to rely on how a complex object leaves the - setting of the segment, as probably the calling code will end up - using the object's segment names.) + the N in force at the start of the part or object, and in this + case the segment will be set back to the last one from the list + in force when the object was entered, as if the object had merely + drawn an infinite amount of track. At the start of processing at the toplevel, the empty-named fixed - subsegment is in use. The empty-named top-level subsegment - indicates that the subsegment is unspecified, unknown or absent. + subsegment is in use. The empty-named top-level segment indicates + that the subsegment is unspecified, unknown or absent. All segments + defined by objects at whose invocation the empty-named top-level + segment is in force, are also assigned to the empty segment. segmap S D ... diff --git a/layout/layout b/layout/layout index cead9ce..e3e78c7 100755 --- a/layout/layout +++ b/layout/layout @@ -190,6 +190,8 @@ our $allwidthmin= allwidth(undef); # # &$fn($drawchrs_spec_by_layer_cmdline) # # = $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 +# $ctx->{SavedSegment} # exists iff segment command used, is a $csss # $ctx->{Layer}{Level} # $ctx->{Layer}{Kind} # @@ -402,6 +404,17 @@ sub cva_idstr ($) { die "invalid id" unless $sp =~ m/^[a-z][_0-9A-Za-z]*$/; return $&; } +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); + $segname= exists $ctx->{SegName} ? + $ctx->{SegName}.$segname + : ''; + return $segname.'/'. + (defined $movfeat ? sprintf "%s%d", $movfeat, $movconf : ''); +} sub cva_idex ($) { my ($sp)=@_; my ($id,$r,$d,$k,$neg,$na,$obj_id,$vflip,$locs); @@ -600,7 +613,7 @@ sub segment_used_len ($) { return if @segments < 3; $segments[1] -= $used; return if $segments[1] > 0; - @segments= @segments[2..-1]; + @segments= @segments[2..$#segments]; } sub parametric_segment ($$$$$) { @@ -629,8 +642,10 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n"; $pt= &$calcfn; for (;;) { if ($subsegcmapreq) { - print "$segments[0]\n" or die $! - unless $subsegcmap{$segments[0]}++; + if (!exists $subsegcmap{$segments[0]}) { + print "$segments[0]\n" or die $!; + $subsegcmap{$segments[0]}++; + } } elsif (exists $subsegcmap{$segments[0]}) { $red= $pt->{A} / (2*$pi); $red *= 64; @@ -1048,8 +1063,7 @@ sub newctx (;$) { $ctx= { Trans => { X => 0.0, Y => 0.0, A => 0.0, R => 1.0 }, InRunObj => "", - DrawMap => sub { $_[0]; }, - SegName => "" + DrawMap => sub { $_[0]; } }; %{ $ctx->{Layer} }= %{ $ctx_save->{Layer} } if defined $ctx_save; @@ -1074,8 +1088,6 @@ sub cmd__defobj ($) { $ctx->{Draw}= $defobj_save->{Draw}.'X'; $ctx->{DrawMap}= sub { ''; }; $ctx->{Layer}= { Level => 5, Kind => '' }; - $segments[0] =~ m,/, or die; - $ctx->{SegName}= $`; } sub cmd_enddef { @@ -1103,6 +1115,20 @@ sub cmd__runobj ($) { } } +sub cmd_segment { + my ($csss,$length); + $ctx->{SavedSegment}= pop @segments + unless exists $ctx->{SavedSegment}; + @segments= (); + while (@al>1) { + $csss= can(\&cva_subsegspec); + $length= can(\&cva_len); + push @segments, $csss, $length; + } + $csss= can(\&cva_subsegspec); + push @segments, $csss; +} + sub layer_draw ($$) { my ($k,$l) = @_; my ($eo,$cc, $r); @@ -1184,6 +1210,7 @@ sub cmd__obj ($) { } else { $ctx->{InRunObj}= $ctx_save->{InRunObj}."${obj_id}::"; } + $ctx->{SegName}= $1 if $segments[0] =~ m,^(.+)/,; $ctx->{DrawMap}= sub { my ($i) = @_; $i= &{ $ctx_save->{DrawMap} }($i); @@ -1207,6 +1234,9 @@ sub cmd__obj ($) { $pfx= cano(\&cva_idstr,undef); } } + if (exists $ctx->{SavedSegment}) { + @segments= ($ctx->{SavedSegment}); + } $ctx_inobj= $ctx; $ctx= $ctx_save; if (defined $pfx) { @@ -1379,6 +1409,7 @@ if ($debug) { } $ctx->{Draw}= ''; +$ctx->{SegName}= ''; @al= qw(layer 5); cmd__one(); diff --git a/layout/parts.i4 b/layout/parts.i4 index 01a0819..f89acb3 100644 --- a/layout/parts.i4 +++ b/layout/parts.i4 @@ -10,8 +10,10 @@ define(`def_point_ord',` dnl OBJNAME-EXCLUDING-PT-L ANGLE STRAIGHT-L CURVE-LONGER CURVE-DIVERGE-Y MIN-R defpart pt_$1l abs c 200 200 0 + segment /P0 extend c a len $3 rel a b $4 -$5 $2 + segment /P1 join c b $6 enddef def_thing_l_r(`pt_$1') @@ -23,7 +25,9 @@ dnl OBJNAME-EXCLUDING-PT-L TIGHT-ANG TIGHT-RECT TIGHT-DIVERGE-Y SHALLOW.. MIN-R abs c 200 200 0 rel c a $6 -$7 $5 rel c b $3 -$4 $2 + segment /P0 join c a $8 + segment /P1 join c b $8 enddef def_thing_l_r(`pt_$1') @@ -35,7 +39,9 @@ dnl OBJNAME-EXCLUDING-PT HALF-ANG RECT HALF-DIVERGE-Y MIN-R abs c 200 200 0 rel c l $3 -$4 $2 rel c r $3 $4 -$2 + segment /P0 join c l $5 + segment /P1 join c r $5 enddef ') @@ -46,9 +52,11 @@ dnl OBJNAME-EXCLUDING-CROSS HALF-ANG HALF-LENGTH abs m 200 200 0 rel m ml 0 0 $2 rel m mr 0 0 -$2 - extend ml tl len $3 + segment F extend mr tr len $3 extend mr bl len -$3 + segment B + extend ml tl len $3 extend ml br len -$3 enddef ') @@ -93,7 +101,9 @@ dnl not R($5) rel strintersect strbackanal -$3 layer = rel strbackanal b $2 + segment /P1 join c b 240 arcline + segment /P0 extend c a len $2 enddef def_thing_l_r(`pt_$1') @@ -111,22 +121,30 @@ defpart pt_shino_x3 layer = rel strintersectc l 141 rel strintersectb r 112 + segment /P1 extend c m len 215 + segment /P0 join c l 315 arcline + segment /P2 join c r 315 arcline enddef define(`def_slip2',` dnl OBJNAME-EXCLUDING-SLIP2 HALF-LEN HALF-ANG defpart slip2_$1 + # configurations: bl-tl 0 bl-tr 1 br-tl 2 br-tr 3 abs m 200 200 0 rel m ml 0 0 $3 rel m mr 0 0 -$3 + segment /S2 extend ml tl len $2 - extend mr tr len $2 extend ml br len -$2 + segment /S1 + extend mr tr len $2 extend mr bl len -$2 + segment /S0 join bl tl 500 + segment /S3 join br tr 500 enddef ')