Versione attuale delle 10:20, 6 gen 2024

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.0.0"

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
   If picco <> 0 Then 
     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
   Else
     ProgressBar1.Value = 0.0
     lb.Text = "0 dB"
     Wait 0.001
   Endif
   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