Code: Select all
IncludeFile "bass.pbi"
CompilerIf #PB_Compiler_Unicode
#UNICODE=#BASS_Unicode
CompilerElse
#UNICODE=#0
CompilerEndIf
Global Handle
Global Event
#SPECWIDTH = 368
#SPECHEIGHT = 127
#TIME_PERIODIC = 1
#MainWin=0
Structure BITMAPINFO256
bmiHeader.BITMAPINFOHEADER
bmiColors.RGBQUAD[256]
EndStructure
Global specpos = 0, specmode = 1
Global bh.BITMAPINFO256
Global Dim specbuf.b(#SPECWIDTH*(#SPECHEIGHT+1))
;' create bitmap to draw spectrum in - 8 bit for easy updating :)
With bh\bmiHeader
\biBitCount = 8
\biPlanes = 1
\biSize = SizeOf(BITMAPINFOHEADER)
\biWidth = #SPECWIDTH
\biHeight = #SPECHEIGHT
\biClrUsed = 256
\biClrImportant = 256
EndWith
;' setup palette
For a = 1 To 127
bh\bmiColors[a]\rgbGreen = 256 - 2 * a
bh\bmiColors[a]\rgbRed = 2 * a
Next a
For a = 0 To 31
bh\bmiColors[128 + a]\rgbBlue = 8 * a
bh\bmiColors[128 + 32 + a]\rgbBlue = 255
bh\bmiColors[128 + 32 + a]\rgbRed = 8 * a
bh\bmiColors[128 + 64 + a]\rgbRed = 255
bh\bmiColors[128 + 64 + a]\rgbBlue = 8 * (31 - a)
bh\bmiColors[128 + 64 + a]\rgbGreen = 8 * a
bh\bmiColors[128 + 96 + a]\rgbRed = 255
bh\bmiColors[128 + 96 + a]\rgbGreen = 255
bh\bmiColors[128 + 96 + a]\rgbBlue = 8 * a
Next a
Enumeration
;PLAY GADGETS
#BG_Play
#BG_Pause
#BG_Stop
#BG_Load
#BG_Next
EndEnumeration
Procedure IIF(expr,y,n)
If expr
ProcedureReturn y
Else
ProcedureReturn n
EndIf
EndProcedure
Procedure UpdateSpectrum()
Define x.l, y.l, y1.l
Dim FFT.f(1024)
BASS_ChannelGetData(Handle,@FFT(),#BASS_DATA_FFT2048)
Select specmode
Case 0
Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1)) ;' clear display
For x = 0 To (#SPECWIDTH/2)-1
Y = Sqr(fft(X + 1)) * 3 * #SPECHEIGHT - 4 ; scale it (sqrt to make low values more visible)
; Y = fft(X + 1) * 10 * #SPECHEIGHT ; scale it (linearly)
If Y>#SPECHEIGHT : Y=#SPECHEIGHT : EndIf
If X
y1 = (Y + y1) / 2
y1 = y1 - 1
While (y1 >= 0)
ind=y1 * #SPECWIDTH + X * 2 - 1
specbuf(ind) = y1 + 1
y1 = y1 - 1
Wend
EndIf
y1 = Y
Y = Y - 1
While (Y >= 0)
ind=Y * #SPECWIDTH + X * 2
specbuf(ind) = Y + 1
Y = Y - 1
Wend
Next X
Case 1
Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1)) ; clear display
Define b0.l, BANDS.i
b0 = 0
BANDS = 21
Define sc.l, b1.l, sum.f
For X = 0 To BANDS
sum = 0
b1 = Pow(2, X * 10.0 / BANDS )
If (b1 > 1023) : b1 = 1023 : EndIf
If (b1 <= b0) : b1 = b0 + 1 : EndIf; make sure it uses at least 1 FFT bin
sc = 10 + b1 - b0
Repeat
sum = sum + fft(1 + b0)
b0 = b0 + 1
Until b0 >= b1
Y = (Sqr(sum / Log10(sc)) * 1.7 * #SPECHEIGHT) - 4 ;' scale it
If Y > #SPECHEIGHT : Y = #SPECHEIGHT : EndIf;' cap it
Y = Y - 1
While Y >= 0
FillMemory(@specbuf(Y * #SPECWIDTH + X * Int(#SPECWIDTH / BANDS)), #SPECWIDTH / BANDS - 2, Y + 1)
Y = Y - 1
Wend
Next X
Case 2
For X = 0 To #SPECHEIGHT - 1
Y = Sqr(fft(X + 1)) * 3 * 127 ;' scale it (sqrt to make low values more visible)
If (Y > 127) : Y = 127 : EndIf;' cap it
specbuf(X * #SPECWIDTH + specpos) = 128 + Y ;' plot it
Next X
;' move marker onto next position
specpos = (specpos + 1) % #SPECWIDTH
For X = 0 To #SPECHEIGHT - 1
specbuf(X * #SPECWIDTH + specpos) = 255
Next X
Case 3
Dim buf.f(0)
Define c.l, ci.BASS_CHANNELINFO
Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1))
BASS_ChannelGetInfo(Handle, @ci)
Dim buf(ci\chans * #SPECWIDTH * 4)
BASS_ChannelGetData(Handle, @buf(0), (ci\chans * #SPECWIDTH * 4) | #BASS_DATA_FLOAT)
For c = 0 To ci\chans - 1
For X = 0 To #SPECWIDTH - 1
v.l = (1 - buf(X * ci\chans + c)) * #SPECHEIGHT / 2
If (v < 0)
v = 0
ElseIf (v >= #SPECHEIGHT)
v = #SPECHEIGHT - 1
EndIf
If (X = 0) : Y = v : EndIf
Repeat
If (Y < v)
Y = Y + 1
ElseIf (Y > v)
Y = Y - 1
EndIf
specbuf(Y * #SPECWIDTH + X) = IIf(c And 1, 127, 1)
Until (Y = v)
Next X
Next c
EndSelect
SetDIBitsToDevice_(GetDC_(WindowID(0)), 0, 0, #SPECWIDTH, #SPECHEIGHT, 0, 0, 0, #SPECHEIGHT, @specbuf(0), @bh, 0)
EndProcedure
Procedure Loadfile()
FileName.s = OpenFileRequester("","","*.*|*.*",0)
If FileName
Handle=BASS_StreamCreateFile(0, @FileName, 0, 0, #UNICODE)
BASS_SetVolume(100)
BASS_ChannelPlay(Handle,0)
EndIf
EndProcedure
#T_Update = 1
;- START
If OpenWindow(0,50,50,#SPECWIDTH,#SPECHEIGHT+35,"BASS Spectrum example")
ButtonGadget(#BG_Load,50,#SPECHEIGHT+5,50,25,"Load")
ButtonGadget(#BG_Stop,100,#SPECHEIGHT+5,50,25,"Stop")
ButtonGadget(#BG_Play,150,#SPECHEIGHT+5,50,25,"Play")
ButtonGadget(#BG_Pause,200,#SPECHEIGHT+5,50,25,"Pause")
ButtonGadget(#BG_Next,250,#SPECHEIGHT+5,50,25,"Spectrum")
AddWindowTimer(#MainWin, #T_Update, 25)
BASS_Init(-1, 44100, 0, WindowID(#MainWin), #Null)
loadfile()
Repeat
Event=WaitWindowEvent(10)
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #BG_Load
BASS_StreamFree(Handle)
Loadfile()
Case #BG_Play
BASS_ChannelPlay(Handle,0)
Case #BG_Pause
BASS_ChannelPause(Handle)
Case #BG_Stop
BASS_ChannelStop(Handle)
BASS_ChannelSetPosition(Handle,0,#BASS_POS_BYTE)
Case #BG_Next
specmode=(specmode+1)%4
EndSelect
Case #PB_Event_Timer
Select EventTimer()
Case #T_Update
UpdateSpectrum()
EndSelect
EndSelect
Until Event=#PB_Event_CloseWindow
EndIf
BASS_Free()
End
