home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 202.lha / FFT / fft.tools < prev    next >
Encoding:
Text File  |  1988-12-28  |  4.2 KB  |  184 lines
  1. anew task-fft_tools
  2.  
  3.  
  4. \ zeros out all magnitude values of a given partial 
  5. \ same as 0 dim# FILL.DIM: MAGNITUDES.
  6.  
  7. : ZERO.DIM.MAG  ( dim# -- )
  8.   0 SWAP FILL.DIM: MAGNITUDES
  9. ;
  10.  
  11. : ZERO.ALL.MAG
  12.   WINDOW-SIZE @ 2/ 0 DO
  13.         0 I FILL.DIM: MAGNITUDES
  14.   LOOP
  15. ;
  16.  
  17. : ZERO.DIM.PHASE  ( dim# -- )
  18.   0 SWAP FILL.DIM: PHASE-INDICES
  19. ;
  20.  
  21. : ZERO.ALL.PHASE
  22.   WINDOW-SIZE @ 0 DO
  23.         0 I FILL.DIM: PHASE-INDICES
  24.   LOOP
  25. ;
  26.  
  27. \ Fills values of a given partial with given value.
  28.  
  29. : FILL.DIM.MAG  ( value dim -- ) 
  30.   SWAP 0 127 CLIPTO SWAP
  31.   FILL.DIM: MAGNITUDES
  32. ;
  33.  
  34. : FILL.DIM.PHASE  ( value dim -- ) 
  35.   SWAP 0 127 CLIPTO 0 |X|.SCALE.UP SWAP ( get value up where ifft can see it) 
  36.   FILL.DIM: PHASE-INDICES
  37. ;
  38.  
  39. \ ************************** LISTENING STUFF *******************************
  40.  
  41. : INIT.INSTRUMENTS
  42.   TUNING-EQUAL PUT.TUNING:  INS-AMIGA-1
  43.   TUNING-EQUAL PUT.TUNING:  INS-AMIGA-2
  44.   0 PUT.ENVELOPE: INS-AMIGA-1
  45.   0 PUT.ENVELOPE: INS-AMIGA-2
  46.   SAMPLE-IN  PUT.WAVEFORM: INS-AMIGA-1
  47.   SAMPLE-OUT PUT.WAVEFORM: INS-AMIGA-2
  48. ;
  49.   
  50. : PLAY.BOTH ( end-note start-note -- )
  51.   INIT.INSTRUMENTS
  52.   DEPTH 2 < IF cr ." PLAY.BOTH expects end and start notes" cr 50 30 THEN
  53.   DO
  54.      I 128 NOTE.ON: INS-AMIGA-1
  55.      700 MSEC
  56.      I 128 NOTE.ON: INS-AMIGA-2
  57.      700 MSEC
  58.   LOOP
  59. ;
  60.  
  61. : PLAY.OUT ( end-note start-note -- )
  62.  INIT.INSTRUMENTS
  63.  DO
  64.      I 128 NOTE.ON: INS-AMIGA-2
  65.      1000 MSEC
  66.  LOOP
  67. ;
  68.  
  69.         
  70.  
  71. \ THIS WORD TESTS INVERSE IFFT FOR A SIMPLE SINE WAVE ADDITION
  72.  
  73. : INIT.SINE.TEST
  74.       60 1 FILL.DIM.MAG 
  75.       40 2 FILL.DIM.MAG
  76. ;
  77.  
  78.  
  79. : COMPARE.THEM ( start -- prints values from sample-in and sample-out)
  80. CR  ." INDEX      SAMPLE-IN    SAMPLE-OUT" CR
  81.   MAX-SAMPLE-SIZE @ SWAP DO
  82.    5 SPACES I . 
  83.    5 SPACES 
  84.    I AT: SAMPLE-IN . 
  85.    10 SPACES
  86.    I AT: SAMPLE-OUT . 
  87.    CR
  88.   ?terminal if leave then
  89.   LOOP
  90. ;
  91.  
  92. : CCC COMPARE.THEM ;  
  93.  
  94. \ ******************************* PLOTTER **********************************
  95.  
  96. \ These routines plot time sliced frequency spectra.  You get a pretty picture
  97. \ of how the magnitudes of the partials are changing over time.
  98. \ Usage is PLOT.SLICES ( el# --), plots 50 time slices starting at el#.
  99.  
  100. VARIABLE X.OFFSET
  101. VARIABLE Y.OFFSET
  102. VARIABLE MAG.INCREMENT
  103. 0 X.OFFSET !
  104. 0 Y.OFFSET !
  105. VARIABLE PLOT-SCALE
  106.  
  107. : PLOT.TIME.SLICE ( el# --, plots spectrum at el#)
  108.   DUP 0 ED.AT: MAGNITUDES PLOT-SCALE @ 100 */
  109.   X.OFFSET @ SWAP 150 - ABS Y.OFFSET @ - GR.MOVE ( -- el#)
  110.   WINDOW-SIZE @ 2/ 1 DO                          ( for each partial)
  111.     I 600 WINDOW-SIZE @ 2/ /  *                ( horizontal subdivision)
  112.     X.OFFSET @ + OVER I ED.AT: MAGNITUDES PLOT-SCALE @ 100 */
  113.                150 - ABS Y.OFFSET @ - GR.DRAW
  114.   LOOP
  115.   DROP
  116. ;
  117.  
  118. \ 50 time slices spread by MAG.INCREMENT
  119.  
  120. : PLOT.SLICES
  121.   GR-CURWINDOW @ NOT IF GR.OPENTEST THEN
  122.   GR.CLEAR
  123.   CALC.STATS: MAGNITUDES
  124.   0 GET.DIM.MAX: MAGNITUDES ( -- start max)
  125.   WINDOW-SIZE @ 2/ 1 DO
  126.     I  GET.DIM.MAX: MAGNITUDES  ( -- start max.start max.new)
  127.     MAX                         ( -- start new.max)
  128.   LOOP
  129.   128 100 ROT */ PLOT-SCALE !             ( -- set max peak)
  130.   0 X.OFFSET !
  131.   0 Y.OFFSET !
  132.      50 MANY: MAGNITUDES MIN 0 DO
  133.         X.OFFSET @ 3 + X.OFFSET !
  134.         Y.OFFSET @ 3 + Y.OFFSET !
  135.         I MAG.INCREMENT @ * PLOT.TIME.SLICE
  136.   LOOP 
  137. ;
  138.  
  139. : PLOT.M
  140.   MANY: MAGNITUDES 50 / MAG.INCREMENT !
  141.   PLOT.SLICES  
  142. ;
  143.  
  144. : PLOT.FIRST.50
  145.    1 MAG.INCREMENT !
  146.    PLOT.SLICES
  147. ;
  148.  
  149. \ ******************** ENVELOPE GENERATOR FOR IFFT ADDITIVE SYNTH *************
  150.  
  151. \ These routines make it easy to create simple n-stage envelopes, apply
  152. \ them to magnitudes of partials for resynthesis.  Very much fun.
  153.  
  154.  
  155. OB.SHAPE ENV-TEMPLATE
  156.  
  157. : STAGE.ENVELOPE ( #stages -- )
  158.    FREE: ENV-TEMPLATE
  159.    DUP DUP 2 NEW: ENV-TEMPLATE
  160.    0 60 1 PUT.DIM.LIMITS: ENV-TEMPLATE
  161.   " POINT" 0 PUT.DIM.NAME: ENV-TEMPLATE
  162.   " AMP" 1 PUT.DIM.NAME: ENV-TEMPLATE
  163.   MANY: MAGNITUDES SWAP / SWAP 0 DO
  164.       I OVER * 30 ADD: ENV-TEMPLATE
  165.   LOOP
  166.   DROP
  167.   cr ." All amplitudes defaulting to 30" cr
  168. ;
  169.  
  170. VARIABLE ELCOUNT
  171. VARIABLE TEMP-DIM
  172.  
  173. : FILL.DIM.ENV ( dimension -- )
  174.   TEMP-DIM !
  175.   0 ELCOUNT !
  176.   MANY: ENV-TEMPLATE 1- 0 DO
  177.     I  GET: ENV-TEMPLATE I 1+ GET: ENV-TEMPLATE SET.INTERP
  178.     I 1+ 0 ED.AT: ENV-TEMPLATE I 0 ED.AT: ENV-TEMPLATE DO
  179.         I INTERP 0 127 CLIPTO ELCOUNT @ TEMP-DIM @ ED.TO: MAGNITUDES
  180.         1 ELCOUNT +!
  181.     LOOP
  182.   LOOP
  183. ;
  184.