PureBasic Forums - English

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