Versione delle 12:44, 23 lug 2017

Per ottenere e mostrare in tempo reale i decibel dell'audio catturato con le funzioni esterne del API di ALSA, possiamo adottare il codice che segue:

Private handle As Pointer
Private bo As Boolean
Private lb As Label

 
Library "libasound:2"

Private Const SND_PCM_STREAM_CAPTURE As Byte = 1
Private Const SND_PCM_FORMAT_S16_LE As Byte = 2
Private Const SND_PCM_ACCESS_RW_INTERLEAVED As Byte = 3

' int snd_pcm_open(snd_pcm_t **pcm, const char *name, snd_pcm_stream_t stream, int mode)
' Opens a PCM.
Private Extern snd_pcm_open(handleP As Pointer, nome As String, flusso As Integer, mode As Integer) As Integer

' int snd_pcm_set_params(snd_pcm_t * pcm, snd_pcm_format_t format, snd_pcm_access_t access, unsigned int channels, unsigned int rate, int soft_resample, unsigned Int latency)
' Set the hardware and software parameters in a simple way.
Private Extern snd_pcm_set_params(pcm As Pointer, formatInt As Integer, accesso As Integer, channels As Integer, rate As Integer, soft_resample As Integer, latency As Integer) As Integer

' snd_pcm_sframes_t snd_pcm_readi (snd_pcm_t *pcm, void *buffer, snd_pcm_uframes_t size)
' Read interleaved frames from a PCM.
Private Extern snd_pcm_readi(pcm As Pointer, buffer As Pointer, size As Integer) As Integer

' const char * snd_strerror (int errnum)
' Returns the message for an error code.
Private Extern snd_strerror(errnum As Integer) As String

' int snd_pcm_recover (snd_pcm_t *pcm, int err, int silent)
' Recover the stream state from an error or suspend.
Private Extern snd_pcm_recover(pcm As Pointer, err As Integer, silent As Integer) As Integer

' snd_pcm_close(snd_pcm_t *pcm)
' Close PCM handle.
Private Extern snd_pcm_close(pcm As Pointer)


Public Sub Form_Open()
 
 Dim err As Integer
   
' Apre il sub-sistema PCM di ALSA per la registrazione:
  err = snd_pcm_open(VarPtr(handle), "default", SND_PCM_STREAM_CAPTURE, 0)
  If err < 0 Then Error.Raise("Errore nell'apertura del sub-sistema PCM: " & snd_strerror(err))
  
' Imposta i parametri del sub-sistema PCM di ALSA per la registrazione:
  err = snd_pcm_set_params(handle, SND_PCM_FORMAT_S16_LE, SND_PCM_ACCESS_RW_INTERLEAVED, 1, 48000, 1, 500000)
  If err < 0 Then
    snd_pcm_close(handle)
    Error.Raise("Errore nell'impostazione dei parametri del sub-sistema PCM: " & snd_strerror(err))
  Endif
  
  With ProgressBar1
    .Value = 0
    .Label = False
  End With
  
  With lb = New Label(ProgressBar1)
    .Background = Color.Transparent
    .Alignment = Align.Center
  End With
  
  bo = True
  
End


Public Sub Button1_Click()
 
 Dim err, dB, picco_max As Integer
 Dim picco As Float
 Dim buffer As Short[]
 Dim buffer_size, frames As Long
 Dim b As Byte
 
' La formula di dB è: 20log(Pressione_sonora / P0).
' Assumendo che Pressione_sonora / P0 = k * valore_del_campione (lineare), si ottiene sperimentalmente che k = 0.45255.
 Dim k As Float = 0.45255
  
  buffer = New Short[8 * 1024]
 
  buffer_size = CLong(Shr(buffer.Count * SizeOf(gb.Short), 1))
  
  While bo
' Legge i dati intercettati:
    frames = snd_pcm_readi(handle, buffer.Data, buffer_size)
    If frames < 0 Then
' Tenta di ripristinare:
      err = snd_pcm_recover(handle, frames, 0)
      If err < 0 Then
        snd_pcm_close(handle)
        Error.Raise("Errore alla funzione snd_pcm_readi( ): " & snd_strerror(err))
      Endif
    Endif
  
    If (frames > 0) And (frames < CLong(buffer_size)) Then
      snd_pcm_close(handle)
      Error.Raise("Lettura dati ridotta (atteso: " & CStr(buffer_size) & ", letto: " & CStr(frames) & ")")
    Endif
       
' Calcola dB e aggiorna eventualmente il valore di picco:
    picco = rms(buffer, buffer_size) * k
    dB = CInt(20 * Log10(picco))
    If dB > picco_max Then picco_max = dB
       
    For b = 1 To 8
      ProgressBar1.Value = dB / 100
      lb.Text = CStr(dB) & " dB"
' Una brevissima pausa consente di agire su eventuali oggetti posti sul Form:
      Wait 0.001
    Next
    
    Label1.Text = "Picco max: " & CStr(picco_max) & " dB"
  
  Wend
  
' Va in Chiusura liberando la memoria precedentemente occupata:
  buffer.Clear
  snd_pcm_close(handle)
  Me.Close
  
End


Public Sub Button2_Click()
 
  bo = False
  
End


' Funzione per il calcolo della radice quadrata media del buffer campione.
' Essa può calcolare un'ampiezza media del buffer.
Private Function rms(buf As Short[], dimbuffer As Long) As Float
 
 Dim i As Integer
 Dim somma_quadra As Long
 Dim result As Float
  
  For i = 0 To dimbuffer - 1
    somma_quadra += CLong(buf[i]) * CLong(buf[i])
  Next
  result = Sqr(somma_quadra / dimbuffer)
  
  Return result
  
End

Riferimenti

• https://it.wikipedia.org/wiki/Decibel
• http://fisicaondemusica.unimore.it/Percezione_dell_intensit.html
• https://tecnologiamusicale.wordpress.com/2012/07/28/lintensita-di-un-suono-e-la-scala-logaritmica-dei-decibel/
• http://pls.dima.unige.it/pls0409/Logaritmo/Berto/decibel.htm
• https://www.inventati.org/radiotorre/Archivio/Audio-PuntoInterrogativo/Decibel.pdf