From: ian <ian>
Date: Sun, 25 Jan 2004 18:23:59 +0000 (+0000)
Subject: sgt's algorithm works now
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=e60644d25d969ad797636052af58d73252d01195;p=trains.git

sgt's algorithm works now
---

diff --git a/layout/informat.txt b/layout/informat.txt
index 3f0ad47..bcdd50b 100644
--- a/layout/informat.txt
+++ b/layout/informat.txt
@@ -35,6 +35,14 @@ Commands
   If length R specified, draws an arc of radius R; R +ve curves to the
   right; R -ve to the left.
 
+ join F T arcs               two circular arcs of equal minimised radius
+ join F T arcsline R         straight line between two arcs radius R
+ join F T arcline            straight line and arc of minimised radius
+  Joins one existing loc, F, to another, T.  F's direction points to
+  the new track; T's away - ie the added track leaves F in F's
+  direction and arrives at T in T's direction.  In each case solution
+  is chosen with minimum total added length.
+
  defobj O
  [commands]
  enddef
diff --git a/layout/layout b/layout/layout
index bba4cb4..8de5cd5 100755
--- a/layout/layout
+++ b/layout/layout
@@ -130,8 +130,9 @@ sub ev_bearing ($$) {
     my ($r);
     $r= atan2($b->{Y} - $a->{Y},
 	      $b->{X} - $a->{X});
-    $r -= 2 * $pi;
-    while ($r < $a->{A}) { $r += 2 * $pi; }
+    $r -= 4.0 * $pi;
+    while ($r < $a->{A}) { $r += 2.0 * $pi; }
+    $r;
 }		 
 sub v_dist ($$) {
     # v_dist(A,B)
@@ -388,19 +389,18 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     }
 }
 
