home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 326.lha / KFFT_v1.1 / makewtable < prev    next >
Text File  |  1989-12-23  |  2KB  |  70 lines
  1. version# 2000 >=  constant  jforth2?
  2.  
  3. jforth2?
  4. .IF    include? float ju:float.ffp
  5.        fpinit
  6.        include? logto ju:logto
  7. .ELSE  include? float ju:floating
  8.        also floating
  9.        open-float
  10. .THEN
  11.  
  12. ANEW task-make-wtab
  13.  
  14. 14 CONSTANT wscale
  15. 1 wscale +SHIFT FLOAT  CONSTANT fwscale
  16.  
  17. jforth2?
  18. .IF    3.14159265   CONSTANT pi_wtab
  19.        : FROUNDFIX compile FIX ; immediate
  20. .ELSE  3.14159265+0 CONSTANT pi-wtab
  21.        : fcos  compile  cos ; immediate
  22.        : fsin  compile  sin ; immediate
  23.        : FROUNDFIX ( float -- rounded-fixed )
  24.                    DUP TST FLOAT 0.5+0 F*  F+ FIX ;
  25. .THEN
  26.  
  27. VARIABLE logging?
  28.  
  29.  
  30. : INPUT$  ( -- $string )
  31.     PAD 1+  128 EXPECT  SPAN @  PAD C!  PAD ;
  32.  
  33. : INPUT#  ( -- N true | false )
  34.     INPUT$ NUMBER?  IF DROP TRUE ELSE FALSE THEN ;
  35.  
  36.  
  37. : makewtable ( -- )
  38.     CR CR ." Input number of (cos,sin) pairs to generate ( 1-20 ). >"
  39.     INPUT#
  40.     IF  DUP 1 20 WITHIN?   ELSE  FALSE  THEN
  41.     NOT  IF  ABORT THEN
  42.  
  43.     CR CR ." Create new WTABLE file?"  y/n
  44.     DUP logging? !
  45.     IF  " WTABLE"  $LOGTO  THEN
  46.  
  47.     DUP CR CR  .  ." CONSTANT max_log2_fft"
  48.     CR CR CR ." float_fft?  .IF"
  49.     CR CR ."            ( floating point cos, sin table )"
  50.     CR ." CREATE  w-table-fft"
  51.     DUP
  52.     0 DO  I 1 AND NOT IF  CR  THEN
  53.          pi_wtab 1 I +SHIFT FLOAT F/ DUP
  54.          FSIN SWAP FCOS
  55.          2 0 DO ."  $ "  .HEX   ."  ,"   LOOP
  56.       LOOP
  57.     CR CR ." .ELSE
  58.     CR CR ."            ( fixed point cos, sin table )"
  59.     CR ." CREATE  w-table-fft"
  60.     0 DO  I 1 AND NOT IF  CR  THEN
  61.          pi_wtab 1 I +SHIFT FLOAT F/ DUP
  62.          FSIN fwscale F* FROUNDFIX  SWAP FCOS fwscale F* FROUNDFIX
  63.          2 0 DO ."  $ "  .HEX   ."  ,"   LOOP
  64.       LOOP
  65.     CR CR ." .THEN" CR CR CR
  66.     logging? @  IF logend THEN
  67. ;
  68.  
  69. cr ." Enter  makewtable  to run." cr cr
  70.