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)=@_;
}
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 ($) {
}
}
+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);
$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";
}