home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 326.lha / KFFT_v1.1 / fftrc < prev    next >
Text File  |  1989-12-23  |  1KB  |  68 lines
  1. \ FFTRC - Fast Fourier Transform - Real in, Complex out.
  2. \
  3. \ KFFT V1.1 (C)Copyright 1989, Jerry Kallaus.  All rights reserved. 
  4. \ May be freely redistributed for non-commercial use (FREEWARE).
  5.  
  6.  
  7. INCLUDE? fft1 fftinc
  8. anew task-fftrc
  9.  
  10. : FFTRC { a m | n/2 n41 kk km xk+xkm xk-xkm yk-ykm savbits --- }
  11.  
  12. [ auto_scale_fft? ]
  13. .IF   outbits-fft @  -> savbits    14 outbits-fft !   .THEN
  14.  
  15.    a  m 1-  FFT         ( do cmplx fft with half as many elements )
  16.  
  17.    m 1- 2**  -> n/2
  18. [ float_fft?  w_table_fft? NOT AND ]
  19. .IF
  20.    pi_fft  n/2 FLOAT  s/
  21.    ZEXP  CONJG
  22. .ELSE
  23.    m 1- ZCELLS  w-table-fft + Z@  CONJG
  24. .THEN
  25.    z1
  26.    a                -> kk
  27.    a n/2 ZCELLS +   -> km
  28.  
  29.    n/2 U2/  1
  30.    DO
  31.      kk ZCELL+     -> kk
  32.      km ZCELL-     -> km
  33.      ZOVER Z*
  34.      ZDUP
  35.      km @ kk @ 2DUP s+       -> xk+xkm
  36.      s-
  37.      kk CELL+ @ km CELL+ @
  38.      2DUP s-                 -> yk-ykm
  39.      s+ SWAP Z*
  40.      2DUP xk+xkm yk-ykm
  41.      Z+  kk  Z!
  42.      SWAP SNEGATE SWAP
  43.      xk+xkm  yk-ykm  SNEGATE
  44.      Z+  km  Z!
  45.    LOOP
  46.  
  47.    ZDROP ZDROP
  48.    a @ DUP s+  a CELL+ @ DUP s+
  49.    ZDUP s- >r s+ r> a Z!
  50.    kk ZCELL+  -> kk
  51.    kk @ DUP s+ kk !  kk CELL+ DUP>R @ DUP s+ SNEGATE R> !
  52.  
  53. [ auto_scale_fft? ]  .IF
  54.  
  55.    savbits dup  outbits-fft !
  56.    IF
  57.      savbits 16 -
  58.      IF
  59.        a   n/2 2*   savbits 16 -
  60.        DUP shifts-fft  +!
  61.        DUP blk-exp-fft +!
  62.        ASHIFT.ARRAY
  63.      THEN
  64.    THEN
  65.  
  66. .THEN
  67. ;
  68.