From: ian Date: Tue, 3 Feb 2004 21:48:05 +0000 (+0000) Subject: arcsline joining; new a_normalise; new line(); better comments in cmd_join results X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=2f2250bf2df2ed1885cfbf1caef71b62317a8c3d;p=trains.git arcsline joining; new a_normalise; new line(); better comments in cmd_join results --- diff --git a/layout/layout b/layout/layout index 88c24fd..6ae94cd 100755 --- 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); }