home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 3 / FREEWARE.BIN / oh_fm / fft / fft.bas next >
BASIC Source File  |  1980-01-02  |  7KB  |  193 lines
  1. 1000 '
  2. 1010 '  SPECTRUM ANALYSER with FFT
  3. 1020 '                         1989/12/20 by Teckey ZeroOne
  4. 1030 '
  5. 1040  CLEAR ,,8192:DEFINT A-Z :TESTF=0
  6. 1050  BIT=8:N=2^BIT:P!=6.28318!/N
  7. 1060  MOUSE 0:ON MOUSE (4) GOSUB *MOUSE4
  8. 1070  ON MOUSE(2) GOSUB *MOUSE2
  9. 1080  HAMF=1:SLOG=1:FAUTO=1:SFREQ=9600:BFREQ!=SFREQ/N
  10. 1090  GOSUB *SINIT:GOSUB *VSCALE:GOSUB *HSCALE:GOSUB *COND
  11. 1100  GOSUB *INIT
  12. 1110  MOUSE(2) ON:MOUSE(4) ON
  13. 1120 *MLOOP:LINE (17,78)-(72,97),XOR,7,BF
  14. 1130  IF FAUTO<>1 THEN A$=INKEY$:IF A$=""THEN 1130
  15. 1140  LINE (17,78)-(72,97),XOR,7,BF
  16. 1150  IF TESTF=0 THEN GOSUB *RECORD ELSE GOSUB *SETDATA
  17. 1160  GOSUB *SCREEN
  18. 1170  IF HAMF=1 THEN GOSUB *HAMMING
  19. 1180  GOSUB *FFT
  20. 1190  GOSUB *POW
  21. 1200  GOSUB *PLOT
  22. 1210  GOTO *MLOOP
  23. 1220 *SETDATA:'SETUP DATA FOR TEST
  24. 1230  FOR I=0 TO N-1:IMAG!(I)=0
  25. 1240    REAL!(I)=(I>N/32)+1
  26. 1250   'REAL!(I)=SIN(P!*N*SIN(P!*I*2.1!))
  27. 1260  NEXT I
  28. 1270  HAMF=0:FAUTO=0:GOSUB *COND:RETURN
  29. 1280 *INIT
  30. 1290  DIM REAL!(N-1),IMAG!(N-1),POW!(N-1),SAMPLE(N/2+32)
  31. 1300  DIM TSIN!(N-1),TCOS!(N-1),TREV(N-1)
  32. 1310  LINE (19,58)-(69,77),XOR,7,BF
  33. 1320  FOR I=0 TO N-1
  34. 1330    TCOS!(I)=COS(I*P!):TSIN!(I)=SIN(I*P!)
  35. 1340    REV=0:K=I
  36. 1350    FOR J=0 TO BIT - 1
  37. 1360      REV = REV + REV
  38. 1370      IF (K AND 1)=1 THEN REV = REV + 1 
  39. 1380      K = K \ 2
  40. 1390    NEXT J
  41. 1400    TREV(I)=REV
  42. 1410  NEXT I:LINE (19,58)-(69,77),XOR,7,BF
  43. 1420  RETURN
  44. 1430 *SINIT
  45. 1440  SCREEN@ 0:VIEW:WINDOW:CLS
  46. 1450  PALETTE 0,[80,80,90]:PALETTE 15,[210,40,60]:PALETTE 13,[180,10,80]
  47. 1460  PALETTE 12,[240,120,120]:PALETTE 14,[200,250,90]
  48. 1470  PALETTE 10,[50,250,50]:PALETTE 11,[200,200,50]
  49. 1480  SYMBOL (0,8),"ＦＦＴ",2,2,4,0,PSET,1+2+4
  50. 1490  LINE(116,1)-(629,203),PSET,1,B:LINE(116,212)-(629,453),PSET,1,B
  51. 1500 *SYMINIT:VIEW:WINDOW:LINE (16,58)-(72,179),PSET,0,BF
  52. 1510  SYMBOL (20,60), " INIT ",1,1,3,0,PSET,1
  53. 1520  SYMBOL (16,80), "STANDBY",1,1,3,0,PSET,1
  54. 1530  SYMBOL (20,100), "RECORD",1,1,3,0,PSET,1
  55. 1540  SYMBOL (16,120)," SETUP",1,1,3,0,PSET,1
  56. 1550  SYMBOL (16,140),"  FFT ",1,1,3,0,PSET,1
  57. 1560  SYMBOL (16,160)," POWER",1,1,3,0,PSET,1
  58. 1570  RETURN
  59. 1580 *FFT
  60. 1590  LINE (19,138)-(69,157),XOR,7,BF
  61. 1600  N1=1:N2=N:LOCATE 2,9
  62. 1610  *LOOP1
  63. 1620    N2=N2/2 : K1=0
  64. 1630    *LOOP2
  65. 1640      X=0:K2=K1+N2-1
  66. 1650      FOR I=K1 TO K2
  67. 1660        H=I+N2
  68. 1670        V!=TCOS!(X):W!=TSIN!(X)
  69. 1680        R!=REAL!(I):I!=IMAG!(I)
  70. 1690        REAL!(I)=R!+REAL!(H):IMAG!(I)=I!+IMAG!(H)
  71. 1700        Q!=(R!-REAL!(H))*V! + (I!-IMAG!(H))*W!
  72. 1710        IMAG!(H)=(I!-IMAG!(H))*V! - (R!-REAL!(H))*W!
  73. 1720        REAL!(H)=Q!
  74. 1730        X=X+N1
  75. 1740      NEXT I
  76. 1750      K1=K1+N2+N2
  77. 1760    IF K1 < N THEN *LOOP2
  78. 1770    IF N2=1 THEN *FFTEND
  79. 1780    N1=N1+N1
  80. 1790    PRINT "*";:GOTO *LOOP1
  81. 1800  *FFTEND
  82. 1810  LINE (19,138)-(69,157),XOR,7,BF
  83. 1820  RETURN
  84. 1830 *POW:MAXPOW!=0
  85. 1840  LINE (19,158)-(69,177),XOR,7,BF
  86. 1850  FOR I=0 TO N/2
  87. 1860    RE!=REAL!(TREV(I)):IM!=IMAG!(TREV(I))
  88. 1870    POW!(I)=SQR(RE!*RE!+IM!*IM!)
  89. 1880    IF POW!(I)>MAXPOW! THEN MAXPOW!=POW!(I)
  90. 1890  NEXT I
  91. 1900  IF SLOG<>1 THEN *POWEND
  92. 1910  FOR I=0 TO N/2
  93. 1920    IF POW!(I)<>0:POW!(I)=100+20*LOG(POW!(I)/MAXPOW!):ELSE POW!(I)=0
  94. 1930  NEXT I:MAXPOW!=100
  95. 1940  *POWEND:LINE (19,158)-(69,177),XOR,7,BF
  96. 1950  RETURN
  97. 1960 *HAMMING
  98. 1970  FOR I=0 TO N-1
  99. 1980    REAL!(I)=REAL!(I)*(.54!-.46!*COS(P!*I))
  100. 1990  NEXT I
  101. 2000  RETURN
  102. 2010 *SCREEN
  103. 2020  VIEW (117,2)-(628,202):CLS 
  104. 2030  WINDOW(0,1)-(N-1,-1)
  105. 2040  LINE(0,0)-(N-1,0),PSET,1
  106. 2050  PSET(0,REAL!(0))
  107. 2060  FOR I=1 TO N-1
  108. 2070    LINE -(I,REAL!(I)),PSET
  109. 2080  NEXT I
  110. 2090  WINDOW:VIEW:RETURN
  111. 2100 *PLOT
  112. 2110  VIEW (117,213)-(628,452):CLS
  113. 2120  WINDOW(0,MAXPOW!)-((N-1)/2,0):DEF PEN 0,2
  114. 2130  FOR I=0 TO N/2-1
  115. 2140    IF (I MOD 10) = 0 THEN PCOL = 5 ELSE PCOL = 7
  116. 2150    LINE (I,POW!(I))-(I,0),PSET,PCOL
  117. 2160  NEXT I
  118. 2170  LINE(1,POW!(1))-(1,0),PSET,2
  119. 2180  DEF PEN 0 :WINDOW:VIEW:RETURN
  120. 2190 *RECORD
  121. 2200  LINE (19,98)-(69,117),XOR,7,BF
  122. 2210  PCMREC SAMPLE,SFREQ
  123. 2220  LINE (19,98)-(69,117),XOR,7,BF
  124. 2230 *SETSAMPLE:PTR&=VARPTR(SAMPLE(30))
  125. 2240  LINE (19,118)-(69,137),XOR,7,BF
  126. 2250  FOR I=0 TO N-1
  127. 2260    DAT=PEEK(PTR&,1):PTR&=PTR&+1
  128. 2270    IF (DAT AND 128)<>0 THEN SIGN=1 ELSE SIGN=-1
  129. 2280    REAL!(I)=SIGN*(DAT AND 127)/127:IMAG!(I)=0
  130. 2290  NEXT I
  131. 2300  LINE (19,118)-(69,137),XOR,7,BF:RETURN
  132. 2310 *MOUSE2
  133. 2320  GOSUB *SYMINIT
  134. 2330  RETURN *MLOOP
  135. 2340 *MOUSE4
  136. 2350  SF=0:GOSUB *SYMINIT:MOUSE 1,10,240,1:MOUSE(2)OFF
  137. 2360  *MOSLOOP:WHILE MOUSE(2,0)<>-1:WEND
  138. 2370   MX=MOUSE(0):MY=MOUSE(1):IF MX<5 OR MX>85 THEN *MOSLOOP
  139. 2380   IF MY>450 AND MY<466 THEN *M4_END
  140. 2390   IF MY>370 AND MY<386 THEN FAUTO=FAUTO XOR 1:GOSUB *COND
  141. 2400   IF MY>320 AND MY<336 THEN SLOG=SLOG XOR 1:GOSUB *VSCALE:GOSUB *COND
  142. 2410   IF MY>420 AND MY<436 THEN HAMF=HAMF XOR 1:GOSUB *COND
  143. 2420   IF MY>220 AND MY<236 THEN GOSUB *M_SAMPLE:GOSUB *HSCALE:GOSUB *COND
  144. 2430   IF MY>270 AND MY<286 THEN GOSUB *M_FREQ:GOSUB *HSCALE:GOSUB *COND
  145. 2440  GOTO *MOSLOOP
  146. 2450 *M4_END
  147. 2460  IF SF=1 THEN GOSUB *DINIT
  148. 2470  MOUSE 1,,,0:MOUSE(4)ON:MOUSE(2)ON:RETURN *MLOOP
  149. 2480 *DINIT
  150. 2490  P!=6.28318!/N
  151. 2500  ERASE REAL!,IMAG!,POW!,SAMPLE,TSIN!,TCOS!,TREV:GOSUB *INIT
  152. 2510  RETURN
  153. 2520 *M_SAMPLE
  154. 2530  BIT=BIT+1:IF BIT>9 THEN BIT=7
  155. 2540  N=2^BIT:BFREQ!=SFREQ/N:SF=1
  156. 2550  RETURN
  157. 2560 *M_FREQ
  158. 2570  IF SFREQ=19200 THEN SFREQ=4800 ELSE SFREQ=SFREQ*2
  159. 2580  BFREQ!=SFREQ/N:RETURN
  160. 2590 *VSCALE
  161. 2600  VIEW:WINDOW:LINE(88,210)-(112,479),PSET,0,BF
  162. 2610  IF SLOG=1 THEN RESTORE *D_LOG ELSE RESTORE *D_LIN
  163. 2620  FOR Y=213 TO 453 STEP 24
  164. 2630    LINE(113,Y)-(115,Y),PSET,1
  165. 2640    READ S$
  166. 2650    SYMBOL (88,Y-4),S$,1,.6!,5
  167. 2660  NEXT Y
  168. 2670  READ S$:SYMBOL(90,463),S$,1,1,5
  169. 2680  RETURN
  170. 2690  *D_LIN DATA 1.0,0.9,0.8,0.7,0.6,0.5,0.4,0.3,0.2,0.1,"  0",""
  171. 2700  *D_LOG DATA "  0",-10,-20,-30,-40,-50,-60,-70,-80,-90,-∞, db
  172. 2710 *HSCALE
  173. 2720  LINE(119,454)-(400,479),PSET,0,BF
  174. 2730  SYMBOL(117,455),STR$(BFREQ!)+"(Hz)",1,1,5
  175. 2740  RETURN
  176. 2750 *COND:LINE (10,200)-(80,440),PSET,0,BF
  177. 2760  SYMBOL (10,200),"SAMPLE",1,1,6,0,PSET,1
  178. 2770  SYMBOL (10,250),"FREQ(Hz)",1,1,6,0,PSET,1
  179. 2780  SYMBOL (10,300),"SCALE",1,1,6,0,PSET,1
  180. 2790  SYMBOL (10,350),"MODE",1,1,6,0,PSET,1
  181. 2800  SYMBOL (10,400),"WINDOW",1,1,6,0,PSET,1
  182. 2810  SYMBOL (5,450),"START",2,1,2,0,PSET,1
  183. 2820 *CONDSET
  184. 2830  IF SLOG=1 THEN S$="LOG(db)" ELSE S$="LINEAR "
  185. 2840  SYMBOL (20,220),STR$(N),1,1,4,0,PSET,1
  186. 2850  SYMBOL (20,270),STR$(SFREQ),1,1,4,0,PSET,1
  187. 2860  SYMBOL (20,320),S$,1,1,4,0,PSET,1
  188. 2870  IF FAUTO=1 THEN S$="AUTO" ELSE S$="ONCE"
  189. 2880  SYMBOL (20,370),S$,1,1,4,0,PSET,1
  190. 2890  IF HAMF=1 THEN S$="ON " ELSE S$="OFF"
  191. 2900  SYMBOL (20,420),S$,1,1,4,0,PSET,1
  192. 2910  RETURN
  193.