From c399ecbc0c27762efd853fc6f279acd4a45a14ca Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Sat, 24 Jan 2004 21:13:55 +0000
Subject: [PATCH] basically fixed reorg-introduced bugs, lib stuff works

---
 layout/layout | 67 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 54 insertions(+), 13 deletions(-)

diff --git a/layout/layout b/layout/layout
index 68b82fa..72c2f7c 100755
--- a/layout/layout
+++ b/layout/layout
@@ -13,11 +13,13 @@ use POSIX;
 #  $ctx->{Trans}{Y}       # new origin.  (is applied at _input_
 #  $ctx->{Trans}{A}       # not at plot-time)
 #  $ctx->{Trans}{R}       # but multiply all y coords by this!
+#  $ctx->{Draw}{T}        # 1 or '' for drawing track
+#  $ctx->{Draw}{L}        # L1 or 1 or '' for labelling or drawing locs
 #
 #  $objs{$id}{CmdLog}
 #  $objs{$id}{Loc}
 
-$debug=1;
+#$debug=1;
 open DEBUG, ($debug ? ">&2" : ">/dev/null") or die $!;
 
 if ($debug) {
@@ -167,7 +169,6 @@ sub cmd_rel {
     $turn= cano(\&cva_absang, 0);
     my ($u)= ev_compose({}, $from, { X => $len, Y => -$right, A => 0 });
     ev_compose($to, $u, { X => 0, Y => 0, A => $turn });
-    $to= $u2;
 }
 
 sub dv__evreff ($) {
@@ -241,10 +242,16 @@ $psu_sleeperlen= 17;
 $psu_sleeperlw= 15;
 $psu_raillw= 1.0;
 
-sub o ($) {
-    # fixme optional marking
-    print "$_[0]" or die $!;
-}
+$lmu_marklw= 4;
+$lmu_marktpt= 9;
+$lmu_txtboxtxty= $lmu_marktpt * 0.30;
+$lmu_txtboxh= $lmu_marktpt * 1.0;
+$lmu_txtboxpadx= 3;
+$lmu_txtboxoff= $lmu_marklw/2;
+$lmu_txtboxlw= 1;
+
+sub o ($) { $o .= $_[0]; }
+sub ol ($) { $ol .= $_[0]; }
 
 sub o_path_begin () {
     o("      newpath\n");
@@ -293,7 +300,7 @@ sub parametric_segment ($$$$$) {
     # $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);
-    return if defined $ctx->{InDefObj};
+    return unless $ctx->{Draw}{T} =~ m/1/;
     $ppu= $psu_ulen/$lenperp;
     my ($railctr)=($psu_gauge + $psu_raillw)*0.5;
     my ($tickend)=($psu_allwidth - $psu_ticklen);
@@ -423,7 +430,8 @@ sub input_abscoords ($$) {
 sub newctx () {
     $ctx= {
 	Trans => { X => 0.0, Y => 0.0, A => 0.0, R => 1.0 },
-	InRunObj => ""
+	InRunObj => "",
+	Draw => { T => 1, L => L1 }
 	};
 }
 
@@ -436,6 +444,7 @@ sub cmd_defobj {
     newctx();
     $ctx->{CmdLog}= [ ];
     $ctx->{InDefObj}= $id;
+    $ctx->{Draw}= { T => '', L => '' }
 }
 
 sub cmd_enddefobj {
@@ -471,6 +480,7 @@ sub cmd__obj ($) {
     $ctx->{Trans}{X}= $actual->{X} - $formcv->{X};
     $ctx->{Trans}{Y}= $actual->{Y} - $formcv->{Y};
     $ctx->{InRunObj}= $ctx_save->{InRunObj}."${obj_id}::";
+    $ctx->{Draw}{L} =~ s/L//;
 dv("cmd__obj $obj_id ",'$ctx',$ctx);
     {
 	local (@al);
@@ -497,7 +507,7 @@ sub cmd__do {
     my ($cmd);
 dv("cmd__do $ctx @al ",'$ctx',$ctx);
     $cmd= can(\&cva_cmd);
-    my ($id,$loc,$io);
+    my ($id,$loc,$io,$ad);
     $io= defined $ctx->{InDefObj} ? "$ctx->{InDefObj}!" : $ctx->{InRunObj};
     o("%L cmd   $io $cmd @al\n");
     $ctx->{LocsMade}= [ ];
@@ -505,7 +515,33 @@ dv("cmd__do $ctx @al ",'$ctx',$ctx);
     die "too many args" if @al;
     foreach $id (@{ $ctx->{LocsMade} }) {
 	$loc= $ctx->{Loc}{$id};
-	o("%L point $io$id $loc->{X} $loc->{Y} ".ang2deg($loc->{A})."\n");
+	$ad= ang2deg($loc->{A});
+	ol("%L point $io$id $loc->{X} $loc->{Y} $ad\n");
+	if (length $ctx->{Draw}{L}) {
+	    ol("    gsave\n".
+	       "      $loc->{X} $loc->{Y} translate $ad rotate\n");
+	    if ($ctx->{Draw}{L} =~ m/1/) {
+		ol("      0 $psu_allwidth newpath moveto\n".
+		   "      0 -$psu_allwidth lineto\n".
+		   "      $lmu_marklw setlinewidth stroke\n");
+	    }
+	    if ($ctx->{Draw}{L} =~ m/L/) {
+		ol("      /s ($id) def\n".
+		   "      lf setfont\n".
+		   "      /sx5  s stringwidth pop\n".
+		   "      0.5 mul $lmu_txtboxpadx add def\n".
+		   "      -90 rotate  0 $lmu_txtboxoff translate  newpath\n".
+		   "      sx5 neg  0             moveto\n".
+		   "      sx5 neg  $lmu_txtboxh  lineto\n".
+		   "      sx5      $lmu_txtboxh  lineto\n".
+		   "      sx5      0             lineto closepath\n".
+		   "      gsave  1 setgray fill  grestore\n".
+		   "      $lmu_txtboxlw setlinewidth stroke\n".
+		   "      sx5 neg $lmu_txtboxpadx add  $lmu_txtboxtxty\n".
+		   "      moveto s show\n");
+	    }
+	    ol("      grestore\n");
+	}
     }
 }
 
@@ -515,8 +551,11 @@ sub cmd__one {
 
 $ptscale= 72/25.4 / 5.0;
 
-o("%!\n".
-  "  $ptscale $ptscale scale\n");
+print
+    "%!\n".
+    "  /lf /Courier-New findfont $lmu_marktpt scalefont def\n".
+    "  $ptscale $ptscale scale\n"
+    or die $!;
 
 newctx();
     
@@ -529,4 +568,6 @@ while (<>) {
     push @{ $ctx->{CmdLog} }, [ @al ] if exists $ctx->{CmdLog};
     cmd__one();
 }
-o("  showpage\n");
+
+print $o, $ol, "  showpage\n"
+    or die $!;
-- 
2.30.2