From: ian <ian>
Date: Tue, 3 Feb 2004 23:04:16 +0000 (+0000)
Subject: arcsline cross works; offer cross and loop crits for join
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=eb0b1beb0e1ce9fa551329d34b8f29c4777c879f;p=trains.git

arcsline cross works; offer cross and loop crits for join
---

diff --git a/layout/informat.txt b/layout/informat.txt
index e434b0d..c5689b9 100644
--- a/layout/informat.txt
+++ b/layout/informat.txt
@@ -69,6 +69,8 @@ Commands
      [!]twoarcs            prefer [not] two circular arcs of equal radius
      [!]arcline            prefer [not] one line and an arc of max radius
      [!]arcsline           prefer [not] line between two arcs of min radius
+     [!]loop               prefer [not] loop (arcsline, arc of same sense)
+     [!]cross              prefer [not] cross (arcsline 2 senses, or twoarcs)
   if this doesn't resolve, will pick the shortest.
 
  defobj|defpart O
diff --git a/layout/layout b/layout/layout
index 6ae94cd..c2c46d0 100755
--- a/layout/layout
+++ b/layout/layout
@@ -542,7 +542,7 @@ sub cmd_join {
 	    $r= -0.5 * (-$b + $m*$d) / $a;
 	    $radius= -$r * $distfact;
 	    o("%     twoarcs $m radius $radius ");
-	    if (abs($radius) < $minradius) { o("too-small"); next; }
+	    if (abs($radius) < $minradius) { o("too-small\n"); next; }
 	    $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);
@@ -562,43 +562,60 @@ sub cmd_join {
 	    $path= [{ T=>Arc, F=>$from, C=>$cfrom, R=> $radius, D=>$delta1 },
 		    { T=>Arc, F=>$to,   C=>$cto,   R=>-$radius, D=>$delta2 }];
 	    push @paths, $path;
-	    push @solkinds, 'twoarcs';
+	    push @solkinds, [ 'twoarcs', 'cross' ];
 	}
     } while 0;
     if ($minradius<=1e-6) {
 	o("%     arcsline no-radius\n");
     } else {
-	# two circular arcs of specified radius in same direction
+	# two circular arcs of specified radius
 	# with an intervening straight
-	my ($lr, $c_cd,$d_cd,$t,$k,$l, $path);
+	my ($lr,$inv, $c,$d,$alpha,$t,$k,$l,$rpmsina,$rcosa,$linelen, $path);
 	foreach $lr (qw(-1 +1)) {
-	    $c_cd= ev_compose({}, $from, { X=>0, Y=>-$lr*$minradius, A=>0 });
-	    $d_cd= ev_compose({}, $to, { X=>0, Y=>-$lr*$minradius, A=>$pi });
-	    $t= v_dist($c_cd,$d_cd);
-	    o("%     arcsline $lr t=$t ");
-	    if ($t < 1e-6) { o("concentric"); next; }
-	    $c_cd->{A}= $d_cd->{A}= ev_bearing($c_cd,$d_cd);
-	    o("bearing ".ang2deg($c_cd->{A})."\n");
-	    $k= ev_compose({}, $c_cd,
-			   { X=>0, Y=>$lr*$minradius, A=>0 });
-	    $l= ev_compose({}, $d_cd,
-			   { X=>0, Y=>$lr*$minradius, A=>0 });
-	    $path= [{ T=>Arc, F=>$from, C=>$c_cd,
-		      R=>$lr*$minradius,
-		      D=> -$lr*a_normalise($lr * ($from->{A} - $k->{A}), 0) },
-		    { T=>Line, A=>$k, B=>$l, L=>$t },
-		    { T=>Arc, F=>$l, C=>$d_cd,
-		      R=> $lr*$minradius,
-		      D=> -$lr*a_normalise(-$lr * ($to->{A} - $l->{A}), 0) }];
-	    push @paths, $path;
-	    push @solkinds, 'arcsline';
+	    foreach $inv (qw(-1 +1)) {
+		$c=ev_compose({},$from,{X=>0,Y=>-$lr*$minradius, A=>0 });
+		$d=ev_compose({},$to,{X=>0, Y=>-$inv*$lr*$minradius, A=>$pi });
+		$t= v_dist($c,$d);
+		o("%     arcsline $lr $inv t=$t ");
+		if ($t < 1e-6) { o("concentric"); next; }
+		$c->{A}= $d->{A}= ev_bearing($c,$d);
+		o("bearing ".ang2deg($c->{A}));
+		if ($inv>0) {
+		    o("\n");
+		    $k= ev_compose({}, $c, { X=>0, Y=>$lr*$minradius, A=>0 });
+		    $l= ev_compose({}, $d, { X=>0, Y=>$lr*$minradius, A=>0 });
+		    $linelen= $t;
+		} else {
+		    my ($cosalpha) = 2.0 * $minradius / $t;
+		    if ($cosalpha > (1.0 - 1e-6)) { o(" too-close\n"); next; }
+		    $alpha= acos($cosalpha);
+		    $rpmsina= $lr * $minradius * sin($alpha);
+		    $rcosa= $minradius * $cosalpha;
+		    $k= ev_compose({}, $c, { X=>$rcosa, Y=>$rpmsina, A=>0 });
+		    $l= ev_compose({}, $d, { X=>-$rcosa, Y=>-$rpmsina, A=>0 });
+		    $k->{A}= $l->{A}= ev_bearing($k,$l);
+		    o(" alpha=".ang2deg($alpha)." kl^=".ang2deg($k->{A})."\n");
+		    $linelen= v_dist($k,$l);
+		}
+		$path= [{ T => Arc, F => $from, C => $c,
+			  R =>$lr*$minradius,
+			  D => -$lr * a_normalise
+			      ($lr * ($from->{A} - $k->{A}), 0) },
+			{ T => Line, A => $k, B => $l, L => $linelen },
+			{ T => Arc, F => $l, C => $d,
+			  R => $inv*$lr*$minradius,
+			  D => -$lr*$inv * a_normalise
+			      (-$lr*$inv * ($to->{A} - $l->{A}), 0) }];
+		push @paths, $path;
+		push @solkinds,  [ 'arcsline', ($inv<0 ? 'cross' : 'loop') ];
+	    }
 	}
     }
-    my ($path,$segment,$bestpath,$len,$scores,$bestscores,@bends,$sk);
+    my ($path,$segment,$bestpath,$len,$scores,$bestscores,@bends,$skl);
     my ($crit,$cs,$i,$cmp);
     foreach $path (@paths) {
-	$sk= shift @solkinds;
-	o("%   possible path $sk $path\n");
+	$skl= shift @solkinds;
+	o("%   possible path @$skl $path\n");
 	$len= 0;
 	@bends= ();
 	foreach $segment (@$path) {
@@ -625,8 +642,8 @@ sub cmd_join {
 		elsif ($1 eq 'end') { $cs= $bends[$#bends]; }
 		else { $cs=0; map { $cs += $_ } @bends; }
 		$cs= -$cs if $2 eq 'left';
-	    } elsif ($crit =~ m/^(\!?)(twoarcs|arcline|arcsline)$/) {
-		$cs= ($2 eq $sk) != ($1 eq '!');
+	    } elsif ($crit =~ m/^(\!?)(twoarcs|arcline|cross|loop)$/) {
+		$cs= !!(grep { $2 eq $_ } @$skl) != ($1 eq '!');
 	    } else {
 		die "unknown sort criterion $crit";
 	    }