As some ppl on the forum has searched for a solution to analyze raw sound datas frequency spectrum, we converted a FFT Routine found on the web.
The following source uses your default soundcard's input and displays its spectrum in a little graph on a window just for testing purpose.
We adjusted the settings in this code to determine a frequency which is at most peak at the moment up to 8 kHz. If you need a higher frequency you only need to adjust the input-frequency. The determined most powerfull frequency is displayed in the Window-Title as the Note that has been found by the FFT. For testing this, I added an archive with some sinus tones. You can download them here: (~9MB Archive)
http://www.danceyourmusic.com/tones.rar
For more accuracy we use 1024 samples in our buffer. If you need lower letancy you can select a lower value (256 oder 512) but it must be a power of two.
Thanks to MrMat for his help on converting the C code.
If you have any hint how to improve Accuracy or speed, just let us know.
Have fun.
Code: Select all
Global Dim rex.f(512*2+1)
Global Dim imx.f(512*2+1)
Global Dim OutPutArray.f(512*2+1)
Global FFTWnd
Structure NoteRange
Note.l
FromPos.l
ToPos.l
EndStructure
Procedure.l ShowNote_Init()
Global Dim NoteRange.NoteRange(53)
For Note=0 To 53
Read FromPos.w
Read ToPos.w
NoteRange(Note)\FromPos = FromPos
NoteRange(Note)\ToPos = ToPos
NoteRange(Note)\Note = Note
Next
Global Dim g_RealNote.s( 53 )
For i = 0 To 42+12-1
Read sRealNote.s
g_RealNote( i ) = sRealNote.s
Next
EndProcedure
Procedure.s ShowNote_Get( lValue)
ProcedureReturn g_RealNote.s( lValue )
EndProcedure
ShowNote_Init()
Structure SCOPE
channel.b
left.l
top.l
width.l
height.l
middleY.l
quarterY.l
EndStructure
Structure CONFIG
hWindow.l ; Window handle
size.l ; Wave buffer size
buffer.l ; Wave buffer pointer
output.l ; WindowOutput()
wave.l ; Address of waveform-audio input device
format.WAVEFORMATEX ; Capturing WaveFormatEx
lBuf.l ; Capturing Buffer size
nBuf.l ; Capturing Buffer number
nDev.l ; Capturing Device identifier
nBit.l ; Capturing Resolution (8/16)
nHertz.l ; Capturing Frequency (Hertz)
nChannel.l ; Capturing Channels number (Mono/Stereo)
LScope.SCOPE ; Wave form display
RScope.SCOPE ; Wave form display
EndStructure
Global Config.CONFIG
Global Dim inHdr.WAVEHDR(16)
Config\format\wFormatTag = #WAVE_FORMAT_PCM
Procedure Record_Start()
Config\format\nChannels = 1
Config\format\wBitsPerSample = 16
Config\format\nSamplesPerSec = 8000
Config\nDev = 0 ; (0 default MS Sound Mapper device)
Config\lBuf = 1024
Config\nBuf = 8
Config\nBit = 1
Config\format\nBlockAlign = (Config\format\nChannels*Config\format\wBitsPerSample)/8
Config\format\nAvgBytesPerSec = Config\format\nSamplesPerSec*Config\format\nBlockAlign
If #MMSYSERR_NOERROR = waveInOpen_(@Config\wave,#WAVE_MAPPER+Config\nDev,@Config\format,Config\hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT)
For i=0 To Config\nBuf-1
inHdr(i)\lpData=AllocateMemory(Config\lBuf)
inHdr(i)\dwBufferLength=Config\lBuf
waveInPrepareHeader_(Config\wave,inHdr(i),SizeOf(WAVEHDR))
waveInAddBuffer_(Config\wave,inHdr(i),SizeOf(WAVEHDR))
Next
If #MMSYSERR_NOERROR = waveInStart_(Config\wave)
SetTimer_(Config\hWindow,0,1,0)
EndIf
EndIf
EndProcedure
Procedure Record_Read(hWaveIn.l,lpWaveHdr.l)
*hWave.WAVEHDR=lpWaveHdr
Config\buffer=*hWave\lpData
Config\size=*hWave\dwBytesRecorded
waveInAddBuffer_(hWaveIn,lpWaveHdr,SizeOf(WAVEHDR))
EndProcedure
Procedure record_FindNote(Value)
For Note = 0 To 53
If Value=>NoteRange(Note)\FromPos And Value<=NoteRange(Note)\ToPos
ProcedureReturn note
EndIf
Next
EndProcedure
Procedure record_doFFT(*scope.SCOPE)
If Config\buffer = 0 : ProcedureReturn : EndIf
For pos=0 To 1024:rex(pos)=0:imx(pos)=0:Next
pos = 0
For i=0 To Config\size Step 2
value.w=PeekW(Config\buffer+i)
;value.w=PeekW(Config\buffer+i+*scope\channel*2) Enable this for Stereo Inpus
rex(pos) = value/32767
imx(pos) = 0 :
pos + 1
Next
N.w = 1024 ; Num Samples
;N.w = 512
m-w = 102
NM1.l = N - 1
ND2.l = N / 2
M.l = Int(Log(N) / 0.69314718055994529)
J.l = ND2
For i.l = 1 To N - 2 ; Bit reversal sorting
If i < J
TR.f = REX(J)
TI.f = IMX(J)
REX(J) = REX(i)
IMX(J) = IMX(i)
REX(i) = TR
IMX(i) = TI
EndIf
K = ND2
While K <= J
J = J - K
K = K / 2
Wend
J = J + K
Next i
For L = 1 To M ; Loop for each stage
LE.l = Int(Pow(2, L))
;LE2.l = LE / 2
LE2.l = LE >> 1
UR.f = 1
UI.f = 0
SR.f = Cos(#PI / LE2) ; Calculate sine & cosine values
SI.f = - Sin(#PI / LE2)
For J.l = 1 To LE2 ; Loop for each sub DFT
JM1.l = J - 1
For i = JM1 To NM1 ; Loop for each butterfly
IP.l = i + LE2
TR = REX(IP) * UR - IMX(IP) * UI ; Butterfly calculation
TI = REX(IP) * UI + IMX(IP) * UR
REX(IP) = REX(i) - TR
IMX(IP) = IMX(i) - TI
REX(i) = REX(i) + TR
IMX(i) = IMX(i) + TI
i + LE - 1
Next i
TR = UR
UR = TR * SR - UI * SI
UI = TR * SI + UI * SR
Next J
Next L
; Outputarray berechnen
For cnt=0 To 512
outputarray(cnt) = (IMX(cnt) * IMX(cnt)) + (REX(cnt) * REX(cnt))
Next cnt
;Search for MaxValue of the Paket
maxvalue = 1
;
For cnt = 0 To 1024
If (maxvalue < outputarray(cnt))
maxvalue = outputarray(cnt)
EndIf
Next cnt
StartDrawing(WindowOutput(FFTWnd))
Box(0,0,500,500,$0)
MaxPeak=0
For cnt = 5 To 512
DiffY=Outputarray(cnt)/MaxValue*400
LineXY(cnt,400,cnt,400-DiffY,$FFFFFF)
If DiffY>MaxPeak
MaxPeak=DiffY
AkNote=cnt
EndIf
Next cnt
SetWindowTitle(FFTWnd,Str(record_FindNote(aknote))+" on:"+Str(aknote)+" note:"+ShowNote_Get(record_FindNote(aknote)))
StopDrawing()
EndProcedure
Procedure record_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
Result.l=#PB_ProcessPureBasicEvents
Select Msg
Case #WM_TIMER : record_doFFT(Config\LScope)
Case #MM_WIM_DATA : record_Read(wParam,lParam)
EndSelect
ProcedureReturn Result
EndProcedure
FFTWnd = OpenWindow(#PB_Any,0,0,500,500,"",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Config\hWindow=WindowID(FFTWnd)
Config\output=WindowOutput(FFTWnd)
SetWindowCallback(@record_CallBack())
Record_Start()
Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
End
DataSection
Notes:
Data.w 14, 17
Data.w 18, 18
Data.w 19, 19
Data.w 20, 20
Data.w 21, 21
Data.w 22, 23
Data.w 24, 24
Data.w 25, 26
Data.w 27, 27
Data.w 28, 29
Data.w 30, 31
Data.w 32, 32
Data.w 33, 34
Data.w 35, 37
Data.w 38, 39
Data.w 40, 41
Data.w 42, 44
Data.w 45, 46
Data.w 47, 49
Data.w 50, 52
Data.w 53, 55
Data.w 56, 59
Data.w 60, 62
Data.w 63, 66
Data.w 67, 70
Data.w 71, 74
Data.w 75, 79
Data.w 80, 83
Data.w 84, 88
Data.w 89, 94
Data.w 95, 99
Data.w 100, 105
Data.w 106, 112
Data.w 113, 118
Data.w 119, 125
Data.w 126, 133
Data.w 134, 141
Data.w 142, 149
Data.w 150, 158
Data.w 159, 168
Data.w 169, 178
Data.w 179, 188
Data.w 189, 200
Data.w 201, 212
Data.w 213, 224
Data.w 225, 238
Data.w 239, 252
Data.w 253, 267
Data.w 268, 283
Data.w 284, 300
Data.w 301, 318
Data.w 319, 337
Data.w 338, 357
Data.w 358, 375
RealNotes:
Data.s "C0", "C#0", "D0", "D#0", "E0", "F0", "F#0", "G0", "G#0"
Data.s "A0", "A#0", "B0", "C1", "C#1", "D1", "D#1", "E1", "F1", "F#1", "G1", "G#1"
Data.s "A2", "A#2", "B2", "C2", "C#2", "D2", "D#2", "E2", "F2", "F#2", "G2", "G#2"
Data.s "A3", "A#3", "B3", "C3", "C#3", "D3", "D#3", "E3", "F3", "F#3", "G3", "G#3"
Data.s "A4", "A#4", "B4", "C4", "C#4", "D4", "D#4", "E4", "F4"
EndDataSection
*thumbs up*