Code: Select all
;I put together some stuff (Tranquil and inc.), played wit it and get this example of making your own FFT display on your player
;Ricardo - June 2008
;Play wav files and show how to display a FFT-kind for the user
;Could be used in any other player, just need to be able to read the data
Global Dim rex.f(512*2+1)
Global Dim imx.f(512*2+1)
Global Dim outputarray.f(512*2+1)
Global Dim CopyArray.f(512*2+1)
#NUM_BUFFERS = 8 ; 8 should be enough.
#BUFFER_SECONDS = 0.01;need to be small to have a good flow in the FFT data
Global rc.l ; Return code
Global hmmioIn.l ; file handle
Global DataOffset.l ; start of audio data in wave file
Global audioLength.l ; number of bytes in audio data
Global startPos.l ; sample where we started playback from
Global format.WAVEFORMATEX ; waveformat structure
Global Dim hmem.l(#NUM_BUFFERS-1) ; memory handles
Global Dim pmem.l(#NUM_BUFFERS-1) ; memory pointers
Global Dim hdr.WAVEHDR(#NUM_BUFFERS-1) ; wave headers
Global bufferSize.l ; size of output buffers
Global fPlaying.b ; is file currently playing
Global fFileOpen.b ; is file currently open
Global hWaveOut.l ; waveout handle
Global msg.s=Space(250) ; message buffer
Global hwnd.l ; window handle
Procedure DrawFFT(none)
Repeat
Delay(40)
StartDrawing(WindowOutput(FFTWnd))
Box(0,0,500,500,$0)
MaxPeak=0
For cnt = 5 To 512 Step 8
;This part could make a purist told me that im not being accurate with FFT, and yes
;but its just for showing in a easier to see way what is happening in the audio
;its just for a normal play and and average user, being much accurate is not intentent
If outputarray(cnt) < CopyArray(cnt)
outputarray(cnt) = (outputarray(cnt) + CopyArray(cnt)+ CopyArray(cnt))/3
ElseIf outputarray(cnt) > CopyArray(cnt)
outputarray(cnt) = (outputarray(cnt) + CopyArray(cnt))/2
EndIf
DiffY=outputarray(cnt)
If DiffY > 380
DiffY = 380
EndIf
OldDiffY = CopyArray(cnt)
CopyArray(cnt) = DiffY
Debug DiffY
NewColor = 10+(DiffY/3)
If NewColor > 255
NewColor = 255
ElseIf NewColor< 50
NewColor = 50
EndIf
If DiffY < 5
DiffY = 5
EndIf
Box(cnt,400-OldDiffY ,4,OldDiffY ,RGB(10,10,150))
Box(cnt,400-DiffY,4,DiffY,RGB(10+NewColor,10,150))
Next cnt
StopDrawing()
ForEver
EndProcedure
Procedure Position()
Protected tm.MMTIME, Position.l
tm\wType = #TIME_BYTES
rc = waveOutGetPosition_(hWaveOut, @tm, SizeOf(MMTIME))
If rc = #MMSYSERR_NOERROR
Position = (startPos + tm\u\cb) / format\nBlockAlign
Else
Position = (mmioSeek_(hmmioIn, 0, #SEEK_CUR) - DataOffset + bufferSize * #NUM_BUFFERS) / format\nBlockAlign
EndIf
ProcedureReturn Position
EndProcedure
Procedure ServiceBuffers(*wavhdr.WAVEHDR)
Protected dataRemaining.l, i.l
If fPlaying = #True
Debug "refilling buffers ... at second "+Str(Position()/format\nSamplesPerSec)
dataRemaining = (DataOffset + audioLength - mmioSeek_(hmmioIn, 0, #SEEK_CUR))
If bufferSize < dataRemaining
rc = mmioRead_(hmmioIn, *wavhdr\lpData, bufferSize)
;-FFT
SizeW = bufferSize/4
Redim rex.f(SizeW*2+1)
Redim imx.f(SizeW*2+1)
Redim outputarray.f(SizeW*2+1)
Redim CopyArray.f(SizeW*2+1)
*mem = *wavhdr\lpData
For pos=0 To 1024:rex(pos)=0:imx(pos)=0:Next
pos = 0
For i=0 To bufferSize Step 8
Value.w=PeekW(*mem+i)
rex(pos) = Value/32767
imx(pos) = 0 :
pos + 1
If pos = 1024
Break
EndIf
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
;- Adittional DSP
*mem = *wavhdr\lpData
For abc = 1 To bufferSize Step 4
;Read modified data
left.w = PeekW(*mem+abc)
right.w = PeekW(*mem+abc+2)
;Here you can do whatever you want with the data
;This is just a dummy DSP routine (very bad one!)
NewLeft.w = left + (right * -1)
NewRight.w = right + (left * -1)
OldLeft.w = left
OldRight.w = right
;Just make sure there is no distortion (this is in fact a bad method but its only and example)
If NewLeft > 32767
NewLeft = 32767
ElseIf NewLeft < -32768
NewLeft = -32768
EndIf
If NewRight > 32767
NewRight = 32767
ElseIf NewRight < -32768
NewRight =-32768
EndIf
;Write modified data
; PokeW(*mem+abc,NewLeft)
; PokeW(*mem+abc+2,NewRight)
Next
;-
Else
rc = mmioRead_(hmmioIn, *wavhdr\lpData, dataRemaining)
fPlaying = #False
Debug "... rest remaining data: "+Str(dataRemaining)
EndIf
; Debug bufferSize
*wavhdr\dwBufferLength = rc
rc = waveOutWrite_(hWaveOut, *wavhdr, SizeOf(WAVEHDR))
Else
Debug "... finishing buffering ... at second "+Str(Position()/format\nSamplesPerSec)
For i = 0 To #NUM_BUFFERS-1
waveOutUnprepareHeader_( hWaveOut, @hdr(i), SizeOf(WAVEHDR))
Next
waveOutClose_( hWaveOut)
EndIf
EndProcedure
Procedure CloseTheFile()
Protected i.l
For i = 0 To (#NUM_BUFFERS-1)
GlobalFree_(hmem(i))
;Debug "Memory "+Str(i)+" allocated at "+Str(pmem(i))+ " released"
Next
If fPlaying = #True
For i = 0 To #NUM_BUFFERS-1
waveOutUnprepareHeader_( hWaveOut, @hdr(i), SizeOf(WAVEHDR))
Next
waveOutClose_( hWaveOut)
EndIf
mmioClose_(hmmioIn, 0)
fFileOpen = #False
EndProcedure
Procedure OpenTheFile(soundfile.s, WinNo.l)
Protected total.f, i.l, mmckinfoParentIn.MMCKINFO, mmckinfoSubchunkIn.MMCKINFO, mmioinf.MMIOINFO
hwnd = WindowID(WinNo)
fPlaying = #False
startPos = 0
; checking if still playing
If fPlaying
fPlaying = #False
EndIf
; close previously open file (if any)
If fFileOpen = #True
CloseTheFile()
EndIf
If soundfile = ""
Debug "File not found"
ProcedureReturn #False
EndIf
; Open the input file
hmmioIn = mmioOpen_(@soundfile, @mmioinf, #MMIO_READ)
If hmmioIn = 0
MessageRequester("Error", "Error opening input File, rc = "+PeekS(@mmioinf\wErrorRet))
ProcedureReturn #False
EndIf
; Check if this is a wave file
mmckinfoParentIn\fccType = mmioStringToFOURCC_("WAVE", 0)
rc = mmioDescend_(hmmioIn, @mmckinfoParentIn, 0, #MMIO_FINDRIFF)
If rc <> #MMSYSERR_NOERROR
CloseTheFile()
MessageRequester("Error", "Not a wave File")
ProcedureReturn #False
EndIf
; Get format info
mmckinfoSubchunkIn\ckid = mmioStringToFOURCC_("fmt", 0)
rc = mmioDescend_(hmmioIn, @mmckinfoSubchunkIn, @mmckinfoParentIn, #MMIO_FINDCHUNK)
If rc <> #MMSYSERR_NOERROR
CloseTheFile()
MessageRequester("Error", "Couldn;t get format chunk")
ProcedureReturn #False
EndIf
rc = mmioRead_(hmmioIn, @format, mmckinfoSubchunkIn\ckSize)
If rc = -1
CloseTheFile()
MessageRequester("Error", "Error reading format")
ProcedureReturn #False
EndIf
Debug " "
Debug "FormatTag: "+Str(format\wFormatTag)
Debug "Channels: "+Str(format\nChannels)
Debug "SamplesPerSec: "+Str(format\nSamplesPerSec)+" Hz"
Debug "AvgBytesPerSec: "+Str(format\nAvgBytesPerSec)
Debug "BlockAlign: "+Str(format\nBlockAlign)+" bytes"
Debug "Resolution: "+Str(format\cbSize)+" bits"
Debug " "
rc = mmioAscend_(hmmioIn, @mmckinfoSubchunkIn, 0)
; Find the data subchunk
mmckinfoSubchunkIn\ckid = mmioStringToFOURCC_("data", 0)
rc = mmioDescend_(hmmioIn, @mmckinfoSubchunkIn, @mmckinfoParentIn, #MMIO_FINDCHUNK)
If rc <> #MMSYSERR_NOERROR
CloseTheFile()
MessageRequester("Error", "Couldn't get data chunk")
ProcedureReturn #False
EndIf
DataOffset = mmioSeek_(hmmioIn, 0, #SEEK_CUR)
; Get the length of the audio
audioLength = mmckinfoSubchunkIn\ckSize
; Allocate audio buffers
bufferSize = format\nSamplesPerSec * format\nBlockAlign * format\nChannels * #BUFFER_SECONDS
bufferSize = bufferSize - (bufferSize % format\nBlockAlign)
For i = 0 To (#NUM_BUFFERS-1)
GlobalFree_(hmem(i))
hmem(i) = GlobalAlloc_(#GMEM_ZEROINIT|#GMEM_MOVEABLE, bufferSize)
pmem(i) = GlobalLock_(hmem(i))
;Debug Str(bufferSize/1024)+"kb allocated at Memory "+Str(i)+" at adress "+Str(pmem(i))
total+(bufferSize/1024/1024)
Next
Debug StrF(total,3)+" MBs in total for "+Str(#NUM_BUFFERS)+" Buffers used"
Debug " "
fFileOpen = #True
ProcedureReturn #True
EndProcedure
Procedure Play()
Protected i.l
If fPlaying
ProcedureReturn #True
EndIf
rc = waveOutOpen_(@hWaveOut, #WAVE_MAPPER, @format, hwnd, #Null, #CALLBACK_WINDOW)
If rc <> #MMSYSERR_NOERROR
waveOutGetErrorText_(rc, @msg, Len(msg))
Debug msg
ProcedureReturn #False
EndIf
For i = 0 To #NUM_BUFFERS-1
hdr(i)\lpData = pmem(i)
hdr(i)\dwBufferLength = bufferSize
hdr(i)\dwFlags = 0
hdr(i)\dwLoops = 0
rc = waveOutPrepareHeader_(hWaveOut, @hdr(i), SizeOf(WAVEHDR))
If rc <> #MMSYSERR_NOERROR
waveOutGetErrorText_(rc, @msg, Len(msg))
Debug msg
ProcedureReturn #False
EndIf
Next
fPlaying = #True
startPos = mmioSeek_(hmmioIn, 0, #SEEK_CUR) - DataOffset
; send a MM_WOM_DONE message to the callback so the buffers get filled and playback starts
For i = 0 To #NUM_BUFFERS-1
PostMessage_(hwnd, #MM_WOM_DONE, 0, @hdr(i))
Next
ProcedureReturn #True
EndProcedure
Procedure FileSeekTo(Position.l)
Protected bytepos.l
bytepos = Position * format\nBlockAlign
If fFileOpen = #False Or bytepos = audioLength
ProcedureReturn #False
EndIf
rc = mmioSeek_(hmmioIn, bytepos + DataOffset, #SEEK_SET)
If rc = #MMSYSERR_NOERROR
startPos = rc
ProcedureReturn #True
EndIf
EndProcedure
Procedure StopPlay()
fPlaying = #False
FileSeekTo(Position())
waveOutReset_( hWaveOut)
EndProcedure
Procedure Pause()
If fPlaying
fPlaying = #False
FileSeekTo(Position())
waveOutPause_(hWaveOut)
Else
fPlaying = #True
WaveOutRestart_(hWaveOut)
EndIf
EndProcedure
Procedure.f Length() ; ... in Audioblocks!
ProcedureReturn audioLength / format\nBlockAlign
EndProcedure
Procedure Playing()
Protected tm.MMTIME
tm\wType = #TIME_BYTES
rc = waveOutGetPosition_(hWaveOut, @tm, SizeOf(MMTIME))
If rc = #MMSYSERR_NOERROR
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure WaveCallback(WindowID, message, wParam, lParam)
Protected result = #PB_ProcessPureBasicEvents
If message = #MM_WOM_DONE ; Buffers need to be refilled?
ServiceBuffers(lParam)
EndIf
ProcedureReturn result
EndProcedure
FFTWnd = OpenWindow(0,0,0,500,500,"",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CreateThread(@DrawFFT(),0)
SetWindowCallback(@WaveCallback())
file.s = OpenFileRequester("Choose a PCM Wave file","","Wave files (*.wav)|*.wav",0)
If file
If OpenTheFile(file,0)
Debug "Lenght: "+StrF(Length()/format\nSamplesPerSec,3)+" sec"
Debug""
If Play()
Repeat
event = WaitWindowEvent()
lprm = EventlParam()
wprm = EventwParam()
If event = #WM_KEYDOWN
If wprm = #VK_ESCAPE ; Quit appl.
StopPlay()
CloseTheFile()
End
EndIf
EndIf
Until event = #PB_Event_CloseWindow
StopPlay()
CloseTheFile()
End
Else
CloseTheFile()
Debug "error playing"
EndIf
End
Else
Debug "error initializing"
EndIf
Else
Debug "error opening"
EndIf
Its not accurate, but not intented too. Its just for displaying kinda FFT for the user that listen to music on your app.
Any improvement or comment are welcome
