Mostrare in tempo reale i decibel dell'audio catturato con le funzioni esterne del API di ALSA
Da Gambas-it.org - Wikipedia.
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