Anonymous user
Circles of given radius through two points: Difference between revisions
Circles of given radius through two points (view source)
Revision as of 18:42, 17 November 2021
, 2 years agoAdded solution for Action!
(Added solution for Action!) |
|||
Line 122:
You can construct the following circles:
ERROR: radius of zero
</pre>
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
BYTE FUNC Equal(REAL POINTER a,b)
BYTE ARRAY x,y
x=a y=b
IF x(0)=y(0) AND x(1)=y(1) AND x(2)=y(2) THEN
RETURN (1)
FI
RETURN (0)
BYTE FUNC GreaterOrEqual(REAL POINTER left,right)
REAL diff
BYTE ARRAY x
RealSub(left,right,diff)
x=diff
IF (x(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
BYTE FUNC Greater(REAL POINTER left,right)
IF GreaterOrEqual(left,right)=1 AND
Equal(left,right)=0 THEN
RETURN (0)
FI
RETURN (0)
PROC Sqrt(REAL POINTER a,b)
REAL z,half
IntToReal(0,z)
ValR("0.5",half)
IF Equal(a,z) THEN
RealAssign(z,b)
ELSE
Power(a,half,b)
FI
RETURN
PROC Circles(CHAR ARRAY sx1,sy1,sx2,sy2,sr)
REAL x1,y1,x2,y2,r,x,y,bx,by,pb,cb,xx,yy
REAL z,half,two,tmp1,tmp2,tmp3
ValR(sx1,x1) ValR(sy1,y1)
ValR(sx2,x2) ValR(sy2,y2)
ValR(sr,r) ValR("0.5",half)
IntToReal(0,z)
IntToReal(2,two)
Print("p1=(") PrintR(x1) Put(32)
PrintR(y1) Print(") p2=(")
PrintR(x2) Put(32) PrintR(y2)
Print(") r=") PrintR(r) Print(" -> ")
IF Equal(r,z) THEN
PrintE("Radius is zero, no circles") PutE()
RETURN
FI
RealSub(x2,x1,tmp1) ;tmp1=x2-x1
RealDiv(tmp1,two,x) ;x=(x2-x1)/2
RealSub(y2,y1,tmp1) ;tmp1=y2-y1
RealDiv(tmp1,two,y) ;y=(y2-y1)/2
RealAdd(x1,x,bx) ;bx=x1+x
RealAdd(y1,y,by) ;bx=x1+x
RealMult(x,x,tmp1) ;tmp1=x^2
RealMult(y,y,tmp2) ;tmp2=y^2
RealAdd(tmp1,tmp2,tmp3) ;tmp3=x^2+y^2
Sqrt(tmp3,pb) ;pb=sqrt(x^2+y^2)
IF Equal(pb,z) THEN
PrintE("Infinite circles")
ELSEIF Greater(pb,r) THEN
PrintE("Points are too far, no circles")
ELSE
RealMult(r,r,tmp1) ;tmp1=r^2
RealMult(pb,pb,tmp2) ;tmp2=pb^2
RealSub(tmp1,tmp2,tmp3) ;tmp3=r^2-pb^2
Sqrt(tmp3,cb) ;cb=sqrt(r^2-pb^2)
RealMult(y,cb,tmp1) ;tmp1=y*cb
RealDiv(tmp1,pb,xx) ;xx=y*cb/pb
RealMult(x,cb,tmp1) ;tmp1=x*cb
RealDiv(tmp1,pb,yy) ;yy=x*cb/pb
RealSub(bx,xx,tmp1) ;tmp1=bx-xx
Print("c1=(") PrintR(tmp1) Put(32)
RealAdd(by,yy,tmp1) ;tmp1=by+yy
PrintR(tmp1) Print(") c2=(")
RealAdd(bx,xx,tmp1) ;tmp1=bx+xx
PrintR(tmp1) Put(32)
RealSub(by,yy,tmp1) ;tmp1=by-yy
PrintR(tmp1) PrintE(")")
FI
PutE()
RETURN
PROC Main()
Put(125) PutE() ;clear the screen
Circles("0.1234","0.9876","0.8765","0.2345","2.0")
Circles("0.0000","2.0000","0.0000","0.0000","1.0")
Circles("0.1234","0.9876","0.1234","0.9876","2.0")
Circles("0.1234","0.9876","0.8765","0.2345","0.5")
Circles("0.1234","0.9876","0.1234","0.9876","0.0")
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Circles_of_given_radius_through_two_points.png Screenshot from Atari 8-bit computer]
<pre>
p1=(.1234 .9876) p2=(.8765 .2345) r=2 -> c1=(1.86311176 1.97421176) c2=(-0.86321176 -0.75211176)
p1=(0 2) p2=(0 0) r=1 -> c1=(0 1) c2=(0 1)
p1=(.1234 .9876) p2=(.1234 .9876) r=2 -> Infinite circles
p1=(.1234 .9876) p2=(.8765 .2345) r=.5 -> c1=(1.19528365 1.30638365) c2=(-0.1953836533 -0.0842836533)
p1=(.1234 .9876) p2=(.1234 .9876) r=0 -> Radius is zero, no circles
</pre>
| |||