arcsline joining; new a_normalise; new line(); better comments in cmd_join results

diff --git a/layout/layout b/layout/layout
index 88c24fd7070cf0d93b2aa90fd44aba820038d324..6ae94cdd62ebf653dc35e5da79a8e17d603175e1 100755 (executable)
--- a/layout/layout
+++ b/layout/layout
@@ -146,6 +146,15 @@ sub ev_lincomb ($$$$) {
     map { $r->{$_} = $q * $a->{$_} + $p * $b->{$_} } qw(X Y A);
     $r;
 }
+sub a_normalise ($$) {
+    # a_normalise(A,Z)
+    # adds or subtracts 2*$pi to/from A until it is in [ Z , Z+2*$pi >
+    my ($a,$z)=@_;
+    my ($r);
+    $r= $z + fmod($a - $z, 2.0*$pi);
+    $r += 2*$pi if $r < $z;
+    return $r;
+}
 sub ev_bearing ($$) {
     # ev_bearing(A,B)
     # returns bearing of B from A
@@ -155,9 +164,8 @@ sub ev_bearing ($$) {
     my ($r);
     $r= atan2($b->{Y} - $a->{Y},
              $b->{X} - $a->{X});
-    $r -= 4.0 * $pi;
-    while ($r < $a->{A}) { $r += 2.0 * $pi; }
-    $r;
+    $r= a_normalise($r,$a->{A});
+    return $r;
 }               
 sub v_dist ($$) {
     # v_dist(A,B)
@@ -254,7 +262,7 @@ sub cva_idex ($) {
     }
     if ($neg) {
        $na= $r->{A} + $pi;
-       $na -= 2*$pi if $na >= 2*$pi;
+       $na= a_normalise($na,0);
        $r= { X => $r->{X}, Y => $r->{Y}, A => $na };
     }
     return $r;
@@ -494,7 +502,7 @@ sub arc ($$$$$) {
     $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;
+    return if abs($delta*$radius) < 1e-9;
     parametric_segment(0.0,1.0, abs($radius*$delta), $radius, sub {
        my ($beta) = $from->{A} + $delta * $param;
        return { X => $ctr->{X} - $radius * sin($beta),
@@ -509,7 +517,11 @@ sub cmd_join {
     $to= can(\&cva_idex);
     $minradius= can(\&cva_len);
     my (@paths,@solkinds);
+    o("%   join ".loc2dbg($from)."..".loc2dbg($to)." $minradius\n");
     do {
+       # two circular arcs of equal maximum possible radius
+       # algorithm courtesy of Simon Tatham (`Railway problem',
+       # pers.comm. to ijackson@chiark 23.1.2004)
        my ($sigma,$distfact, $theta,$phi, $a,$b,$c,$d, $m,$r, $radius);
        my ($cvec,$cfrom,$cto,$midpt, $delta1,$delta2, $path,$reverse);
        $sigma= ev_bearing($from,$to);
@@ -520,11 +532,17 @@ sub cmd_join {
        $b= 2 * (cos($theta) - cos($phi));
        $c= -1;
        $d= sqrt($b*$b - 4*$a*$c);
+       o("%     twoarcs theta=".ang2deg($theta)." phi=".ang2deg($phi).
+         " ${a}r^2 + ${b}r + ${c} = 0\n");
        foreach $m (qw(-1 1)) {
-           next if $a < 1e-6;
+           if ($a < 1e-6) {
+               o("%     twoarcs $m insoluble\n");
+               next;
+           }
            $r= -0.5 * (-$b + $m*$d) / $a;
            $radius= -$r * $distfact;
-           next if abs($radius) < $minradius;
+           o("%     twoarcs $m radius $radius ");
+           if (abs($radius) < $minradius) { o("too-small"); 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);
@@ -535,6 +553,7 @@ sub cmd_join {
            }
            $delta1= ev_bearing($cfrom, $midpt) - $cfrom->{A};
            $delta2= ev_bearing($cto,   $midpt) - $cto->{A};
+           o("ok deltas ".ang2deg($delta1)." ".ang2deg($delta2)."\n");
            if ($reverse<0) {
                $delta1 -= 2*$pi;
                $delta2 -= 2*$pi;
@@ -546,6 +565,35 @@ sub cmd_join {
            push @solkinds, 'twoarcs';
        }
     } while 0;
+    if ($minradius<=1e-6) {
+       o("%     arcsline no-radius\n");
+    } else {
+       # two circular arcs of specified radius in same direction
+       # with an intervening straight
+       my ($lr, $c_cd,$d_cd,$t,$k,$l, $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';
+       }
+    }
     my ($path,$segment,$bestpath,$len,$scores,$bestscores,@bends,$sk);
     my ($crit,$cs,$i,$cmp);
     foreach $path (@paths) {
@@ -558,12 +606,16 @@ sub cmd_join {
                o("%     Arc C ".loc2dbg($segment->{C}).
                  " R $segment->{R} D ".ang2deg($segment->{D})."\n");
                $len += abs($segment->{R} * $segment->{D});
-               push @bends, signum($segment->{R} * $segment->{D}); # right +ve
+               push @bends, -abs($segment->{R}) * $segment->{D}; # right +ve
+           } elsif ($segment->{T} eq Line) {
+               o("%     Line A ".loc2dbg($segment->{A}).
+                 " B ".loc2dbg($segment->{A})." L $segment->{L}\n");
+               $len += abs($segment->{L});
            } else {
                die "unknown segment $segment->{T}";
            }
        }
-       o("%    length $len\n");
+       o("%    length $len bends @bends.\n");
        $scores= [];
        foreach $crit (@al, 'short') {
            if ($crit eq 'long') { $cs= $len; }
@@ -575,6 +627,8 @@ sub cmd_join {
                $cs= -$cs if $2 eq 'left';
            } elsif ($crit =~ m/^(\!?)(twoarcs|arcline|arcsline)$/) {
                $cs= ($2 eq $sk) != ($1 eq '!');
+           } else {
+               die "unknown sort criterion $crit";
            }
            push @$scores, $cs;
        }
@@ -594,12 +648,21 @@ sub cmd_join {
     foreach $segment (@$bestpath) {
        if ($segment->{T} eq 'Arc') {
            arc({}, $segment->{C},$segment->{F},$segment->{R},$segment->{D});
+       } elsif ($segment->{T} eq 'Line') {
+           line($segment->{A}, $segment->{B}, $segment->{L});
        } else {
            die "unknown segment";
        }
     }
 }
 
+sub line ($$$) {
+    my ($from,$to,$len) = @_;
+    parametric_segment(0.0, 1.0, abs($len), undef, sub {
+       ev_lincomb({}, $from, $to, $param);
+    });
+}
+
 sub cmd_extend {
     my ($from,$to,$radius,$len,$upto,$ctr,$beta,$ang,$how,$sign_r);
     $from= can(\&cva_idex);
@@ -623,9 +686,7 @@ sub cmd_extend {
        $to->{X}= $from->{X} + $len * cos($from->{A});
        $to->{Y}= $from->{Y} + $len * sin($from->{A});
        $to->{A}= $from->{A};
-       parametric_segment(0.0, 1.0, abs($len), undef, sub {
-           ev_lincomb({}, $from, $to, $param);
-       });
+       line($from,$to,$len);
     } else {
        my ($sign_r, $sign_ang, $ctr, $beta_interval, $beta, $delta);
        print DEBUG "radius >$radius<\n";
@@ -659,7 +720,7 @@ sub cmd_extend {
            $delta= $beta - $from->{A};
            last if $sign_ang * $sign_r * $delta <= 0;
            $beta -= $sign_ang * $sign_r * $beta_interval * $pi;
-       }       
+       }
     printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
        arc($to, ,$ctr,$from, $radius,$delta);
     }