chiark / gitweb /
tried sgt's join, obviously misimplemented. But spec -ve pts for idex works
authorian <ian>
Sat, 24 Jan 2004 21:52:02 +0000 (21:52 +0000)
committerian <ian>
Sat, 24 Jan 2004 21:52:02 +0000 (21:52 +0000)
layout/layout
layout/testfile

index 72c2f7cb142ef743ba4a4fb6f277f0dbb03ca700..b4a1e8945de2bbb9c8706028c4657343e9f8474f 100755 (executable)
@@ -84,7 +84,25 @@ sub ev_lincomb ($$$$) {
     my ($q) = 1.0-$p;
     map { $r->{$_} = $q * $a->{$_} + $p * $b->{$_} } qw(X Y A);
     $r;
-}    
+}
+sub v_bearing ($$) {
+    # v_bearing(A,B)
+    # returns bearing of B from A (in radians)
+    # A->{A} and B->{A} are ignored
+    my ($a,$b)= @_;
+    return atan2($b->{Y} - $a->{Y},
+                $b->{X} - $a->{X});
+}               
+sub v_dist ($$) {
+    # v_dist(A,B)
+    # returns distance from A to B
+    # A->{A} and B->{A} are ignored
+    my ($a,$b)= @_;
+    my ($xd,$yd);
+    $xd= $b->{X} - $a->{X};
+    $yd= $b->{Y} - $a->{Y};
+    return sqrt($xd*$xd + $yd*$yd);
+}               
 
 sub canf ($$) {
     my ($converter,$defaulter)=@_;
@@ -126,13 +144,19 @@ sub cva_idstr ($) {
 }
 sub cva_idex ($) {
     my ($sp,$id)=@_;
-    my ($r,$d,$k);
-    $id=cva_idstr($sp);
+    my ($r,$d,$k,$neg,$na);
+    $neg= $sp =~ s/^\-//;
+    $id= cva_idstr($sp);
     die "unknown $id" unless defined $ctx->{Loc}{$id};
     $r= $ctx->{Loc}{$id};
     $d= "idex $id";
     foreach $k (sort keys %$r) { $d .= " $k=$r->{$k}"; }
     printf DEBUG "%s\n", $d;
+    if ($neg) {
+       $na= $r->{A} + $pi;
+       $na -= 2*$pi if $na >= 2*$pi;
+       $r= { X => $r->{X}, Y => $r->{Y}, A => $na };
+    }
     return $r;
 }
 sub cva_idnew ($) {
@@ -342,6 +366,52 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     }
 }
 
+sub arc ($$$$$$$) {
+    my ($to, $endstatuses, $ctr,$from,$fromsense, $radius,$delta) = @_;
+    # does parametric_segment to draw an arc centred on $ctr
+    # from $from with radius $radius (this must be consistent!)
+    # and 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;
+    $to->{X}= $ctr->{X} - $radius * sin($beta);
+    $to->{Y}= $ctr->{Y} + $radius * cos($beta);
+    parametric_segment($endstatuses, 0.0,1.0, abs($radius*$delta), sub {
+       my ($beta) = $from->{A} + $delta * $p;
+       return { X => $ctr->{X} - $radius * sin($beta),
+                Y => $ctr->{Y} + $radius * cos($beta),
+                A => $beta }
+    });
+}
+
+sub cmd_join {
+    my ($from,$to,$how);
+    $from= can(\&cva_idex);
+    $to= can(\&cva_idex);
+    $how= can(cvam_enum(qw(arcs arcsm)));
+    my ($sigma,$distfact, $theta,$phi, $a,$b,$c,$d2, $r,$cfrom);
+    $sigma= v_bearing($from,$to);
+    $distfact= v_dist($from,$to);
+    $theta= $from - $sigma;
+    $phi= $to + 2 * $pi - $sigma;
+    $a= 2 * (1 + sin($theta - $phi));
+    $b= 2 * (sin($theta) - sin($phi));
+    $c= -1;
+    die "too close" if $a<1.1e-10;
+    $d2= $b*$b - 4*$a*$c;
+    $pm = $how =~ /m$/ ? -1 : +1;
+    $r= (-$b + $pm*sqrt($d2))/$a;
+    $rf= $r*$distfact;
+    $cfrom= ev_compose({}, $from, { Y =>  $rf, X => 0, A => 0 });
+    $cto=   ev_compose({}, $to,   { Y => -$rf, X => 0, A => 0 });
+    $cbearing= v_bearing($cfrom,$cto);
+    arc({}, IS, $cfrom,$from,1.0,  $rf, $cbearing - $cfrom->{A});
+    arc({}, IS, $cto,  $to, -1.0, -$rf, $cbearing - $cfrom->{A} + 2*$pi);
+}
+
 sub cmd_extend {
     my ($from,$to,$radius,$ctr,$beta,$ang,$how,$sign_r);
     $from= can(\&cva_idex);
@@ -400,15 +470,7 @@ sub cmd_extend {
            $beta -= $sign_ang * $sign_r * $beta_interval * $pi;
        }       
     printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
-       $to->{A}= $beta;
-       $to->{X}= $ctr->{X} - $radius * sin($beta);
-       $to->{Y}= $ctr->{Y} + $radius * cos($beta);
-       parametric_segment(II, 0.0, 1.0, abs($radius*$delta), sub {
-           my ($beta) = $from->{A} + $delta * $p;
-           return { X => $ctr->{X} - $radius * sin($beta),
-                    Y => $ctr->{Y} + $radius * cos($beta),
-                    A => $beta }
-       });
+       arc($to, II, ,$ctr,$from,1.0, $radius,$delta);
     }
     printf DEBUG "to $to->{X} $to->{Y} $to->{A}\n";
 }
index 54d46b0bbf6d2403c0a635cb9d3b179d3478078d..30261bb0f685dc91033cd69028e0aa8a73ca9901 100644 (file)
@@ -16,3 +16,8 @@ extend a b1 ang 22.5 -228
 extend b1 c1 uptoang 60 -228
 extend c1 d1 upto f
 extend d1 e1 len 100
+
+abs j 100 600 27
+extend -j je len 50
+
+join j f arcs