PureBasic Forums - English

Code: Select all

;you can use this java app to test tones
;http://www.dsptutor.freeuk.com/dtmf/ToneGenerator.html

Global Dim rex.f(512*2+1)
Global Dim imx.f(512*2+1)
Global Dim FFTOUT.f(2,512*2+1)
Global gtone 
Global FFTMUT = CreateMutex()
Global FFTWnd, gdraw, gmaxvalue

Structure CONFIG
 
  hWindow.l            
  size.l               
  buffer.l             
  output.l             
  wave.l               
  format.WAVEFORMATEX  
  lBuf.l               
  nBuf.l               
  nDev.l               
  nBit.l               
  nHertz.l             
  nChannel.l           

EndStructure

Global Config.CONFIG
Global Dim inHdr.WAVEHDR(16)
Global maxvalue,maxvalue2 ,AKnote, gphase, stone.s
Config\format\wFormatTag = #WAVE_FORMAT_PCM

Declare.s gettone(a,b)
 
Procedure Record_Start()

  Config\format\nChannels = 1

  Config\format\wBitsPerSample  = 16
  Config\format\nSamplesPerSec  = 11025
  Config\nDev                   = 0  
  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_doFFT()

  Protected N.w,M.w,NM1.i,J.i,ND2.i,MM.i
  Static lt,ltone.s 
  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)
    rex(pos) = value/32767
    imx(pos) = 0  :
    pos + 1
  Next

  N.w = 1024     
  NM1 = N - 1
  ND2 = N / 2
  MM = Int(Log(N) / 0.69314718055994529)
  J = ND2

  For ii = 1 To N - 2  
      If ii < J
          TR.f = REX(J)
          TI.f = IMX(J)
          REX(J) = REX(ii)
          IMX(J) = IMX(ii)
          REX(ii) = TR
          IMX(ii) = TI
      EndIf
      K = ND2
      While K <= J
          J = J - K
          K = K / 2
      Wend
      J = J + K
  Next 

  For L = 1 To MM  
      LE.l = Int(Pow(2, L))
       
      LE2.l = LE >> 1
      UR.f = 1
      UI.f = 0
      SR.f = Cos(#PI / LE2)  
      SI.f = - Sin(#PI / LE2)
      For J = 1 To LE2  
          JM1.l = J - 1
          For i = JM1 To NM1  
              IP.l = i + LE2
              TR = REX(IP) * UR - IMX(IP) * UI  
              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
   
   
   LockMutex(FFTMUT)
   maxvalue = 1
   maxvalue2 = 1
   
   For cnt=1 To 512
     ;calculate the power and phase 
     FFTOUT(0,cnt) = (IMX(cnt) * IMX(cnt)) + (REX(cnt) * REX(cnt)) 
     FFTOUT(1,cnt) = ATan(IMX(cnt)/REX(cnt))
     ;get max frequency  
     If FFTOUT(0,cnt) > maxvalue  
        maxvalue = FFTOUT(0,cnt)
        If maxvalue > gmaxvalue
          gmaxvalue = maxvalue 
        EndIf    
        AkNote=cnt
        fq = (((Config\format\nSamplesPerSec / 512.0) * (cnt)) + (Config\format\nSamplesPerSec / 512.0)) * 0.5 
        gphase = FFTOUT(1,cnt)
     EndIf
     
               
   Next 
   ;loop through again to find the second frequency 
      
   For cnt = 1 To 512 
      ;make sure it's not leakage from the main peak and within a reasonable range   
      If Abs(aknote - cnt) > 10 And  Abs(aknote - cnt) < 90    
        If FFTOUT(0,cnt) > maxvalue2 
          maxvalue2 = FFTOUT(0,cnt)
          fq1 = (((Config\format\nSamplesPerSec / 512.0) * (cnt)) + (Config\format\nSamplesPerSec / 512.0)) * 0.5 
        EndIf
     EndIf  
   Next 
    
   If fq > 0  
       ;apply a theshold check should use DB scale but for quick n dirty we can do it on the scope window height
       sfy.f = (1.0-200.0) / (1.0-gmaxvalue)  
       stone = gettone(fq,fq1) 
       
       If maxvalue * sfy > 100 And maxvalue2 * sfy > 100
         
         If stone <> ltone And stone <> ""
            gtone = #True 
         ElseIf stone = ltone And stone <> "" 
           If ElapsedMilliseconds() > lt 
             gtone = #True 
           EndIf   
         EndIf 
         ltone = stone
         lt= ElapsedMilliseconds()+45
      EndIf  
   EndIf 
   UnlockMutex(FFTMUT)
     
 Delay(0)
   
EndProcedure

Procedure.s gettone(a,b)
   Protected snb.s 
   Static lt, sna.s
   If a > b 
     t=a 
     a=b 
     b=t
   EndIf 
      
   
   If a > 662 And a < 731  ;697
     If b > 1148 And b < 1268 ;1209
       nb=1
       snb="1" 
     ElseIf b > 1269 And b < 1402 ;1336
       nb=2
       snb="2"  
     ElseIf b > 1403 And b < 1550 ;1477
       nb=3
       snb="3" 
     ElseIf b > 1551 And b < 1715 ;1633
       nb=13 
       snb="A"
     EndIf            
   ElseIf a > 731 And a < 808  ;770
     If b > 1148 And b < 1268 
       nb=4
       snb="4" 
     ElseIf b > 1269 And b < 1402
       nb=5
       snb="5"  
     ElseIf b > 1403 And b < 1550 
       nb=6
       snb="6" 
     ElseIf b > 1551 And b < 1715 ;1633
       nb=14 
       snb="B"
     EndIf    
   ElseIf a > 809 And a < 892 ;852
    If b > 1148 And b < 1268 
       nb=7
       snb="7" 
     ElseIf b > 1269 And b < 1402
       nb=8
       snb="8"  
     ElseIf b > 1403 And b < 1550 
       nb=9
       snb="9" 
     ElseIf b > 1551 And b < 1715 ;1633
       nb=15 
       snb="C"
     EndIf     
   ElseIf a > 893 And a < 988  ;941
      If b > 1148 And b < 1268 
       nb=10
       snb="*" 
     ElseIf b > 1269 And b < 1402
       nb=11
       snb="0"  
     ElseIf b > 1403 And b < 1550 
       nb=12
       snb="#" 
     ElseIf b > 1551 And b < 1715 ;1633
       nb=16 
       snb="D"
     EndIf    
   EndIf 
   
    
          
   ProcedureReturn snb 
   
EndProcedure   

Procedure record_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
 
  Result.l=#PB_ProcessPureBasicEvents
 
  Select Msg
    Case #WM_TIMER    : record_doFFT()
    Case #MM_WIM_DATA : record_Read(wParam,lParam)
  EndSelect
 
  ProcedureReturn Result
 
EndProcedure

Procedure draw(win)
hwnd = WindowID(win)
gdraw=1 
Static lt 
Static blt 
mytones.s
ltone.s
StartDrawing(WindowOutput(win))
 
SetWindowColor(win,0)
While gdraw 
  
  LockMutex(FFTMUT)
    
  sfy.f = (1.0-200.0) / (1.0-gmaxvalue)  
  
  For a = 1 To 512 
    ht = fftout(0,a) * sfy
    LineXY(a,200,a,200-ht,RGB(255,255,255))
  Next 
  gmaxvalue = 1
  If gtone  
    blt = ElapsedMilliseconds() + 250
    mytones + stone 
    gtone = #False 
  EndIf 
  If ElapsedMilliseconds() > blt 
    mytones = "" 
  EndIf   
  DrawText(20,20,mytones,RGB(0,255,0),0) 
  
  UnlockMutex(fftmut)
  
  Delay(20)
  rc.rect 
  GetWindowRect_(hwnd,@rc)
  InvalidateRect_(hwnd,rc,1)
   
  
Wend 

StopDrawing()

EndProcedure 

;set recording to wave out mix 
Procedure RecWindow(void)
   
   hwnd = OpenWindow(#PB_Any,0,0,200,200,"Tone",#PB_Window_Invisible)
   Config\hWindow=WindowID(hwnd)
   SetWindowCallback(@record_CallBack())
   Record_Start()
    
   Repeat 

   ev = WaitWindowEvent() 

   Until ev=#WM_CLOSE 
      
EndProcedure 

;XIncludeFile "mixer.pbi" 

OpenWindow(0,0,0,512,200,"fft",#PB_Window_SystemMenu)

CreateThread(@RecWindow(),0)
CreateThread(@draw(),0)

Repeat 

  ev = WaitWindowEvent()

Until ev =#WM_CLOSE    

gdraw = #False 

CloseWindow(0)