From ff1ad670d7e4ca58c34a9ff410030fa77686fadd Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 24 Jan 2004 21:52:02 +0000 Subject: [PATCH] tried sgt's join, obviously misimplemented. But spec -ve pts for idex works --- layout/layout | 86 ++++++++++++++++++++++++++++++++++++++++++------- layout/testfile | 5 +++ 2 files changed, 79 insertions(+), 12 deletions(-) diff --git a/layout/layout b/layout/layout index 72c2f7c..b4a1e89 100755 --- a/layout/layout +++ b/layout/layout @@ -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"; } diff --git a/layout/testfile b/layout/testfile index 54d46b0..30261bb 100644 --- a/layout/testfile +++ b/layout/testfile @@ -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 -- 2.30.2