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