t
u
testjoin
-*.d4
*.new
*,*.gnuplot-data
*,*.gnuplot-cmd
*.oprints-l-tmp
*.tmp
*.oprint-*.ps
-ours-*.ps
parts.ps
*.zip.d
--- /dev/null
+*.d4
+ours-*.ps
+*.new
+*.segcmapreq
+*.segcmap
--- /dev/null
+
+M4INCS= parts.i4
+
+E_TRACK= ArsCLMNo
+LAYOUTOPTS_ALL= -ep=*Cm
+LAYOUTOPTS= -E=*$(E_TRACK) $(LAYOUTOPTS_ALL)
+LAYOUTOPTS_PHYS= -S1.0 $(LAYOUTOPTS) '-e*A'
+XLAYOUTOPTS_LAYER= -e'=5AN' -E'*~=5rsm' -e'p~=5r' -e'*~=9C' -e'*=*l'
+
+LAYOUTOPTS_SEGS= '-e*=*r' '-e=5G'
+
+LAYERS_LS= 0 10 20
+LAYERS_PS= $(addsuffix .ps, $(LAYERS_LS))
+LAYERS_L= $(addprefix ours-l, $(LAYERS_PS))
+LAYERS_E= $(addprefix ours-e, $(LAYERS_PS))
+LAYERS= $(LAYERS_L) $(LAYERS_E)
+
+LPAGES= $(foreach x, 0 1 2 3 4 5 6, $(foreach y, 1 2 3 4 5, ours-p0-$xx$y.ps))
+
+default: layers
+all: default lpages
+
+layers: $(LAYERS)
+lpages: $(LPAGES)
+
+o=>$@.new && mv -f $@.new $@
+
+%.d4: %.m4 $(M4INCS) Makefile
+ m4 -s <$< $o
+
+%-a.ps: %.d4 layout
+ ./layout <$< $(LAYOUTOPTS) '-E*l' $o
+
+%-al.ps: %.d4 layout
+ ./layout <$< $(LAYOUTOPTS) '-e*C' '-ep=rm' $o
+
+%-ap.ps: %.d4 layout
+ ./layout -S1.0 <$< $(LAYOUTOPTS) '-e*A' '-ep=rm' $o
+
+ours-g%.ps: ours.d4 ours-g%.segcmap layout
+ ./layout <$< -l$* $(LAYOUTOPTS_SEGS) -GRours-g$*.segcmap $o
+
+ours-g%.segcmap: ours-g%.segcmapreq segcmapassign
+ ./segcmapassign <$< $o
+
+ours-g%.segcmapreq: ours.d4 layout
+ ./layout <$< -l$* $(LAYOUTOPTS_SEGS) -GL $o
+
+ours-l%.ps: ours.d4 layout
+ ./layout <$< -l$* $(LAYOUTOPTS) $(XLAYOUTOPTS_LAYER) $o
+
+ours-e%.ps: ours.d4 layout
+ ./layout <$< -l$* -E'=*aRsclMno' \
+ -e'p=*rm' -e'=5RN' -E'*~=5rsm' -e'p~=5r' -e'*=*l' $o
+
+ours-p%.ps: ours.d4 layout
+ ./layout <$< -l$$(printf %s "$*" | sed -e 's/-/ -P/') \
+ $(LAYOUTOPTS_PHYS) $(XLAYOUTOPTS_LAYER) $o
+
+parts.ps: showlib.d4 layout
+ ./layout <$< $(LAYOUTOPTS_ALL) $o
+
+clean:
+ -rm -f -- *.d4 *~ *.new
+ -rm -f ours-*.ps parts.ps
+ -rm -f *.oprint-*.ps
+
+.PRECIOUS: $(OPRINTS)
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
+ Specifies that arcs and lines in layer kind K are part of subsegment
+ Sn.
+
+ 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
+ to; the first D0 of track is part of subsegment S0, the next D1 of
+ track is part of the next subsegment S1, and so on, with the last
+ subsegment Sn (without a distance restriction) being used for track
+ beyond that. Each segment command resets the distance counter, and
+ it is not an error for there to be unused subsegment specs in a
+ segment command. For these distances, only track whose subsegment
+ encoding is actually drawn counts.
+
+ If a part or object is used, then the arcs and lines inside it are
+ processed for subsegments as if they appeared directly.
+
+ A subsegment is a specification of:
+ * The named electrically separate track segment of which
+ this track forms part.
+ * If this track is part of one possible configuration of a
+ junction or point, the moveable feature name and configuration
+ number. Any one junction or point is one moveable feature and
+ must be associated with and form part of one track segment.
+ Moveable segments must be entirely contained within objects or
+ parts (ie, one moveable segment cannot span multiple parts).
+ Configuration numbers should start at 0 and be allocated densely.
+
+ Subsegment specs Si are
+ N[/[MP]]
+ where
+ N is the segment name (alphanumeric, may be empty)
+ 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.
+
+ 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.)
+
+ 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.
+
+ segmap S D ...
+
+ Maps specified (sub)segments or moveable feature(s) S to
+ consequently defined (sub)segments or moveable features D. This is
+ primarily intended so that parts' internal segment and feature names
+ can be remapped to correspond to the layout naming scheme.
+
+ S O
+ ---- ----
+ N N' remaps an entire segment including all features
+ N/M M' remaps a particular moveable feature; N is the
+ unmapped name (if applicable)
+
+ The effect is that (sub)segments or features used in segment
+ commands are translated when the segment command is read; the
+ specified names (S) are those which the segment command would
+ define.
+
+ Where segmap is used outside a part or object, the mappings apply to
+ the segment names which would result at the toplevel. When segmap
+ is used inside a part or object, the mappings apply to the segment
+ names defined within the part (perhaps by its subparts). Ie, the
+ mapping operates on the segment names visible at the level at which
+ segmap is used (and thus several segmaps at different levels may
+ operate on a signal segment name, in sequence).
+
+ Mappings in later segmap commands replace earlier mappings at the
+ same level.
+
+ The remapping may coalesce otherwise-distinct segments.
+
layer K[L]
K is layer kind (letters and `_', may be empty), L is a layer depth
(digits, or `=' meaning current layer, or `*' meaning output layer;
Turn on and off drawing of elements in groups.
These are abbreviations for various -E... options.
track -E....
- A full track ARSc
- R rails only aRsc
- S rails and sleepers only aRSc
- C centrelines only arsC
- c swept area and ticks only Arsc
- r no lines drawn at all arcs
+ A full track ARScg
+ R rails only aRscg
+ S rails and sleepers only aRScg
+ C centrelines only arsCg
+ c swept area and ticks only Arscg
+ r no lines drawn at all arcs
labels at locs
- L label top-level locs (turns on bars for them too) LM
+ L label top-level locs (turns on bars for them too) LMg
l do not label any locs l
bars at locs (thick lines perp to track dir'n)
- M bars for top-level locs only Mno
- N bars for top-level locs and those in obj's MNo
- O bars for everything, including those inside parts MNO
+ M bars for top-level locs only Mnog
+ N bars for top-level locs and those in obj's MNog
+ O bars for everything, including those inside parts MNOg
m no bars (turns off labelling too) mnol
+ subsegment encoding
+ G draw only subsegment encoding Garcslmno
-E<layersel>[ARSCLMNOarsclmno]...
enable (capitals) or disable (lowercase) drawing of
M mark locs with a bar
N mark locs with a bar in objs
O mark locs with a bar in parts
+ G draw subsegment encoding
+
+ -GL output segment colour map request list
+ use with -eG or -EG to write out the list of subsegment
+ specs which will need colours, one per line (and not
+ necessarily only once each)
-q quiet: do not print info to stderr
(default: prints bounding box, at the moment)
our $quiet=0;
our $debug=0;
our $output_layer= '*';
+our $subsegcmapreq=0;
our $ps_page_shift= 615;
our $ps_page_xmul= 765.354;
our $ps_page_ymul= 538.583;
our @eopts;
-
-our $drawers= 'arsclmno';
-our %chdraw_emap= qw(A ARSc
- R aRsc
- S aRSc
- C arsC
- c Arsc
+our @segments= ('/');
+our %subsegcmap;
+
+our $drawers= 'arsclmnog';
+our %chdraw_emap= qw(A ARScg
+ R aRscg
+ S aRScg
+ C arsCg
+ c Arscg
r arcs
- L LM
+ L LMg
l l
- M Mno
- N MNo
- O MNO
- m mnol);
+ M Mnog
+ N MNog
+ O MNOg
+ m mnol
+ G Garsclmno);
while (@ARGV && $ARGV[0] =~ m/^\-/) {
last if $ARGV[0] eq '-';
elsif (s/^l(\d+|\*)//) { $output_layer=$1; }
elsif (s/^S([0-9.]+)$//) { $scale= $1 * 1.0; }
elsif (s/^P(\d+)x(\d+)$//) { $page_x= $1; $page_y= $2; }
- elsif (s/^(e)
+ elsif (s/^GL//) { $subsegcmapreq=1; }
+ elsif (s/^GR(.*)$//) {
+ my ($sscmfn) = $1;
+ my ($sscmf);
+ local ($_);
+ $sscmf= new IO::File $sscmfn, 'r'
+ or die "$sscmfn: cannot open: $!\n";
+ while (<$sscmf>) {
+ m,^\s*(\w+/(?:[a-z]+\d+))\s+(\S.*\S)\s*$,
+ or die "$sscmfn:$.: syntax error in subseg cmap\n";
+ $subsegcmap{$1}= $2;
+ }
+ $sscmf->error and die "$sscmfn: error reading: $!\n";
+ close $sscmf;
+ } elsif (s/^(e)
((?:[a-z]|\*|\?|\[[a-z][-a-z]*\])*?)
(\~?) (\d*) (\=*|\-+|\++) (\d*|\*)
([a-z]+)$//ix) {
our $psu_sleeperlw= 15;
our $psu_raillw= 1.0;
our $psu_thinlw= 1.0;
+our $psu_subseglw= 2.0;
our $lmu_marklw= 4;
our $lmu_marktpt= 11;
# $ctx->{DrawMap} # =$fn s.t.
# # &$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)
# $ctx->{Layer}{Level}
# $ctx->{Layer}{Kind}
#
# $eopts[]{GlobRe} # regexp for K
# $eopts[]{LayerCheck} # =$fn where &$fn($l) is true iff layer matches
# $eopts[]{DrawMods} # modifier chars for drawing
+#
+# @segments= ( $csss0, $dist0, $csss1, $dist1, ..., $csssn )
+#
+# $subsegcmap{$csss} = "$green $blue"
+# # $csss is canonical subseg spec; always has '/'
our $ctx;
our %objs;
sub o ($) { $o .= $_[0]; }
sub ol ($) { $ol .= $_[0]; }
sub oflushpage () {
+ return if $subsegcmapreq;
print $o, $ol, " showpage\n"
or die $!;
$o=$ol='';
sub o_path_stroke ($) {
my ($width)=@_;
o(" $width setlinewidth stroke\n");
-}
+}
+sub o_path_strokeonly () {
+ o(" stroke\n");
+}
sub o_line ($$$) {
my ($a,$b,$width)=@_;
o_path_point("$pt->{X} $pt->{Y}");
}
+sub segment_used_len ($) {
+ my ($used) = @_;
+ return if @segments < 3;
+ $segments[1] -= $used;
+ return if $segments[1] > 0;
+ @segments= @segments[2..-1];
+}
+
sub parametric_segment ($$$$$) {
my ($p0,$p1,$lenperp,$minradius,$calcfn) = @_;
# makes $p (global) go from $p0 to $p1 ($p1>$p0)
# $calcfn is invoked with $p 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/[ARSC]/;
+ return unless $ctx->{Draw} =~ m/[ARSCG]/;
$ppu= $psu_ulen/$lenperp;
$allwidth= allwidth($minradius);
my ($railctr)=($psu_gauge + $psu_raillw)*0.5;
my ($sleeperend)=($psu_sleeperlen*0.5);
print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
$draw= current_draw();
+ if ($draw =~ m/G/) {
+ my ($pt,$going,$red);
+ $going=0;
+ o(" $psu_subseglw setlinewidth\n");
+ $param=$p0;
+ $pt= &$calcfn;
+ for (;;) {
+ if ($subsegcmapreq) {
+ next if $subsegcmap{$segments[0]}++;
+ print "$segments[0]\n" or die $!;
+ } elsif (exists $subsegcmap{$segments[0]}) {
+ $red= $pt->{A} / (2*$pi);
+ $red *= 64;
+ $red %= 64;
+ $red /= 64.0;
+ $red= sprintf("%f", $red);
+ o(" $red $subsegcmap{$segments[0]} setrgbcolor\n");
+ } else {
+ die "unknown subsegment colour for $segments[0]\n";
+ }
+ o_path_begin();
+ parametric__o_pt($pt);
+
+ $param += $ppu;
+ last if $param>=$p1;
+ segment_used_len($psu_ulen);
+ $pt= &$calcfn;
+ parametric__o_pt($pt);
+ o_path_strokeonly();
+ }
+ segment_used_len(($p1-($param-$ppu)) * $lenperp);
+ $param=$p1;
+ parametric__o_pt(&$calcfn);
+ o_path_strokeonly();
+ }
if ($draw =~ m/C/) {
my ($pt);
o(" $psu_thinlw setlinewidth\n");
$ctx= {
Trans => { X => 0.0, Y => 0.0, A => 0.0, R => 1.0 },
InRunObj => "",
- DrawMap => sub { $_[0]; }
+ DrawMap => sub { $_[0]; },
+ SegName => ""
};
%{ $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 {
cmd__do();
}
-print
- "%!\n".
- " /lf /Courier-New findfont $lmu_marktpt scalefont def\n".
- " $ps_page_shift 0 translate 90 rotate\n"
- or die $!;
+o("%!\n".
+ " /lf /Courier-New findfont $lmu_marktpt scalefont def\n".
+ " $ps_page_shift 0 translate 90 rotate\n");
if ($page_x || $page_y) {
- print
- " /Courier-New findfont 15 scalefont setfont\n".
- " 30 30 moveto (${page_x}x${page_y}) show\n"
- or die $!;
+ o(" /Courier-New findfont 15 scalefont setfont\n".
+ " 30 30 moveto (${page_x}x${page_y}) show\n");
}
-print
- " -$ps_page_xmul $page_x mul -$ps_page_ymul $page_y mul translate\n".
- " $ptscale $ptscale scale\n"
- or die $!;
+o(" -$ps_page_xmul $page_x mul -$ps_page_ymul $page_y mul translate\n".
+ " $ptscale $ptscale scale\n");
newctx();
}
if (!$quiet) { print STDERR $bboxstr; }
$bboxstr =~ s/^/\%L bbox /mg;
- print $bboxstr or die $!;
+ o($bboxstr) or die $!;
if ($scale < 1.5) {
my ($tick_x, $tick_y, $ticklen);
--- /dev/null
+#!/usr/bin/perl
+# input:
+# lines, with one canonical subsegment specification (csss) each
+# (need not be unique)
+# output:
+# lines:
+# <csss> <green> <blue> <stuff which will be ignored...>
+# where <csss> is N/[MP] (see informat.txt) and <green> and <blue>
+# contain no whitespace and are suitable for inserting like this
+# into the PostScript output:
+# ...code to compute and stack red in range [0,1>...
+# <green> <blue> setrgbcolor
+#
+# Encoding is as follows:
+#
+# RED
+# 6 bits angle
+# 1 bit `edge or core' (currently 0 meaning `core')
+# 1 bit reserved (0)
+#
+# GREEN
+# 2 bits segment overflow
+# 6 bits moveable feature
+#
+#
+# 10 bits
~ijackson / trains.git / commitdiff