RosettaCodeData/Task/Arithmetic-Complex/Action-/arithmetic-complex.action

136 lines
3.1 KiB
Plaintext

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
DEFINE R_="+0"
DEFINE I_="+6"
TYPE Complex=[CARD cr1,cr2,cr3,ci1,ci2,ci3]
BYTE FUNC Positive(REAL POINTER x)
BYTE ARRAY tmp
tmp=x
IF (tmp(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
PROC PrintComplex(Complex POINTER x)
PrintR(x R_)
IF Positive(x I_) THEN
Put('+)
FI
PrintR(x I_) Put('i)
RETURN
PROC PrintComplexXYZ(Complex POINTER x,y,z CHAR ARRAY s)
Print("(") PrintComplex(x)
Print(") ") Print(s)
Print(" (") PrintComplex(y)
Print(") = ") PrintComplex(z)
PutE()
RETURN
PROC PrintComplexXY(Complex POINTER x,y CHAR ARRAY s)
Print(s)
Print("(") PrintComplex(x)
Print(") = ") PrintComplex(y)
PutE()
RETURN
PROC ComplexAdd(Complex POINTER x,y,res)
RealAdd(x R_,y R_,res R_) ;res.r=x.r+y.r
RealAdd(x I_,y I_,res I_) ;res.i=x.i+y.i
RETURN
PROC ComplexSub(Complex POINTER x,y,res)
RealSub(x R_,y R_,res R_) ;res.r=x.r-y.r
RealSub(x I_,y I_,res I_) ;res.i=x.i-y.i
RETURN
PROC ComplexMult(Complex POINTER x,y,res)
REAL tmp1,tmp2
RealMult(x R_,y R_,tmp1) ;tmp1=x.r*y.r
RealMult(x I_,y I_,tmp2) ;tmp2=x.i*y.i
RealSub(tmp1,tmp2,res R_) ;res.r=x.r*y.r-x.i*y.i
RealMult(x R_,y I_,tmp1) ;tmp1=x.r*y.i
RealMult(x I_,y R_,tmp2) ;tmp2=x.i*y.r
RealAdd(tmp1,tmp2,res I_) ;res.i=x.r*y.i+x.i*y.r
RETURN
PROC ComplexDiv(Complex POINTER x,y,res)
REAL tmp1,tmp2,tmp3,tmp4
RealMult(x R_,y R_,tmp1) ;tmp1=x.r*y.r
RealMult(x I_,y I_,tmp2) ;tmp2=x.i*y.i
RealAdd(tmp1,tmp2,tmp3) ;tmp3=x.r*y.r+x.i*y.i
RealMult(y R_,y R_,tmp1) ;tmp1=y.r^2
RealMult(y I_,y I_,tmp2) ;tmp2=y.i^2
RealAdd(tmp1,tmp2,tmp4) ;tmp4=y.r^2+y.i^2
RealDiv(tmp3,tmp4,res R_) ;res.r=(x.r*y.r+x.i*y.i)/(y.r^2+y.i^2)
RealMult(x I_,y R_,tmp1) ;tmp1=x.i*y.r
RealMult(x R_,y I_,tmp2) ;tmp2=x.r*y.i
RealSub(tmp1,tmp2,tmp3) ;tmp3=x.i*y.r-x.r*y.i
RealDiv(tmp3,tmp4,res I_) ;res.i=(x.i*y.r-x.r*y.i)/(y.r^2+y.i^2)
RETURN
PROC ComplexNeg(Complex POINTER x,res)
REAL neg
ValR("-1",neg) ;neg=-1
RealMult(x R_,neg,res R_) ;res.r=-x.r
RealMult(x I_,neg,res I_) ;res.r=-x.r
RETURN
PROC ComplexInv(Complex POINTER x,res)
REAL tmp1,tmp2,tmp3
RealMult(x R_,x R_,tmp1) ;tmp1=x.r^2
RealMult(x I_,x I_,tmp2) ;tmp2=x.i^2
RealAdd(tmp1,tmp2,tmp3) ;tmp3=x.r^2+x.i^2
RealDiv(x R_,tmp3,res R_) ;res.r=x.r/(x.r^2+x.i^2)
ValR("-1",tmp1) ;tmp1=-1
RealMult(x I_,tmp1,tmp2) ;tmp2=-x.i
RealDiv(tmp2,tmp3,res I_) ;res.i=-x.i/(x.r^2+x.i^2)
RETURN
PROC ComplexConj(Complex POINTER x,res)
REAL neg
ValR("-1",neg) ;neg=-1
RealAssign(x R_,res R_) ;res.r=x.r
RealMult(x I_,neg,res I_) ;res.i=-x.i
RETURN
PROC Main()
Complex x,y,res
IntToReal(5,x R_) IntToReal(3,x I_)
IntToReal(4,y R_) ValR("-3",y I_)
Put(125) PutE() ;clear screen
ComplexAdd(x,y,res)
PrintComplexXYZ(x,y,res,"+")
ComplexSub(x,y,res)
PrintComplexXYZ(x,y,res,"-")
ComplexMult(x,y,res)
PrintComplexXYZ(x,y,res,"*")
ComplexDiv(x,y,res)
PrintComplexXYZ(x,y,res,"/")
ComplexNeg(y,res)
PrintComplexXY(y,res," -")
ComplexInv(y,res)
PrintComplexXY(y,res," 1 / ")
ComplexConj(y,res)
PrintComplexXY(y,res," conj")
RETURN