RosettaCodeData/Task/Continued-fraction/Action-/continued-fraction.action
2023-07-01 13:44:08 -04:00

107 lines
1.6 KiB
Text

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
DEFINE PTR="CARD"
DEFINE JSR="$20"
DEFINE RTS="$60"
PROC CoeffA=*(INT n REAL POINTER res)
[JSR $00 $00 ;JSR to address set by SetCoeffA
RTS]
PROC CoeffB=*(INT n REAL POINTER res)
[JSR $00 $00 ;JSR to address set by SetCoeffB
RTS]
PROC SetCoeffA(PTR p)
PTR addr
addr=CoeffA+1 ;location of address of JSR
PokeC(addr,p)
RETURN
PROC SetCoeffB(PTR p)
PTR addr
addr=CoeffB+1 ;location of address of JSR
PokeC(addr,p)
RETURN
PROC Calc(PTR funA,funB INT count REAL POINTER res)
INT i
REAL a,b,tmp
SetCoeffA(funA)
SetCoeffB(funB)
IntToReal(0,res)
i=count
WHILE i>0
DO
CoeffA(i,a)
CoeffB(i,b)
RealAdd(a,res,tmp)
RealDiv(b,tmp,res)
i==-1
OD
CoeffA(0,a)
RealAdd(a,res,tmp)
RealAssign(tmp,res)
RETURN
PROC sqrtA(INT n REAL POINTER res)
IF n>0 THEN
IntToReal(2,res)
ELSE
IntToReal(1,res)
FI
RETURN
PROC sqrtB(INT n REAL POINTER res)
IntToReal(1,res)
RETURN
PROC napierA(INT n REAL POINTER res)
IF n>0 THEN
IntToReal(n,res)
ELSE
IntToReal(2,res)
FI
RETURN
PROC napierB(INT n REAL POINTER res)
IF n>1 THEN
IntToReal(n-1,res)
ELSE
IntToReal(1,res)
FI
RETURN
PROC piA(INT n REAL POINTER res)
IF n>0 THEN
IntToReal(6,res)
ELSE
IntToReal(3,res)
FI
RETURN
PROC piB(INT n REAL POINTER res)
REAL tmp
IntToReal(2*n-1,tmp)
RealMult(tmp,tmp,res)
RETURN
PROC Main()
REAL res
Put(125) PutE() ;clear the screen
Calc(sqrtA,sqrtB,50,res)
Print(" Sqrt2=") PrintRE(res)
Calc(napierA,napierB,50,res)
Print("Napier=") PrintRE(res)
Calc(piA,piB,500,res)
Print(" Pi=") PrintRE(res)
RETURN