From: ian <ian>
Date: Sat, 24 Jan 2004 13:18:57 +0000 (+0000)
Subject: objs work except for result points
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=fcc64f0ed965f83bde6b3d728c6023273fffc750;p=trains.git

objs work except for result points
---

diff --git a/layout/layout b/layout/layout
index fd4d07e..76f9697 100755
--- a/layout/layout
+++ b/layout/layout
@@ -21,7 +21,7 @@ use POSIX;
 #  $objs{$id}{CmdLog}
 #  $objs{$id}{Loc}
 
-#$debug=1;
+$debug=1;
 open DEBUG, ($debug ? ">&2" : ">/dev/null") or die $!;
 
 if ($debug) {
@@ -78,14 +78,15 @@ sub cva_idex ($) {
     return $r;
 }
 sub cva_idnew ($) {
-    my ($sp,$id)=@_;
+    my ($sp)=@_;
+    my ($id);
     $id=cva_idstr($sp);
     die "duplicate $id" if exists $ctx->{Loc}{$id};
     exists $ctx->{Loc}{$id}{X};
     push @{ $ctx->{LocsMade} }, $id;
     return $ctx->{Loc}{$id};
 }
-sub cva_cmd ($) { return cva_idstr($_); }
+sub cva_cmd ($) { return cva_idstr($_[0]); }
 sub cva__enum ($$) {
     my ($sp,$el)=@_;
     return $sp if grep { $_ eq $sp } @$el;
@@ -120,7 +121,7 @@ sub evreff ($) {
 sub evr ($) {
     my ($v) = @_;
     return $v if $v !~ m/\W/ && $v =~ m/[A-Z]/ && $v =~ m/^[a-z_]/i;
-    return $v if $v eq ($v+0.0);
+    return $v if $v =~ m/^[0-9.]+/;
     $v =~ s/[\\\']/\\$&/g;
     return "'$v'";
 }
@@ -142,7 +143,7 @@ sub dv1_kind ($$$$$$$) {
     1;
 }    
 sub dv1 ($$$) {
-    return ;0 unless $debug;
+    return 0 unless $debug;
     my ($pfx,$expr,$v) = @_;
     $ref= ref $v;
 #print STDERR "dv1 >$pfx|$ref<\n";
@@ -183,8 +184,8 @@ sub loc_lin_comb ($$$) {
 $psu_ulen= 4.5;
 $psu_edgelw= 0.5;
 $psu_ticklw= 0.1;
-$psu_ticksperu= 3;
-$psu_ticklen= 3.0;
+$psu_ticksperu= 1;
+$psu_ticklen= 5.0;
 $psu_allwidth= 37.0/2;
 $psu_gauge= 9;
 $psu_sleeperlen= 17;
@@ -243,6 +244,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};
     $ppu= $psu_ulen/$lenperp;
     my ($railctr)=($psu_gauge + $psu_raillw)*0.5;
     my ($tickend)=($psu_allwidth - $psu_ticklen);
@@ -311,6 +313,7 @@ sub cmd_extend {
 	});
     } else {
 	print DEBUG "radius >$radius<\n";
+	$radius *= $ctx->{Trans}{AA};
 	$signum= $radius / abs($radius);
 	$ctr->{X}= $from->{X} + $radius * sin($from->{A});
 	$ctr->{Y}= $from->{Y} - $radius * cos($from->{A});
@@ -359,7 +362,7 @@ sub cmd__do {
     &{ "cmd_$cmd" };
     die "too many args" if @al;
     foreach $id (@{ $ctx->{LocsMade} }) {
-	$loc= $ctx->{Locs}{$id};
+	$loc= $ctx->{Loc}{$id};
 	o("%  point $id $loc->{X} $loc->{Y} ".ang2deg($loc->{A})."\n");
     }
 }
@@ -368,8 +371,11 @@ sub cmd__one {
     cmd__do();
 }
 
+sub ang2deg ($) {
+    return $_[0] * 180 / $pi;
+}
 sub input_absang ($) {
-    return $_ * $ctx->{Trans}{AA} + $ctx->{Trans}{A0};
+    return $_[0] * $ctx->{Trans}{AA} + $ctx->{Trans}{A0};
 }
 sub input_abscoords ($$) {
     my ($in,$out, $i);
@@ -387,23 +393,26 @@ sub newctx () {
     $ctx= { Trans => { X0 => 0.0, Y0 => 0.0,
 		       XY => 0.0, YX => 0.0,
 		       A0 => 0.0, AA => 1.0,
-		       XX => 1.0, YY => 1.0; } }
+		       XX => 1.0, YY => 1.0 } }
 }
 
 sub cmd_defobj {
-    $defobj_id= can(\&cva_idstr);
+    my ($id);
+    $id= can(\&cva_idstr);
     die "nested defobj" if $defobj_save;
-    die "repeated defobj" if exists $objs{$defobj_id};
+    die "repeated defobj" if exists $objs{$id};
     $defobj_save= $ctx;
     newctx();
-    $ctx= { CmdLog => [ ] }
+    $ctx->{CmdLog}= [ ];
+    $ctx->{InDefObj}= $id;
 }
 
 sub cmd_enddefobj {
-    die "unmatched enddefobj" unless $defobj_save;
-    my ($bit);
+    my ($bit,$id);
+    $id= $ctx->{InDefObj};
+    die "unmatched enddefobj" unless defined $id;
     foreach $bit (qw(CmdLog Loc)) {
-	$objs{$defobj_id}{$bit}= $ctx->{$bit};
+	$objs{$id}{$bit}= $ctx->{$bit};
     }
     $ctx= $defobj_save;
     $defobj_save= undef;
@@ -416,31 +425,36 @@ sub cmd__obj ($) {
     my ($obj_id, $ctx_save, $pfx);
     $obj_id= can(\&cva_idstr);
     $actual= can(\&cva_idex);
-    $formal= can(\&cva_idstr);
+    $formal_id= can(\&cva_idstr);
     $obj= $objs{$obj_id};
+    dv("cmd__obj ",'$obj',$obj);
     die "unknown obj $obj_id" unless $obj;
+    $formal= $obj->{Loc}{$formal_id};
+    die "unknown formal $formal_id" unless $formal;
     $ctx_save= $ctx;
     newctx();
     o("%  obj $obj_id\n");
     $ctx->{Trans}{AA}= $flipsignum;
-    $ctx->{Trans}{A0}= $formal->{A} - $actual->{A}/$flipsignum;
+    $ctx->{Trans}{A0}= $actual->{A} - $formal->{A}/$flipsignum;
     $ctx->{Trans}{XX}= cos($ctx->{Trans}{A0});
     $ctx->{Trans}{YY}= $flipsignum * cos($ctx->{Trans}{A0});
-    $ctx->{Trans}{XY}= sin($ctx->{Trans}{A0});
+    $ctx->{Trans}{XY}= $flipsignum * sin($ctx->{Trans}{A0});
     $ctx->{Trans}{YX}= -$flipsignum * sin($ctx->{Trans}{A0});
     ($xformcv,$yformcv)= input_abscoords($formal->{X}, $formal->{Y});
+print STDERR ">$xformcv|$yformcv<\n";
     $ctx->{Trans}{X0}= $actual->{X} - $xformcv;
     $ctx->{Trans}{Y0}= $actual->{Y} - $yformcv;
     {
 	local (@al);
-	foreach $c ($obj->{CmdLog}) {
+	foreach $c (@{ $obj->{CmdLog} }) {
 	    @al= @$c;
+	    next if $al[0] eq 'enddefobj';
 	    cmd__one();
 	}
     }
     $pfx= cano(\&cva_idstr,'');
     if (length $pfx) {
-	foreach $id (keys $ctx->{Loc}) {
+	foreach $id (keys %{ $ctx->{Loc} }) {
 	    $newid= $pfx.$id;
 	    next if exists $ctx_save->{Loc}{$newid};
 	    $pt= $ctx->{Loc}{$id};
diff --git a/layout/testobj b/layout/testobj
new file mode 100644
index 0000000..f96274d
--- /dev/null
+++ b/layout/testobj
@@ -0,0 +1,14 @@
+defobj po
+abs c 100 100 0
+extend c a len 87
+extend c b ang 22.5d -228
+enddefobj
+
+abs r 200 350 180
+abs rf 200 150 180
+
+obj po r b po_
+objflip po po_c b pof_
+
+#rel po_c po2c 0 0 180
+#objflip po po2c c po2_