Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Audio storage, stereo switching
#3
first of all sorry for the confusion, the above way of saving sound only works in older versions. I looked into it and here is a way to save the sound generated by the program, this time as WAV, 8 bit, stereo. But if you configure _NewSound differently and then put the correct resampling in the _NewSound field, you can of course save it in better quality (16 bit stereo or 32 bit stereo, SndStereoSave will handle that. The only thing I couldn't debug is the crackling at the end in the saved file, I'll fix it later, but if someone beats me to it, I'll be happy Smile

Code: (Select All)
'SOUND created in Phoenix and then saved as WAV

t = 0
tmp$ = "Sample = ##.#####   Time = ##.#####"
Locate 1, 60: Print "Rate:"; _SndRate

'------ modification -------
Dim SNDREC(_SndRate * 3.00239) As _Unsigned _Byte 'sound duration is 3,1 seconds, use _unsigned _byte for 8 bit record
'------ modification -------
'fill SNDREC array with zeros (silent)
For silent = 0 To UBound(SNDREC)
    SNDREC(silent) = 0~%
Next
Print "Phoenix generate sound..."
Do
    'queue some sound
    Do While _SndRawLen < 0.1 'you may wish to adjust this
        sample = Sin(t * 440 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ď€)
        sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound

        '------ modification -------
        SNDREC(rec) = 127 * sample + 128 ' recalculate samples for 8 bit record
        rec = rec + 1
        '------ modification -------

        _SndRaw sample
        t = t + 1 / _SndRate 'sound card sample frequency determines time
    Loop

    'do other stuff, but it may interrupt sound
    Locate 1, 1: Print Using tmp$; sample; t
Loop While t < 3.0 'play for 3 seconds

Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop

Print "Phoenix save this sound as 8 bit stereo WAV file Ding.Wav"

'------ modification -------

Dim LR As _MEM
NewSound = _SndNew(_SndRate * 3.1, 2, 8) 'create stereo 8 bit snd record
LR = _MemSound(NewSound, 0)

Dim REC As _Unsigned _Byte
'because created sound is MONO but we recording it as stereo, create here pseudo stereo directly to created empty stream:

done = 0
Do Until done = UBound(SNDREC)
    REC = SNDREC(done)
    _MemPut LR, LR.OFFSET + RECINDEX, REC 'left
    _MemPut LR, LR.OFFSET + RECINDEX + 1, REC 'right
    done = done + 1
    RECINDEX = RECINDEX + 2 'switch by 2 bytes in LR MEM array (because its 8 bite per record = 1 byte for left and 1 byte for right channel)
Loop



Print "Saving sound as ding.wav..."
SndStereoSave LR, "Ding.wav"
Print "Phoenix play saved 8 bit file Ding.wav"
_SndPlayFile "Ding.wav"
End




Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
            'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
            _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function


Sub SndStereoSave (arr As _MEM, file As String)
    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As _Unsigned Long '              4 bytes  (file size)  velikost souboru
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As _Unsigned Long '            4 bytes  Data block size
    End Type '                     44 bytes  total

    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset(arr.SIZE)
    H16.fomat = "WAVE"
    H16.sub1 = "fmt "

    H16.subchunksize = 16

    H16.format = 1
    H16.channels = 2
    H16.rate = _SndRate

    Select Case SNDGetBites(arr)
        Case 1, 2: H16.Bits = 32
        Case 3: H16.Bits = 16
        Case 4: H16.Bits = 8
    End Select

    H16.ByteRate = (_SndRate * 2 * H16.Bits) / 8
    H16.Block = (2 * H16.Bits) / 8

    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset(arr.SIZE)
    If _FileExists(file$) Then Kill file$

    Audio$ = Space$(ConvertOffset(arr.SIZE))
    If SNDGetBites(arr) = 1 Then 'convert values from SINGLE to LONG values, because Marena from the cowshed said it should be like that :)    /Czech Joke/
        Dim A As _MEM, VS As Single, VL As Long
        A = _MemNew(arr.SIZE)
        Do Until done& = arr.SIZE
            VS = _MemGet(arr, arr.OFFSET + done&, Single)
            VL& = 2147483648 * VS
            _MemPut A, A.OFFSET + done&, VL&
            done& = done& + 4
        Loop
        _MemGet A, A.OFFSET, Audio$
        _MemFree A
    Else
        _MemGet arr, arr.OFFSET, Audio$
    End If
    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""

    Close ch
End Sub

Function SNDGetBites (handle As _MEM)
    Select Case handle.TYPE
        Case 260: SNDGetBites = 1 ' 32-bit floating point SINGLE
        Case 132: SNDGetBites = 2 ' 32-bit integer LONG
        Case 130: SNDGetBites = 3 ' 16-bit integer INTEGER
        Case 1153: SNDGetBites = 4 ' 8-bit unsigned integer
    End Select
End Function

Function SndChannels~%% (handle As Long)
    Dim SampleData As _MEM
    ' Check if the sound is valid
    SampleData = _MemSound(handle, 0)
    If SampleData.SIZE = 0 Then
        Print "SndChannels: MemSound return ZERO for audio data size!"
        Exit Function
    End If

    ' Check the data type and then decide if the sound is stereo or mono
    Select Case SampleData.TYPE
        Case 260 ' 32-bit floating point
            If SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 132 ' 32-bit integer
            If SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 130: ' 16-bit integer
            If SampleData.ELEMENTSIZE = 2 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 2
            End If
        Case 1153: ' 8-bit unsigned integer
            If SampleData.ELEMENTSIZE = 1 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 2 Then
                SndChannels = 2
            End If
    End Select
    _MemFree SampleData
End Function
Here is a corrected version of the program without the end click. While I would swear that the above program worked correctly in some older versions (some of the early PE versions), it now throws errors in version 4.0. These are removed in the following program, as is the end click.

Code: (Select All)
'SOUND created in Phoenix and then saved as WAV Revision to QB64PE IDE 4.0.0 x32 - 01-18-25
t = 0
tmp$ = "Sample = ##.#####  Time = ##.#####"
Locate 1, 60: Print "Rate:"; _SndRate
'------ modification -------
Dim SNDREC(_SndRate * 4) As _Unsigned _Byte 'sound duration is 3,1 seconds, use _unsigned _byte for 8 bit record
'------ modification -------
'fill SNDREC array with zeros (silent)
For silent = 0 To UBound(SNDREC)
    SNDREC(silent) = 0~%
Next
Print "Phoenix generate sound..."
Do
    'queue some sound
    Do While _SndRawLen < 0.01 'you may wish to adjust this
        sample = Sin(t * 440 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ď€)
        sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound
        '------ modification -------
        SNDREC(rec) = 128 * sample + 127 ' recalculate samples for 8 bit record
        rec = rec + 1
        '------ modification -------
        _SndRaw sample
        t = t + 1 / _SndRate 'sound card sample frequency determines time
    Loop
    'do other stuff, but it may interrupt sound
    Locate 1, 1: Print Using tmp$; sample; t
Loop While t < 3.0 'play for 3 seconds
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
Print "Phoenix save this sound as 8 bit stereo WAV file Ding.Wav"
'------ modification -------
Dim LR As _MEM
NewSound = _SndNew(_SndRate * 4, 2, 8) 'create stereo 8 bit snd record
LR = _MemSound(NewSound, 0)
Dim REC As _Unsigned _Byte
'because created sound is MONO but we recording it as stereo, create here pseudo stereo directly to created empty stream:
done = 0
Do Until done = _Ceil(t * _SndRate)
    REC = SNDREC(done)
    _MemPut LR, LR.OFFSET + RECINDEX, REC 'left
    _MemPut LR, LR.OFFSET + RECINDEX + 1, REC 'right
    done = done + 1
    RECINDEX = RECINDEX + 2 'switch by 2 bytes in LR MEM array (because its 8 bite per record = 1 byte for left and 1 byte for right channel)
Loop
Print "Saving sound as ding.wav..."
SndStereoSave LR, "Ding.wav"
Print "Phoenix play saved 8 bit file Ding.wav"
_SndPlayFile "Ding.wav"
End
Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
            'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
            _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function
Sub SndStereoSave (arr As _MEM, file As String)
    Type head16
        chunk As String * 4 '      4 bytes  (RIFF)
        size As _Unsigned Long '              4 bytes  (file size)  velikost souboru
        fomat As String * 4 '      4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '        2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '      2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '          2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '  4 bytes  ("data")  contains begin audio samples
        lenght As _Unsigned Long '            4 bytes  Data block size
    End Type '                    44 bytes  total
    Dim H16 As head16
    ch = FreeFile
    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset(arr.SIZE)
    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = _SndRate
    Select Case SNDGetBites(arr)
        Case 1, 2: H16.Bits = 32
        Case 3: H16.Bits = 16
        Case 4: H16.Bits = 8
    End Select
    H16.ByteRate = (_SndRate * 2 * H16.Bits) / 8
    H16.Block = (2 * H16.Bits) / 8
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset(arr.SIZE)
    If _FileExists(file$) Then Kill file$
    Audio$ = Space$(ConvertOffset(arr.SIZE))
    If SNDGetBites(arr) = 1 Then
        Dim A As _MEM, VS As Single, VL As Long
        A = _MemNew(arr.SIZE)
        Do Until done& = arr.SIZE
            VS = _MemGet(arr, arr.OFFSET + done&, Single)
            VL& = 2147483648 * VS
            _MemPut A, A.OFFSET + done&, VL&
            done& = done& + 4
        Loop
        _MemGet A, A.OFFSET, Audio$
        _MemFree A
    Else
        _MemGet arr, arr.OFFSET, Audio$
    End If
    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""
    Close ch
End Sub
Function SNDGetBites (handle As _MEM)
    Select Case handle.TYPE
        Case 260: SNDGetBites = 1 ' 32-bit floating point SINGLE
        Case 132: SNDGetBites = 2 ' 32-bit integer LONG
        Case 130: SNDGetBites = 3 ' 16-bit integer INTEGER
        Case 1153: SNDGetBites = 4 ' 8-bit unsigned integer
    End Select
End Function
Function SndChannels~%% (handle As Long)
    Dim SampleData As _MEM
    ' Check if the sound is valid
    SampleData = _MemSound(handle, 0)
    If SampleData.SIZE = 0 Then
        Print "SndChannels: MemSound return ZERO for audio data size!"
        Exit Function
    End If
    ' Check the data type and then decide if the sound is stereo or mono
    Select Case SampleData.TYPE
        Case 260 ' 32-bit floating point
            If SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 132 ' 32-bit integer
            If SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 130: ' 16-bit integer
            If SampleData.ELEMENTSIZE = 2 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 4 Then
                SndChannels = 2
            End If
        Case 1153: ' 8-bit unsigned integer
            If SampleData.ELEMENTSIZE = 1 Then
                SndChannels = 1
            ElseIf SampleData.ELEMENTSIZE = 2 Then
                SndChannels = 2
            End If
    End Select
    _MemFree SampleData
End Function


Reply


Messages In This Thread
Audio storage, stereo switching - by Petr - 02-18-2023, 09:21 PM
RE: Audio storage, stereo switching - by Petr - 02-20-2023, 08:26 PM
RE: Audio storage, stereo switching - by Petr - 01-18-2025, 04:47 PM
RE: Audio storage, stereo switching - by bplus - 01-18-2025, 07:59 PM
RE: Audio storage, stereo switching - by Petr - 01-18-2025, 08:48 PM
RE: Audio storage, stereo switching - by bplus - 01-18-2025, 08:50 PM
RE: Audio storage, stereo switching - by Petr - 01-18-2025, 09:03 PM
RE: Audio storage, stereo switching - by madscijr - 02-22-2025, 07:55 PM
RE: Audio storage, stereo switching - by Petr - 02-22-2025, 08:56 PM
RE: Audio storage, stereo switching - by madscijr - 02-24-2025, 05:25 PM
RE: Audio storage, stereo switching - by Petr - 02-22-2025, 11:09 PM
RE: Audio storage, stereo switching - by Petr - 02-24-2025, 09:29 PM
RE: Audio storage, stereo switching - by madscijr - 02-25-2025, 12:04 AM



Users browsing this thread: 1 Guest(s)