-sub arc ($$$$$$) {
-    my ($to, $ctr,$from,$fromsense, $radius,$delta) = @_;
+sub arc ($$$$$) {
+    my ($to, $ctr,$from, $radius,$delta) = @_;
     # does parametric_segment to draw an arc centred on $ctr
+    # ($ctr->{A} ignored)
     # from $from with radius $radius (this must be consistent!)
     # and directionally-subtending an angle $delta.
     # sets $to->... to be the other end, and returns $to
-    # $fromsense is 1 or -1, and affects only the interpretation
-    # of $from->{A} (not the result).
-    my ($beta, $fromadj);
-    $fromadj= (1.0 - $fromsense) * $pi;
-    $to->{A}= $beta= $from->{A} + $fromadj + $delta;
+    my ($beta);
+    $to->{A}= $beta= $from->{A} + $delta;
     $to->{X}= $ctr->{X} - $radius * sin($beta);
     $to->{Y}= $ctr->{Y} + $radius * cos($beta);
+    return if abs($delta*$radius) < 1E-9;
     parametric_segment(0.0,1.0, abs($radius*$delta), sub {
 	my ($beta) = $from->{A} + $delta * $param;
 	return { X => $ctr->{X} - $radius * sin($beta),
@@ -420,7 +420,7 @@ sub cmd_join {
     my (@paths);
     if ($how eq 'arcs') {
 	my ($sigma,$distfact, $theta,$phi, $a,$b,$c,$d, $m,$r);
-	my ($cvec,$cfrom,$cto,$midpt, $delta1,$delta2, $path);
+	my ($cvec,$cfrom,$cto,$midpt, $delta1,$delta2, $path,$reverse);
 	$sigma= ev_bearing($from,$to);
 	$distfact= v_dist($from,$to);
 	$theta= 0.5 * $pi - ($from->{A} - $sigma);
@@ -432,15 +432,23 @@ sub cmd_join {
 	foreach $m (qw(-1 1)) {
 	    $r= -0.5 * (-$b + $m*$d) / $a;
 	    $radius= -$r * $distfact;
-	    $cvec= { X => 0, Y => -$radius, A => 0.5*$pi };
-	    $cfrom=  ev_compose({}, $from, $cvec);
-	    $cto=    ev_compose({}, $to,   $cvec);
+	    $cfrom=  ev_compose({}, $from, { X=>0, Y=>-$radius, A=>-0.5*$pi });
+	    $cto=    ev_compose({}, $to,   { X=>0, Y=> $radius, A=> 0.5*$pi });
 	    $midpt=  ev_lincomb({}, $cfrom, $cto, 0.5);
-	    $delta1= ev_bearing($cfrom, $midpt);
-	    $delta2= ev_bearing($cto,   $midpt);
-	    $delta2 -= 2*$pi;
-	    $path= [{ T=>Arc, F=>$from, C=>$cfrom, R=>$radius, D=>$delta1 },
-		    { T=>Arc, F=>$to,   C=>$cto,   R=>$radius, D=>$delta2 }];
+	    $reverse= signum($r);
+	    if ($reverse<0) {
+		$cfrom->{A} += $pi;
+		$cto->{A} += $pi;
+	    }
+	    $delta1= ev_bearing($cfrom, $midpt) - $cfrom->{A};
+	    $delta2= ev_bearing($cto,   $midpt) - $cto->{A};
+	    if ($reverse<0) {
+		$delta1 -= 2*$pi;
+		$delta2 -= 2*$pi;
+	    }
+	    my ($fs);
+	    $path= [{ T=>Arc, F=>$from, C=>$cfrom, R=> $radius, D=>$delta1 },
+		    { T=>Arc, F=>$to,   C=>$cto,   R=>-$radius, D=>$delta2 }];
 	    push @paths, $path;
 	}
     }
@@ -467,8 +475,7 @@ sub cmd_join {
     o("%   chose path $bestpath\n");
     foreach $segment (@$bestpath) {
 	if ($segment->{T} eq 'Arc') {
-	    arc({}, $segment->{C}, $segment->{F}, 1.0,
-		$segment->{R}, $segment->{D});
+	    arc({}, $segment->{C},$segment->{F},$segment->{R},$segment->{D});
 	} else {
 	    die "unknown segment";
 	}
@@ -536,7 +543,7 @@ sub cmd_extend {
 	    $beta -= $sign_ang * $sign_r * $beta_interval * $pi;
 	}	
     printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
-	arc($to, ,$ctr,$from,1.0, $radius,$delta);
+	arc($to, ,$ctr,$from, $radius,$delta);
     }
     printf DEBUG "to $to->{X} $to->{Y} $to->{A}\n";
 }
diff --git a/layout/testfile b/layout/testfile
index 30261bb..6960b47 100644
--- a/layout/testfile
+++ b/layout/testfile
@@ -1,4 +1,4 @@
-abs a 100 400 -30
+abs a 200 400 -30
 extend a b len 200mm
 extend b c ang 120 -450
 extend c d len 150mm
@@ -17,7 +17,7 @@ extend b1 c1 uptoang 60 -228
 extend c1 d1 upto f
 extend d1 e1 len 100
 
-abs j 100 600 27
+abs j 200 600 27
 extend -j je len 50
 
-join j f arcs
+join f -j arcs
diff --git a/layout/testjoin.m4 b/layout/testjoin.m4
new file mode 100644
index 0000000..edbd451
--- /dev/null
+++ b/layout/testjoin.m4
@@ -0,0 +1,23 @@
+define(`simple',`
+rel b$2 b$2x$1 0 0 $1
+join a$2 -b$2x$1 arcs
+')
+
+define(`complex',`
+abs org$1 $2 $3 0
+rel org$1 a$1 0 0 $4
+rel org$1 b$1 200 0 0
+simple(0,$1)
+simple(30,$1)
+simple(60,$1)
+simple(90,$1)
+simple(135,$1)
+simple(300,$1)
+simple(345,$1)
+')
+
+complex(0,    200,300,  0   )
+complex(30,   200,800,  30  )
+complex(60,   200,1400, 60  )
+complex(m75,  800,500,  -75 )
+complex(m300, 800,1300, -300)