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 ...
# # &$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}
#
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);
return if @segments < 3;
$segments[1] -= $used;
return if $segments[1] > 0;
- @segments= @segments[2..-1];
+ @segments= @segments[2..$#segments];
}
sub parametric_segment ($$$$$) {
$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;
$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;
$ctx->{Draw}= $defobj_save->{Draw}.'X';
$ctx->{DrawMap}= sub { ''; };
$ctx->{Layer}= { Level => 5, Kind => '' };
- $segments[0] =~ m,/, or die;
- $ctx->{SegName}= $`;
}
sub cmd_enddef {
}
}
+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);
} 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);
$pfx= cano(\&cva_idstr,undef);
}
}
+ if (exists $ctx->{SavedSegment}) {
+ @segments= ($ctx->{SavedSegment});
+ }
$ctx_inobj= $ctx;
$ctx= $ctx_save;
if (defined $pfx) {
}
$ctx->{Draw}= '';
+$ctx->{SegName}= '';
@al= qw(layer 5);
cmd__one();
~ijackson / trains.git / commitdiff