\\          *** Fast Fourier Transformation ***        15may93py                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Loadscreen                                           06apr94py                                                                \needs complex  include complex.fb  Onlyforth                                                                                   Onlyforth complex also float also Forth  also Memory                                                                            : Carray ( -- )  Create 0 ,  DOES> @ swap complex' + ;          Carray values                                                   Carray expix                                                                                                                    : r+ BEGIN 2dup xor -rot and dup WHILE 1 rshift REPEAT  drop ;  : reverse  ( n -- )  2/ dup dup 2* 1                              DO  dup I < IF  dup values I values 2dup z@ z@ z! z! THEN           over r+  LOOP  2drop ;                                                                                                                                                    -->             \ reverse carry add                                    23sep05py8 Value #points                                                 : points  ( n --- )  dup to #points dup complex' dup              & values dup @  IF  dup HandleOff  THEN  Handle!  2/            & expix  dup @  IF  dup HandleOff  THEN  Handle!                dup 0 DO  !0 !0 I values z!  LOOP                               !1 !0 0 expix z! 2/ dup 2/ dup 2/ dup 1+ 1                      ?DO  pi I I' 1- 4* fm*/ fsincos fswap   I expix z!  LOOP        ?DO  I' I - 1- expix z@ fswap    I 1+ expix z!  LOOP  dup 2/    ?DO  I' I -    expix z@ fswap fnegate fswap                                                       I    expix z!  LOOP ;       : .values  ( -- )  precision  4 set-precision                     #points 0 DO  I values z@ z. cr  LOOP  set-precision ;        : .expix  ( -- )   precision  4 set-precision                     #points 2/ 0 DO  I expix z@ z. cr  LOOP  set-precision ;      ' .values ALIAS .rvalues                        -->             \ FFT                                                  18aug07pyCode z2dup+ ( c1 c2 -- c1 c2 c1+c2 )                                 3 ST fld  2 ST fadd  3 ST fld  2 ST fadd                        Next end-code  macro                                       \ : z2dup+ zover zover z+ ;                                                                                                     : butterfly ( cexpix addr1 addr2 -- cexpix )                      zdup over z@ z* dup z@ z2dup+ z! zr- z! ;                     : butterflies ( cexpix step off end start -- )                    ?DO  dup I + values I values butterfly                          over +LOOP  zdrop drop ;                                      : fft-step ( n flag step steps -- n flag step )                   0 DO  I over2 I' */ 2/ expix z@                                       over2 IF  fnegate  THEN  I' over2 I butterflies           LOOP ;                                                                                                        -->             \ FFT                                                  17feb09py                                                                : (fft ( n flag -- )  swap dup reverse 1                          BEGIN  2dup >  WHILE  dup 2* swap fft-step                      REPEAT  2drop drop ;                                          : fftscale ( f -- ) #points                                       0 DO  I values dup z@ fover2 zscale z!  LOOP  fdrop ;         : normalize ( -- )  #points s>f 1/f fftscale ;                                                                                  : fft  ( -- )  #points  true (fft ;                             : rfft ( -- )  #points false (fft ;                                                                                             : hamming ( -- )  #points 0 DO                                        I values dup z@ pi I #points fm*/ fsin f**2 f2* zscale z!   LOOP ;                                                        previous