Daily Programmer #190 Hard

main.f

include mini-oof.fs

: 2fdup ( f1 f2 -- f1 f2 f1 f2 ) fover fover ;
: -frot ( f1 f2 f3 -- f3 f1 f2 ) frot frot ;
: 2f/ ( f1 f2 f3 f4 -- f1/f3 f2/f4 )
  frot fswap f/ -frot f/ fswap ;

object class
  method init
  method conjugate
  method modulus
  method complex>string
  float% field real
  float% field imag
end-class complex

:noname ( r i -- ) dup imag f! real f! ; complex defines init
:noname ( -- c )
  dup real f@ imag f@ -1e f*
  complex new dup init ; complex defines conjugate
:noname ( -- f ) 
  dup
  real f@ fdup f*
  imag f@ fdup f*
  f+ fsqrt ; complex defines modulus

: 2real ( c1 c2 -- f1 f2 ) real f@ real f@ fswap ;
: 2imag ( c1 c2 -- f1 f2 ) imag f@ imag f@ fswap ;
  
: complex+ ( c c -- c )
  2dup 2real f+ 2imag f+
  complex new dup init ;
: complex- ( c c -- c )
  2dup 2real f- 2imag f-
  complex new dup init ;
: complex* ( c c -- c )
  2dup 2real f* 2dup 2imag f* f-
  2dup real f@ imag f@ f* imag f@ real f@ f* f+
  complex new dup init ;
: complex/ ( c c -- c )
  tuck conjugate complex*
  dup real f@ imag f@
  modulus fdup f* fdup 2f/ 
  complex new dup init ;

complex new constant t1
complex new constant t2
3e 5e t1 init
8e -1e t2 init

: complex. ( c -- )
  dup real f@ f. imag f@ f. ;

." + " t1 t2 complex+ complex. cr
." - " t1 t2 complex- complex. cr
." * " t1 t2 complex* complex. cr
." / " t1 t2 complex/ complex. cr
." modulo " t1 modulus f. cr

bye