This program displays a real-time spectrum of whatever audio signal is fed to your PC (microphone input or line input, as selected in Windows Volume Control). The .EXE version is self-contained, but if you want to run the .BBC version you will need to download FFTW2DLL.DLL to your BBC BASIC for Windows\LIB folder.
| Download ANALYSER.BBC | Run ANALYSER.EXE |
|---|
REM. Real-time audio spectrum analyser in BBC BASIC for Windows
REM. Richard Russell, 20th November 2006
*FLOAT 64
MODE 8
OFF
ON ERROR PROCcleanup : SYS "MessageBox", @hwnd%, REPORT$, 0, 48 : QUIT
ON CLOSE PROCcleanup : QUIT
REM. Install 'Fastest Fourier Transform in the West' DLL:
SYS "LoadLibrary", @lib$+"FFTW2DLL.DLL" TO fftw%
IF fftw% = 0 ERROR 100, "Cannot load FFTW2DLL.DLL"
SYS "GetProcAddress", fftw%, "fftw_create_plan" TO `fftw_create_plan`
SYS "GetProcAddress", fftw%, "fftw_one" TO `fftw_one`
REM. Open wave input device:
DIM Format{wFormatTag{l&,h&}, nChannels{l&,h&}, nSamplesPerSec%, \
\ nAvgBytesPerSec%, nBlockAlign{l&,h&}, wBitsPerSample{l&,h&}, \
\ cbSize{l&,h&}}
Format.wFormatTag.l& = 1 : REM WAVE_FORMAT_PCM
Format.nChannels.l& = 1 : REM Monaural
Format.nSamplesPerSec% = 11025
Format.wBitsPerSample.l& = 16
Format.nBlockAlign.l& = Format.nChannels.l& * Format.wBitsPerSample.l& / 8
Format.nAvgBytesPerSec% = Format.nSamplesPerSec% * Format.nBlockAlign.l&
_WAVE_MAPPER = -1
SYS "waveInOpen", ^WaveIn%, _WAVE_MAPPER, Format{}, 0, 0, 0 TO ret%
IF ret% ERROR 100, "waveInOpen failed: "+STR$~ret%
REM. Create wave headers:
DIM _WAVEHDR{lpData%, dwBufferLength%, dwBytesRecorded%, dwUser%, \
\ dwFlags%, dwLoops%, lpNext%, Reserved%}
nBuffers% = 3
DIM Headers{(nBuffers%-1)}=_WAVEHDR{}
REM. Fill in wave headers; allocate, prepare and add buffers:
SamplesPerBuffer% = 1024
BytesPerBuffer% = SamplesPerBuffer% * Format.nBlockAlign.l&
FOR buff% = 0 TO nBuffers%-1
DIM buffer% BytesPerBuffer% - 1
Headers{(buff%)}.lpData% = buffer%
Headers{(buff%)}.dwBufferLength% = BytesPerBuffer%
SYS "waveInPrepareHeader", WaveIn%, Headers{(buff%)}, !!^_WAVEHDR{} TO ret%
IF ret% ERROR 100, "waveInPrepareHeader failed: "+STR$~ret%
SYS "waveInAddBuffer", WaveIn%, Headers{(buff%)}, !!^_WAVEHDR{} TO ret%
IF ret% ERROR 100, "waveInAddBuffer failed: "+STR$~ret%
NEXT
REM. Prepare FFT:
_FFTW_FORWARD = -1
SYS `fftw_create_plan`, SamplesPerBuffer%, _FFTW_FORWARD, 0 TO Plan%
IF Plan%=0 ERROR 100, "fftw_create_plan failed"
DIM In#(SamplesPerBuffer%-1,1), Out#(SamplesPerBuffer%-1,1)
REM. Draw axes and labels:
ORIGIN 128,64
LINE -2,-2,-2,903 : REM Y-axis
LINE -2,-2,1022,-2 : REM X-axis
VDU 5
FOR F = 0 TO 5
X% = F/5.5125*1024
LINE X%-2,-2,X%-2,-12 : REM X ticks
MOVE X%-10,-20 : PRINT ;F*Format.nSamplesPerSec%/11025; : REM X labels
NEXT
PRINT " kHz";
FOR D = 0 TO -90 STEP -10
Y% = 903 + D*10
LINE -2,Y%-2,-12,Y%-2 : REM Y ticks
MOVE -80,Y%+12 : PRINT ;D; : REM Y labels
IF D = 0 PRINT " dB";
NEXT
COLOUR 1,100,255,100
GCOL 1
VDU 28,8,29,71,0 : REM Set text viewport
VDU 24,0;0;1022;958; : REM Set graphics viewport
REM. Start capture:
SYS "waveInStart", WaveIn% TO ret%
IF ret% ERROR 100, "waveInStart failed: "+STR$~ret%
*REFRESH OFF
REM. Wait for and process audio data:
_WHDR_DONE = 1
REPEAT
FOR buff% = 0 TO nBuffers%-1
IF Headers{(buff%)}.dwFlags% AND _WHDR_DONE THEN
PROCprocess(Headers{(buff%)}.lpData%,SamplesPerBuffer%)
Headers{(buff%)}.dwFlags% AND= NOT _WHDR_DONE
SYS "waveInAddBuffer", WaveIn%, Headers{(buff%)}, !!^_WAVEHDR{}
ENDIF
NEXT
SYS "Sleep", 1
UNTIL FALSE
END
DEF PROCcleanup
*REFRESH ON
WaveIn% += 0 : IF WaveIn% THEN
SYS "waveInStop", WaveIn%
SYS "waveInReset", WaveIn%
SYS "waveInClose", WaveIn%
WaveIn% = 0
ENDIF
fftw% += 0 : IF fftw% SYS "FreeLibrary", fftw% : fftw% = 0
ENDPROC
REM. Process data in audio buffer: n.b. time-critical!
DEF PROCprocess(B%,N%)
LOCAL I%, P%, V%, V, L
FOR I% = 0 TO N%-1
V% = B%!(I%*2) AND &FFFF : IF V% >= &8000 V% -= 65536
In#(I%,0) = V%/N% * (COS((I%/N%-0.5)*PI*2)+1) : REM Hanning window
NEXT
In#() *= 2.0
SYS `fftw_one`, Plan%, ^In#(0,0), ^Out#(0,0)
CLS
P% = 4
FOR I% = 0 TO N%/2-1
V = Out#(I%,0)^2+Out#(I%,1)^2
IF V=0 L=0 ELSE L=10*LOGV
PLOT P%,I%*2,L*10 : P%=5
NEXT
*REFRESH
ENDPROC
