Per gli utenti, ...vicini e lontani, ho tradotto in Gambas il simpatico programmino, scritto in C, sopra indicato da
.
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, peak As Integer
Dim k As Float = 0.45255
Dim Pvalue As Float
Dim buffer As Short[]
Dim buffer_size, frames As Long
Dim b As Byte
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:
Pvalue = rms(buffer, buffer_size) * k
dB = CInt(20 * Log10(Pvalue))
If dB > peak Then peak = dB
For b = 1 To 8
ProgressBar1.Value = dB / 100
lb.Text = CStr(dB) & " dB"
Wait 0.001
Next
Label1.Text = "Picco max: " & CStr(peak) & " 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
Private Function rms(buf As Short[], dimbuffer As Long) As Float
Dim i As Integer
Dim square_sum As Long
Dim result As Float
For i = 0 To dimbuffer - 1
square_sum += CLong(buf[i]) * CLong(buf[i])
Next
result = Sqr(square_sum / dimbuffer)
Return result
End
