Circles of given radius through two points: Difference between revisions

Using Real Math module
(Added solution for Action!)
(Using Real Math module)
Line 126:
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
{{libheader|Action! Real Math}}
<lang Action!>INCLUDE "D2H6:REALREALMATH.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) ValRIntToReal("0.5"2,halftwo)
IntToReal(0,z)
IntToReal(2,two)
 
Print("p1=(") PrintR(x1) Put(32)
Line 183 ⟶ 142:
Print(") r=") PrintR(r) Print(" -> ")
 
IF EqualRealEqual(r,zrzero) THEN
PrintE("Radius is zero, no circles") PutE()
RETURN
Line 202 ⟶ 161:
Sqrt(tmp3,pb) ;pb=sqrt(x^2+y^2)
 
IF EqualRealEqual(pb,zrzero) THEN
PrintE("Infinite circles")
ELSEIF GreaterRealGreater(pb,r) THEN
PrintE("Points are too far, no circles")
ELSE
Line 235 ⟶ 194:
PROC Main()
Put(125) PutE() ;clear the screen
MathInit()
Circles("0.1234","0.9876","0.8765","0.2345","2.0")
Circles("0.0000","2.0000","0.0000","0.0000","1.0")
Anonymous user