Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Everything else that doesn't fall into one of the other PB categories.
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by Baldrick »

Hi all,
Long long time since I have fired up PB and am now so far away from coding, I feel like a complete beginner again..... :(
I am thinking of starting into a little project to programmatically create sound tones and decode them again.
The idea pretty much being able to take say the ansii character list, allocate a certain frequency tone to it, then use the same program to listen and decode it back to its character. ( Call it a primitive form of SMS over CB radio if you like....) :)
Thought this would be pretty simple with PB and probably is. But not for me these days with so much rust in my little brain from lack of any coding work for so many years!
Would also like whatever I do to be cross platform as I rarely use windows these days and stick for myself pretty much to Linux ( Ubuntu ) - just so easy to use!
User avatar
kenmo
Addict
Addict
Posts: 1967
Joined: Tue Dec 23, 2003 3:54 am

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by kenmo »

Hi Baldrick!

It is pretty simple to map text characters to audio frequencies, then generate sinusoidal audio sample data.
Writing that audio data to a basic WAV file is simple too.
Now the two hard parts:

1. Decoding audio sample data to a frequency, then matching that frequency to your closest defined text character...
You should look up Fourier Transform (FFT) implementations, there are some in PureBasic.
These decode audio data to frequency levels, you'd have to "scan" them and grab the peak frequency.

2. Doing EITHER of these (encode, decode) in REALTIME (microphone in, speaker out, etc) is out of my experience.
There should be examples on the forum for recording live audio, and for generating live audio output.
If you're just writing to files, then decoding back from files, that's easier!

Cheers.
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by idle »

I did a dtmf tone thing for windows xp a while back,
see here
viewtopic.php?p=302318#p302318

and if you want the src send a pm
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by Baldrick »

@ kenmo,
Thanks for your input. It is really the sound creation / encoding and decoding that has me a little stumped atm. The mapping and everything else should be relatively easy even for a bloke as rusty as me.
@Idle, I will take a good look at your DTMF code as I was actually thinking along those lines. Just a case of extend the 4 x 4 tones out to 16 x 16 tones, do a lot of testing to separate enough to give a good drift error comparator. Probably use a couple of single tones as a handshake to signal start of message, or similar.
Fwiw Idle, I actually run my own home grown software which I use as an alarm receiver over I.P. for an old analogue DTMF security protocol known as Contact ID using DTMF converter/ adapters which are manufactured in N.Z. :)
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by idle »

Baldrick wrote: Sun Oct 10, 2021 12:09 pm @Idle, I will take a good look at your DTMF code as I was actually thinking along those lines. Just a case of extend the 4 x 4 tones out to 16 x 16 tones, do a lot of testing to separate enough to give a good drift error comparator. Probably use a couple of single tones as a handshake to signal start of message, or similar.
Fwiw Idle, I actually run my own home grown software which I use as an alarm receiver over I.P. for an old analogue DTMF security protocol known as Contact ID using DTMF converter/ adapters which are manufactured in N.Z. :)
I used DTMF with skypeIN so I could do a few things from the phone with button pushes and activate voice recognition for more specific things. It only became a problem when the telco doing the actual crossover from landline to voip literally clipped out the DTMF tones. I surmised it was to stop the cheap international calling cards which were very popular with backpackers and students, they'd phone a local number then dial their international number, it essentially undercut the telco charges by 2-3 times if not more. so they thwarted them by filtering out the dtmf.

I haven't got it working yet with latest PB I need to replace callfunctionfast with prototypes.
I've got a better FFT routine as well
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by Baldrick »

idle wrote: Sun Oct 10, 2021 10:23 pm
I used DTMF with skypeIN so I could do a few things from the phone with button pushes and activate voice recognition for more specific things. It only became a problem when the telco doing the actual crossover from landline to voip literally clipped out the DTMF tones. I surmised it was to stop the cheap international calling cards which were very popular with backpackers and students, they'd phone a local number then dial their international number, it essentially undercut the telco charges by 2-3 times if not more. so they thwarted them by filtering out the dtmf.

I haven't got it working yet with latest PB I need to replace callfunctionfast with prototypes.
I've got a better FFT routine as well
A little offtopic-ish already, but that sort of sounds to me like the grief that was early days of Voip with competing RFC's and the "inband" " out of band" functions various service providers were struggling with at that time.
See here:
https://www.voip-info.org/sip-dtmf-signalling/


