arcsline cross works; offer cross and loop crits for join

diff --git a/layout/informat.txt b/layout/informat.txt
index e434b0db8946d71311cd543da40d120f8079f9b0..c5689b96e454c43f57d152037c4fe902ef697827 100644 (file)
--- 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 6ae94cdd62ebf653dc35e5da79a8e17d603175e1..c2c46d0e14e952a7d8e0a85142f0945d3afa3baf 100755 (executable)
--- 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";
            }