Sorry your browser is not supported!

Rem Project: FFTspectrum
Rem Created: 21.11.2008 07:18:30
Rem Original Author: Mini Malistix
Rem Tinkered with by: TheComet

///////////////////////////////////////////////////////////////////
// Display
///////////////////////////////////////////////////////////////////

Set Display Mode 800,600,16

Sync Rate 60
Sync On
backdrop off

Disable Escapekey

Set Text Font "courier new",1
Set Text Size 13

///////////////////////////////////////////////////////////////////
// UDT to store DLL information
///////////////////////////////////////////////////////////////////

Type msx
   handle As Integer
   ffthandle As Integer
   spectrum As Integer
   lof As Integer
   fft As Integer
Endtype

Global music As msx

///////////////////////////////////////////////////////////////////
// Array to store FFT-SPECTRUM information
///////////////////////////////////////////////////////////////////

global f_resolution as dword = 400

Global Dim eq(f_resolution-1) As Float

scw=screen width()
sch=screen height()

///////////////////////////////////////////////////////////////////
// Call needed functions
///////////////////////////////////////////////////////////////////

f_LoadFMOD("tracker.mp3")

f_PlayMusic()

///////////////////////////////////////////////////////////////////
// start reading spectrum
///////////////////////////////////////////////////////////////////

Do

   // after calling this function, all fft values are
   // stored as float ( 0.0 - 1.0 ) in the eq(x) array

   f_GetFFT()

   // *****

   a2fillbox 0,0,scw,sch-f_resolution-22,0xFF000000
   a2line 0,sch-19,scw,sch-19,0xFFFFFFFF
   a2line 0,sch-f_resolution-21,scw,sch-f_resolution-21,0xFFFFFFFF
   For i=0 To f_resolution-1

      a2dot xpos,sch-i-20,f_GetColor(eq(i))
      a2line 20+i,sch-f_resolution-32,20+i,sch-f_resolution-32-(eq(i)*150),0xFFFFFFFF

   Next i
   inc xpos:if xpos>scw then xpos=0


   Sync

   If Escapekey() Then Exit

Loop

///////////////////////////////////////////////////////////////////
// stop music and delete dll
///////////////////////////////////////////////////////////////////

f_StopMusic()

End

///////////////////////////////////////////////////////////////////
// Functions
///////////////////////////////////////////////////////////////////

Function f_LoadFMOD(file$)

   Load Dll "fmod.dll",1

   nul=Call Dll(1,"_FSOUND_Init@12",44100,1,0)
   music.handle=Call Dll(1,"_FSOUND_Stream_Open@16",file$,0,0,0)
   music.lof=Call Dll(1,"_FSOUND_Stream_GetLength@4",music.handle)

   Make Memblock 1,f_resolution*4
   music.fft=Get Memblock Ptr(1)

Endfunction



Function f_StopMusic()

   nul=Call Dll(1,"_FSOUND_Stream_Stop@4",music.handle)
   nul=Call Dll(1,"_FSOUND_Stream_Close@4",music.handle)
   nul=Call Dll(1,"_FSOUND_Close@0")

   Delete Dll 1

Endfunction



Function f_PlayMusic()

   nul=Call Dll(1,"_FSOUND_Stream_Play@8",0,music.handle)
   music.ffthandle=Call Dll (1,"_FSOUND_DSP_GetFFTUnit@0")
   nul=Call Dll (1,"_FSOUND_DSP_SetActive@8",music.ffthandle,-1)
   music.spectrum=Call Dll (1,"_FSOUND_DSP_GetSpectrum@0")

Endfunction



Function f_GetFFT()

   Copy Memory music.fft,music.spectrum,f_resolution*4

   nr=0

   For i=0 To f_resolution*4-4 Step 4
      eq(nr)=Memblock Float(1,i)
      Inc nr,1
   Next i

Endfunction

function f_GetColor(value#)

   local maxv as integer
   local r as integer
   local g as integer
   local b as integer
   local n as integer

   maxv=value#*765

   for n=0 to maxv
      if b<255 then inc b
      if b=255 and r<255 then inc r
      if r=255 then inc g
   next n
   
   maxv=rgb(r,g,b)

endfunction maxv