view release on metacpan or  search on metacpan

Cog.pm  view on Meta::CPAN

    $gp->gmove('x',$tx+$xi,'y',$ty+$yi); 

    $gp->gmove('x',$x+$xi,'y',$y+$yi,'z',$z,'f',$feed);

    $x+=$dx/2; # this takes us to next addendum point 
    $y+=$dy/2; 

    }
    }

    $gp->gmove('z',0.1);
    $gp->gmove('x',$xi,'y',$yi); 

}

sub smooth
{
    # given a circle radius b and a point on circumference l2
    # the plan is to smooth the join between the line l1/l2  (each of these are points) and the circle circumference by 
    # replacing a bit of the line l1/l2 with a circle of radius r. 
    # The following are supplied where x1 y1 is l1 point 1, x2, y2 point 2 or l2.

    # so call with l1,l2,b ,r 
    # what comes back is l1 (unchanged), ,replacement l2 point sa which is start of arc, l1,sa are on the line 
    # l1,l2 but sa is nearer l1 than l2. 
    # ea where ea is on the original arc radius b, like l2, but is moved away from original l2. 
    # sa, ea can be joined with arc radius b.
 

    my ($w,$x1,$y1,$x2,$y2,$b,$r)=@_;

    # print "smooth x1=$x1,y1=$y1,x2=$x2,y2=$y2,b=$b,r=$r\n";

    #($x1,$y1,$x2,$y2,$b,$r)=(-0.2 , 0.2 , -0.707 , 0.707 , 1.0 , 0.1); 
#    ($x1,$y1,$x2,$y2,$b,$r)=   (-0.279378067455943, 0.65017874253593, 0.702760341741972, 0.0831408677831007, 0.9,0.1); 

    my $ks; 
  
    # straight line l1 l2 has eqn y=mx+c 

    my $m=($y2-$y1)/($x2-$x1); 
    my $c=$y1-($y2-$y1)*$x1/($x2-$x1); 
    $ks=$r>0?1:-1;  
#   $ks=-$ks if ($y2>0);
    $r=abs($r);  
    $ks=-$ks if ($x1<$x2);

    
    # line paralell to this and distance r away is y=mx+j where j=c+k or j=c-k 

    my $k = abs($r) * sqrt( (($x2-$x1)**2+($y2-$y1)**2)/($x2-$x1)**2); 
    my $j=$c+$k*$ks;  # ks is the sign of k from above. 

    # we need to solve this with the circle x^2+y^2=(b+r)^2
    # substituting for y in here gives 
    # 
    # x^2+y^2=(b+r)^2
    # y=mx+j
    # x^2+m^2x^2+2mxj+j^2=(b+r)^2
    # (1+m^2) x^2 + 2mj x +j^2-(b+r)^2=0 
    # use quadratic equation formula to find x: 
    # x=(-b+- sqrt(b^2-4ac)/2a
    #
    # x=(-2mj +- sqrt(4m^2j^2-4(1+m^2)(j^2-(b+r)^2)))/2(1+m^2)
    # This is the center point of the arc. 

    # s is the distance between c and l2, we now have x and y coords for both c and l2. 
    # u^2=s^2-r^2 and is distance from l2 in direction of l1  for the new l2 point at start of smoothing arc. 
    # The end of the arc is oc scaled such that distance is b, the radius of the circle. 
    $r=-$r if (dist(0,0,$x1,$y1)<$b);
    
    my $cxa=(-2*$m*$j + sqrt(abs(4*$m**2*$j**2-4*(1+$m**2)*($j**2-($b+$r)**2))))/2/(1+$m**2);
    my $cxb=(-2*$m*$j - sqrt(abs(4*$m**2*$j**2-4*(1+$m**2)*($j**2-($b+$r)**2))))/2/(1+$m**2);   # This is the other root of the quadratic. 
                                                                                        # use the one closest to l2? 
    my $cya=$m*$cxa+$j; 
    my $cyb=$m*$cxb+$j; 

    ($cxa,$cya,$cxb,$cyb)=($cxb,$cyb,$cxa,$cya) if (dist($x2,$y2,$cxb,$cyb)<dist($x2,$y2,$cxa,$cya)); # want nearest root to l2 .
    # swap rather than assign so that we still have the other root if we need to look at it for debug purposes.  

    my $s=dist($x2,$y2,$cxa,$cya);
    my $u=sqrt($s**2-$r**2);  
    my $sax=$x2+($x1-$x2)*$u/dist($x1,$y1,$x2,$y2);    #start of arc
    my $say=$y2+($y1-$y2)*$u/dist($x1,$y1,$x2,$y2); 
    my $eax=$cxa*$b/dist(0,0,$cxa,$cya); 
    my $eay=$cya*$b/dist(0,0,$cxa,$cya); 

    return ($x1,$y1,$sax,$say,$eax,$eay);              #ending on the circle

    # The code below is used for graphing out test cases. Its debug only. 
    my $gd=gdcode::new(undef,"test.png",6.0,2500,2500); 
    $gd->gmove('z',0.1);
    $gd->gmove('x',$x1,'y',$y1); 
    $gd->gmove('z',-0.1); 
    $gd->gmove('x',$x2,'y',$y2); 

    $gd->gmove('z',0.1);         
    $gd->gmove('x',0,'y',$b); 
    $gd->gmove('z',-0.1);             
    $gd->garcccw('x',0,'y',-$b,'r',$b); 
    $gd->garcccw('x',0,'y',$b,'r',$b); 


    $gd->gmove('z',0.1); 
    # ($cxa,$cya)=($cxb,$cyb);  # want to see the other one ? 
    $gd->gmove('x',$cxa+0.05,'y',$cya+0.05);             # mark the center with an X
    $gd->gmove('x',$cxa-0.05,'y',$cya-0.05,'z',-0.1); 
    $gd->gmove('x',$cxa+0.05,'y',$cya-0.05,'z',0.1); 
    $gd->gmove('x',$cxa-0.05,'y',$cya+0.05,'z',-0.1); 

#    $gd->gmove('x',$cxa,'y',$cya+$r,'z',0.1); 
#    $gd->garcccw('x',$cxa,'y',$cya-$r,'r',abs($r),'z',-0.1); 
#    $gd->garcccw('x',$cxa,'y',$cya+$r,'r',abs($r),'z',-0.1);

    
    $gd->gmove('x',$sax,'y',$say,'z',0.1); 
    $gd->garccw('x',$eax,'y',$eay,'r',abs($r),'z',-0.1);    


    $gd->gend(); 
    die;