\\ *** Complexe Arithmetik *** 23sep91py \ Loadscreen 15aug03py \needs float import float \ include float.fb Module Complex float also Complex : complex' 2* floats ; : complex+ float+ float+ ; 1 6 +thru toss Module; \ simple operations 02may95py: cdup fover fover ; macro : cdrop fdrop fdrop ; macro : cover fover3 fover3 ; macro Code c>r \$14 # RP sub .fx \$A RP D) fstp .fx RP ) fstp Next end-code macro Code cr> .fx RP ) fld .fx \$A RP D) fld \$14 # RP add Next end-code macro Code cswap 1 ST fxch 3 ST fxch 1 ST fxch 2 ST fxch Next end-code macro : cpick 2* 1+ >r r@ fpick r> fpick ; : cpin 2* 1+ >r r@ fpin r> fpin ; : cdepth fdepth 2/ ; : crot c>r cswap cr> cswap ; : c-rot cswap c>r cswap cr> ; : cf@ dup >r f@ r> float+ f@ ; : cf! dup >r float+ f! r> f! ; \ simple operations 15aug03pyCode c+ 2 STP fadd 2 STP fadd Next end-code macro Code c- 2 STP fsubr 2 STP fsubr Next end-code macro Code cr- 2 STP fsub 2 STP fsub Next end-code macro \ : c+ frot f+ f-rot f+ fswap ; \ : c- fnegate frot f+ f-rot f- fswap ; Code c* 0 ST fld 4 ST fmul 2 ST fld 4 ST fmul 1 STP fadd 4 ST fxch ( i3 i1 r2 i2 r1 ) 2 STP fmul 2 STP fmul 1 STP fsub 1 ST fxch Next end-code \ : c* fdup 4 fpick f* f>r fover 3 fpick f* f>r \ f>r fswap fr> f* f>r f* fr> f- fr> fr> f+ ; Code cscale 2 r f* fr> ; \ simple operations 15aug03py : cnegate fnegate fswap fnegate fswap ; : cconj fnegate ; macro : c*i fnegate fswap ; macro : c/i fswap fnegate ; macro : csqabs fdup f* fswap fdup f* f+ ; : 1/c cconj cdup csqabs 1/f cscale ; : c/ 1/c c* ; : cabs csqabs fsqrt !0 ; : c2/ f2/ f>r f2/ fr> ; : c2* f2* f>r f2* fr> ; \ cexp cln 15aug94py : cexp fsincos fswap frot fexp cscale ; : cln cdup cabs fdrop fln f>r fswap fatan2 fr> fswap ; : csqrt cln c2/ cexp ; : c** cswap cln c* cexp ; \ Test: Fibonacci-Zahlen !1 !5 fsqrt f+ f2/ fconstant g !1 g f- fconstant -h : cfib cdup c>r g !0 cswap c** cr> cswap c>r -h !0 cswap c** cnegate cr> c+ [ g -h f- 1/f ] FLiteral cscale ; \ complexe Operationen 15aug94py : csinh cexp cdup 1/c c- c2/ ; : ccosh cexp cdup 1/c c+ c2/ ; : ctanh c2* cexp cdup !1 !0 c- cswap !1 !0 c+ c/ ; : csin c*i csinh c/i ; : ccos c*i ccosh ; : ctan c*i ctanh c/i ; : Re fdrop !0 ; : Im fnip !0 ; \ Ausgabe 16may93py : c0= f0= >r f0= r> and ; Defer fc. ' f. IS fc. : c. cdup c0= IF cdrop ." 0 " exit THEN fdup f0= IF fdrop fc. exit THEN fswap fdup f0= IF fdrop ELSE fc. curleft fdup f0> IF ." +" THEN THEN fc. curleft ." i " ; : c.s cdepth 0 ?DO i cpick cswap c>r c. cr> ?cr LOOP ;