Fwiw, back in those days I studied for the Digium DCAP High end Asterisk certification while I was running a small softswitch ( Think I must have been the worlds smallest service provider....) for a year or so which gave me some pretty good insights into the Voip world back then. (Didnt have a spare Au$7,500.00 plus accomodation, etc for a couple of weeks doing training and exams to get that DCAP cert.)

Back on topic, I havent had a look at your code yet, but will when I get a spare few minutes. - Knowing I will struggle to remember the stuff I would have done without even thinking much back in the day. :)
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by idle »

yes the last paragraph seemed to explain the situation. G.723.1 codec seems to ring a bell it was a lossy 8 bit codec but it worked fine until they cottoned on and switched the codec for one that just plain filtered out the dtmf.

I still can't get it going on the vm, might need to try it with historical PB first as some things changed and it doesn't like the threaded window in the code example.

here's the better FFT routine code I mentioned.

Code: Select all

; /********************************************************************
;    F A S T   F O U R I E R   T R A N S F O R M   P R O G R A M S
; 
;   by Wang Jian-Sheng 4 Nov 1998, added fft2D(), 11 Apr 2003 
; ---------------------------------------------------------------------
;   port to PB 5.62 idle 22/12/18 
;
;   Reference: "Computational Frameworks for the Fast Fourier 
;               Transform", Charles Van Loan, SIAM, 1992.
; 
;   There are many FFT algorithms, the most important ones are
;      COOLEY-TUKEY:  in place, bit reversal
;      STOCKHAM AUTOSORT:  additional memory size of input Data
;      MIXED RADIX:  20% less operations comparing To Cooley-Tukey
;      PRIME FACTOR: arbitrary length n
; 
;   We use a combination of the Stockham autosort algorithm 1.7.2, 
;   page 57, And multirow Cooley-Tukey (3.1.7), page 124, of the 
;   reference above.  
; 
;   The discrete Fourier transform is defined by
;   y[k] = sum_(j=0,n-1) x[j] Exp(-2 Pi sqrt[-1] j k/n), 
;   k=0,1,...,n-1.  The factor (1/n) is Not included.  
;   If y[]<-x[]; fft(x,n,1); fft(x,n,-1); then y[]==x[]/n is true.
;   Three dimensional transform is generalized straightforwardly.
; 
;    Interface And usage:
;    1D Fourier transform 
;    Use: fft(x, n, flag)
;       x    : an Array of Structure type complex;
;       n    : the size of Data, must be a power of 2;
;       flag : 1 For forward transform, -1 For inverse transform.
; 
;    3D Fourier transform
;    Use :  fft3D(x, n1, n2, n3, flag)
;      x    : 1D Array of type complex representing 3D Array; 
;             mapping through C convention, i.e., 
;             (i,j,k) -> k + n3*j + n2*n3*i;
;      n1, n2, n3 : dimensions in three directions;
;      flag : same As in 1D.
; 
;    2D FFT is similar but With n1 And n2 only.


Structure complex 
  Re.d
  Im.d 
EndStructure   

Structure arcomplex 
  ar.complex[0]
EndStructure 

Procedure _stockham(*x.arcomplex,n.i,flag.i,n2.i,*y.arcomplex)

  Protected *y_orig.arcomplex 
  Protected *tmp.complex 
 
  Protected i.i, j.i, k.i, k2.i, Ls.i, r.i, jrs.i;
  Protected half, m, m2;
  Protected wr.d, wi.d, tr.d, ti.d;
   
   *y_orig = *y
   half = n >> 1
   r = half 
   Ls = 1                                     
  
   While(r >= n2) 
      *tmp = *x                  
      *x = *y                             
      *y = *tmp
      m = 0                      
      m2 = half                    
      j=0
      While j < ls
         wr = Cos(#PI*j/Ls)
         wi = -flag * Sin(#PI*j/Ls)            
         jrs = j*(r+r)
         k = jrs
         While k < jrs+r
            k2 = k + r
            tr =  wr * *y\ar[k2]\Re - wi * *y\ar[k2]\Im   
            ti =  wr * *y\ar[k2]\Im + wi * *y\ar[k2]\Re
            *x\ar[m]\Re = *y\ar[k]\Re + tr
            *x\ar[m]\Im = *y\ar[k]\Im + ti
            *x\ar[m2]\Re = *y\ar[k]\Re - tr
            *x\ar[m2]\Im = *y\ar[k]\Im - ti
            m+1
            m2+1
            k+1
         Wend 
          j+1
      Wend  
      r  >> 1
      Ls << 1
   Wend 

   If (*y <> *y_orig) 
      For i = 0 To n -1
         *y\ar[i] = *x\ar[i]
      Next 
   EndIf 
   
EndProcedure   

Procedure _cooley_tukey(*x.arcomplex,n.i,flag.i,n2.i)

   Protected c.complex  
   Protected i.i, j.i, k.i, m.i, p.i, n1.i
   Protected Ls.i, ks.i, ms.i, jm.i, dk.i
   Protected wr.d, wi.d, tr.d, ti.d
   Protected tm.l 
   n1 = n/n2 
   k=0
   While k < n1        
      j = 0 
      m = k
      p = 1                            
      While p < n1
        j << 1 
        j + (m & 1)   
        m >> 1
        p << 1 
      Wend 
              
      If j > k   
        i=0
        While i < n2
           c\Re = *x\ar[k*n2+i]\Re 
           c\im = *x\ar[k*n2+i]\Im  
           *x\ar[k*n2+i]\Re = *x\ar[j*n2+i]\Re 
           *x\ar[k*n2+i]\im = *x\ar[j*n2+i]\im 
           *x\ar[j*n2+i]\Re = c\Re 
           *x\ar[j*n2+i]\im = c\Im 
                      
           i+1  
         Wend  
      EndIf 
     k+1  
   Wend  
                                           
   p = 1
   While p < n1
     Ls = p 
     p << 1
     jm = 0                                                
     dk = p*n2
     j=0
     While j < Ls 
       wr = Cos((#PI*j/Ls))
       wi = -flag * Sin((#PI*j/Ls))
       k=jm
       While k < n 
         ks = k + Ls*n2
         i=0
         While i < n2 
           m = k + i
           ms = ks + i
           tr =  (wr * *x\ar[ms]\Re) - (wi * *x\ar[ms]\Im)
           ti =  (wr * *x\ar[ms]\Im) + (wi * *x\ar[ms]\Re)
           *x\ar[ms]\Re = *x\ar[m]\Re - tr
           *x\ar[ms]\Im = *x\ar[m]\Im - ti
           *x\ar[m]\Re + tr
           *x\ar[m]\Im + ti
           i+1
         Wend   
         k+dk 
       Wend    
       jm + n2
       j+1
     Wend
   Wend 
EndProcedure 

Procedure fft(*x.arcomplex,n.i,flag.i=1)
   Protected *y.arcomplex
   *y = AllocateMemory((n)*SizeOf(complex))
   _stockham(*x, n, flag, 1, *y)
   FreeMemory(*y) 
EndProcedure 

Procedure fft2D(*x.arcomplex,n1.i,n2.i,flag.i=1)

   Protected *y.arcomplex;
   Protected i, n
   
    n = n1*n2
   *y = AllocateMemory(n2*SizeOf(complex))
    i=0
    While i < n                               
      _stockham(@*x\ar[i],n2,flag, 1,*y) 
      i+n2  
    Wend  
   FreeMemory(*y)
   _cooley_tukey(@*x\ar[0], n, flag, n2)                               
EndProcedure 

Procedure fftCT(*x.arcomplex,n.l,flag.l=1)
  _cooley_tukey(*x\ar[0],n,flag,1)  
EndProcedure   

Procedure fft3D(*x.arcomplex,n1.i,n2.i,n3.i,flag.i=1)

   Protected *y.arcomplex;
   Protected i, n, n23;
   
   n23 = n2*n3;
   n = n1*n23;
   *y = AllocateMemory(n23*SizeOf(complex))
   
   For i=0 To n-1                                
      _stockham(@*x\ar[i], n3, flag, 1, *y)
      i+n3  
   Next 
   For i=0 To n-1                                
      _stockham(@*x\ar[i], n23, flag, n3, *y) 
      i+n23  
   Next 
   FreeMemory(*y)
   _cooley_tukey(@*x\ar[0], n, flag, n23)                             
 EndProcedure 
   
 Macro _Magnitude(complex) 
   Sqr(complex\re * complex\re + complex\im * complex\im) 
 EndMacro 
 
 Macro _Amplitude(complex,N) 
   Abs(complex\re) / N  
 EndMacro   
  
 Macro _FrequencyResolution(N,timeseconds)  
   ((1.0/timeseconds) / N)   
 EndMacro   
 
 Macro _Frequency(bin,FrequencyResolution)  
   bin * FrequencyResolution 
 EndMacro   
  
 CompilerIf #PB_Compiler_IsMainFile 
 
 Global Dim inp.complex(7) 
 Global a,b 
 For a = 0 To 3 
   inp(a)\Re = 1 
 Next 
 For a = 0 To 7
   Debug StrF(inp(a)\Re,3) + " " + StrF(inp(a)\Im,3)  
 Next  
  
 fft(@inp(0),8) 
  
 Debug "=========================================================" 
 For a = 0 To 7
    Debug StrF(inp(a)\Re,3) + " " + StrF(inp(a)\Im,3)  
 Next   
 
 Debug "IFFT========================================================="
 fft(@inp(0),8,-1) 
 For a = 0 To 7 
   Debug StrF(inp(a)\Re /8 ,3) ;+ " " + StrF(inp(a)\Im,3)  
 Next  
 
 Debug "2D Input======================================================="
 Global Dim inp2.complex(3,3) 
  For a = 1 To 2 
    For b = 1 To 2 
      inp2(a,b)\Re = 3 
      Debug inp2(a,b)\re   
    Next 
  Next 
  Debug "2D FFT========================================================="
 fft2d(@inp2(0,0),4,4)
  For a = 1 To 2 
    For b = 1 To 2 
      Debug StrF(inp2(a,b)\Re,3) + " " + StrF(inp2(a,b)\im,3) 
    Next 
  Next 
 
 Debug "2D IFFT========================================================="
 fft2d(@inp2(0,0),4,4,-1)
  For a = 1 To 2 
    For b = 1 To 2 
     Debug inp2(a,b)\re  / 16      
    Next 
  Next 
 
 CompilerEndIf 


Realizimo
User
User
Posts: 64
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by Realizimo »

Thanks idle for the code
This example is for wave-files 44100/16bit mono and stereo
It save the whole file in memory

Code: Select all

EnableExplicit
Structure complex 
  Re.f
  Im.f 
EndStructure   

Structure arcomplex 
  ar.complex[0]
EndStructure 

Procedure _stockham(*x.arcomplex,n.i,flag.i,n2.i,*y.arcomplex)  
  Protected *y_orig.arcomplex 
  Protected *tmp.complex 
  
  Protected.i i, j, k, k2, Ls, r, jrs
  Protected.i half, m, m2
  Protected.f wr, wi, tr, ti
  
  *y_orig = *y
  half = n >> 1
  r = half 
  Ls = 1                                     
  
  While(r >= n2) 
    *tmp = *x                  
    *x = *y                             
    *y = *tmp
    m = 0                      
    m2 = half                    
    j=0
    While j < ls
      wr = Cos(#PI*j/Ls)
      wi = -flag * Sin(#PI*j/Ls)            
      jrs = j*(r+r)
      k = jrs
      While k < jrs+r
        k2 = k + r
        tr =  wr * *y\ar[k2]\Re - wi * *y\ar[k2]\Im   
        ti =  wr * *y\ar[k2]\Im + wi * *y\ar[k2]\Re
        *x\ar[m]\Re = *y\ar[k]\Re + tr
        *x\ar[m]\Im = *y\ar[k]\Im + ti
        *x\ar[m2]\Re = *y\ar[k]\Re - tr
        *x\ar[m2]\Im = *y\ar[k]\Im - ti
        m+1
        m2+1
        k+1
      Wend 
      j+1
    Wend  
    r  >> 1
    Ls << 1
  Wend 
  
  If (*y <> *y_orig) 
    For i = 0 To n -1
      *y\ar[i] = *x\ar[i]
    Next 
  EndIf 
EndProcedure  

;    Use: fft(x, n, flag)
;       x    : an Array of Structure type complex;
;       n    : the size of Data, must be a power of 2;
;       flag : 1 For forward transform, -1 For inverse transform.
Procedure fft(*x.arcomplex , n.i , flag.i=1)
  Protected *y.arcomplex
  *y = AllocateMemory((n)*SizeOf(complex))
  _stockham(*x , n , flag, 1, *y)
  FreeMemory(*y) 
EndProcedure 

;- ---------------------------------------------------------
#band   = 40 
#maxfreq= 22000
#minfreq= 50
#rate   = 44100.0

Global.f freq_cashe
Global.f band20, band20000

Global.f magn1, magn2=0.17, magn3
Global i , key , pause
Global sample_max, sample_max2 ,rate, time_step.f
Global mem , memstep

Global cashe  = 11; (11=2048)
Global cashe2 = 1<<cashe;, cashe3
Global Dim max.f(1,#band)
Global Dim frekv(#band)

#band_w = 20
#scr_w  = #band_w*#band
#band_w2= #band_w*0.36

#fr_h   = 50
#high   = 400
#scr_h  = #high +#fr_h

InitSprite()
InitKeyboard()
OpenWindow(0 ,  0 ,  0 ,  #scr_w,  #scr_h ,  "S O U N D" ,  #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0) ,  0 ,  0 ,  #scr_w ,  #scr_h , 0 , 0 , 0 , 0)

Procedure proc_sprite6()
  Protected x
  magn3  = magn1*magn2
  SetWindowTitle(0, "S O U N D        //     cashe = "+Str (cashe2)+"     //     Magnitude =  "+StrF(magn3*10000,3)) 
  StartDrawing(SpriteOutput(6))
  ;      DrawingMode(#PB_2DDrawing_Transparent )
  Box(0,0,#scr_w,#fr_h,0)
  For i=1 To #band
    DrawRotatedText(i*#band_w-1,4,Str(frekv(i-1)*freq_cashe),270,#White)
;     Debug Str(frekv(i-1)) + " " + Str(frekv(i-1)*freq_cashe)
  Next i
  StopDrawing()
EndProcedure

Procedure proc_cashe()
  Protected.f Frekv2 ,  p , s ,  s1
  cashe2 = 1<<cashe
  Global Dim inp.complex(cashe2-1)
  Global Dim cos2.f(cashe2-1)
;   cashe3 = cashe2/2-1
  
  freq_cashe= #rate/cashe2 ; 21.53
  band20000 = #maxfreq/freq_cashe
  band20    = Int(#minfreq/freq_cashe)+1
  Frekv2 = band20
  p = (Pow(band20000,1/#band)-Pow(band20,1/#band))/Pow(band20,1/#band)+1
  Debug p
  magn1  = 1 / cashe2 + 0.0001
  ;   If cashe3=>#band: cashe3=#band: EndIf

  sample_max2=sample_max-rate/50 -cashe2
  time_step = #scr_w/sample_max2  
  
  s = (#PI*2)/(cashe2-1)
  s1 = #PI
  For i=1 To cashe2
    cos2(i-1)=(Cos(s1)+1)/2
    Debug Str(i)+" "+StrF(cos2(i-1),4)
    s1+s
  Next
  
  For i=1 To #band
    Frekv2*p
    frekv(i-1)=Frekv2
  Next i
  proc_sprite6()
  Debug ""
EndProcedure

Procedure proc_dosprite()
  Protected Dim col(5)
  col(1)=#Green
  col(2)=#Yellow
  col(3)=#Green
  col(4)=#Yellow
  col(5)=#Cyan
  For i=1 To 5
    If i=5 :CreateSprite(i ,6,6 )
    Else   :CreateSprite(i ,#band_w2 ,Bool(i<3)*#high+2 )
    EndIf  
    StartDrawing(SpriteOutput(i))
    FillArea(1,1,4,col(i))
    StopDrawing()
  Next i
  Protected Frekv2.f=50 ;, Dim Frekv(#spectrum_nr)
  CreateSprite(6 ,(#band+1)*#band_w,#fr_h)
EndProcedure

; Debug GetCurrentDirectory()
; SetCurrentDirectory("C:\Users\Daniel\Desktop\pure-code\2021\sound\wave")
Procedure proc_Initialize_sound() 
  Protected Filename$ , Header  ,chan , bits
  Static ok
  Repeat 
    Filename$ = OpenFileRequester("Choose a wav","","Wav files|*.wav|",0)
    If Filename$
      If OpenFile(0,Filename$)
        Debug Filename$
        Debug Str(Lof(0))+" bytes"
        Header = AllocateMemory(Lof(0),#PB_Memory_NoClear)  
        ReadData(0, Header, Lof(0))
        CloseFile(0)
        InitSound()
        CatchSound(0 ,Header)
        ;         SetSoundFrequency(0,44100)
        SoundVolume(0 , 10)
        PlaySound(0)
        sample_max = SoundLength(0)        
        mem  = Header
        chan = PeekW(Header+22) ; chanals
        rate = PeekL(Header+24) ; SampleFreq
        bits = PeekW(Header+34) ; bits
      Else
        Debug "error"
      EndIf
    Else
      If ok :ProcedureReturn :Else :End :EndIf
    EndIf
    Debug StrF(sample_max/rate,1) + " sec"
    ;     Debug StrF(SoundLength(0,#PB_Sound_Millisecond)/1000,1) + " sec"
    Debug chan
    Debug rate
    Debug bits
    Debug "--------------"
  Until (chan=1 Or chan=2) And rate=44100 And bits=16
  pause = 0
  ok=1
  mem  = Header + 44
  memstep = chan*2
EndProcedure

Procedure proc_keys()
  If KeyboardPushed(#PB_Key_Up)      :magn2*(1+cashe*0.001)  : proc_sprite6()
  ElseIf KeyboardPushed(#PB_Key_Down):magn2*(1-cashe*0.001) : proc_sprite6()
  EndIf
  If KeyboardReleased(#PB_Key_Left)And cashe>5 :cashe-1 :proc_cashe()
  ElseIf KeyboardReleased(#PB_Key_Right)And cashe<16:cashe+1 :proc_cashe()
  EndIf
  
  If KeyboardPushed(#PB_Key_O): proc_Initialize_sound():proc_cashe(): EndIf
  If KeyboardPushed(#PB_Key_Space) 
    If key
      pause!1
      If pause : PauseSound(0): Else: ResumeSound(0): EndIf
    EndIf
    key=0
  Else
    key=1
  EndIf
EndProcedure

Procedure proc_draw(channel)
  Protected x,x2 , magn.f , loops  
  For i=band20 To band20000
    magn +Sqr(inp(i)\Re * inp(i)\Re + inp(i)\im * inp(i)\im)
    loops+1
    If i<frekv(x) : Continue : EndIf
    magn/loops
    magn*magn3
    If magn>#high-5: magn=#high-5:EndIf    
    x2 = X*#band_w + (2+#band_w2)*channel + 2
    DisplaySprite(1+channel , X2 , #high-magn)    
    If max(channel,x)<=magn :max(channel,x)=magn: EndIf;:max2(channel,x)=u(x): EndIf
    max(channel,x)-1
    DisplaySprite(3+channel , x2 , #high-max(channel,x))    
    x+1
    magn=0
    loops=0
  Next i
EndProcedure

proc_Initialize_sound()
proc_dosprite()
proc_cashe()
Define sample, sample2 , mem2
;  SetSoundPosition(0, sample_max*0.985)
Repeat
  ClearScreen(0)
  WindowEvent() 
  ExamineKeyboard()
  proc_keys()
  sample = GetSoundPosition(0)
  If sample<>sample2
    If sample>sample_max2 :PlaySound(0) : Debug "Restart "+Str(sample -sample_max) :sample=0 :EndIf
    If SoundStatus(0)=#PB_Sound_Stopped: PlaySound(0) : Debug "Restart2 "+Str(sample2 -sample_max) :sample=0 :EndIf
    
    mem2 = mem + sample*memstep
    For i = 0 To cashe2-1 
      inp(i)\Re = PeekW(mem2)*cos2(i) :mem2+memstep
      inp(i)\Im = 0
    Next 
    fft(@inp(0),cashe2,1)
    proc_draw(0)
    
    If memstep=4
      mem2 = mem + sample*4+2
      For i = 0 To cashe2-1 
        inp(i)\Re = PeekW(mem2)*cos2(i) :mem2+4
        inp(i)\Im = 0
      Next 
      fft(@inp(0),cashe2,1)
    EndIf
    proc_draw(1)
    
    DisplaySprite(6,0,#high)
    DisplaySprite(5,sample*time_step,#high)
    FlipBuffers()
  Else 
    Delay(10)
  EndIf
  sample2=sample
Until KeyboardPushed(#PB_Key_Escape) Or Event()=#PB_Event_CloseWindow; Or ElapsedMilliseconds()>20000
User avatar
Tenaja
Addict
Addict
Posts: 1948
Joined: Tue Nov 09, 2010 10:15 pm

Re: Wondering if anybody might be able to point me to a way with PB to Encode / Decode Tones

Post by Tenaja »

If you are looking at simple sine waves, autocorrelation might be a better (simpler) thing to implement than fft.
https://en.m.wikipedia.org/wiki/Autocorrelation
Post Reply