SndStereoSave for PHOENIX
#1
Hi team.

How it goes? Here I've modified my audio save routine quite a bit, cheekily borrowing a few things from @a740g and after some trouble it seems to work as expected. It's the first version, it can only do stereo, it doesn't even have subsampling. I will add all this gradually. Just one question: 32 bit WAV sound. Is the type SINGLE used in WAV containers? Windows media player didn't really want to understand it and played like if you ride a bike on a road paved with cobblestones and sing along... (so I converted it to the LONG type and it plays cleanly). Does anyone know?


Code: (Select All)
'SndStereoSave by Petr for PHOENIX 3.5.0

Dim Song As Long
Song = _SndOpen("vi.mp3") ' Replace file name with your sound file
Dim As _MEM N
N = _MemSound(Song, 0)

'convert MP3 as WAV!

If SndChannels(Song) < 2 Then Print "Sorry, this is just for stereo (first version).": End
SndStereoSave N, "Test.wav" 'tested on WAV 16bit stereo, XM file (stereo), MP3 (stereo), all pass


'create the same music as in Song, but so that it plays backwards. Lets try _SndNew!
'the same its for own music created in QB64

Select Case SNDGetBites(N)
    Case 1, 2: bites& = 32
    Case 3: bites& = 16
    Case 4: bites& = 8
End Select

NM& = _SndNew(_SndLen(Song) * _SndRate, SndChannels(Song), bites&)

Dim Done As _Offset, PlusStep As _Offset, Value As Single, NewMusic As _MEM

NewMusic = _MemSound(NM&, 0)

Done = N.SIZE - N.ELEMENTSIZE
Do Until Done = 0
    _MemGet N, N.OFFSET + Done, Value
    _MemPut NewMusic, NewMusic.OFFSET + PlusStep, Value
    Done = Done - 4
    PlusStep = PlusStep + 4
Loop
SndStereoSave NewMusic, "Backward.wav"

_MemFree N
_MemFree NewMusic
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) 'work by a740g
    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

It is good! I was so focused on functionality that I forgot to add labels to the program Smile

So - on line 4, enter a valid name for your music file for Phoenix and then run it. The program is stingy with words, it doesn't write anything on your screen, it keeps secrets. Smile
Your music file will be saved in WAV format to the file test.wav and backward.wav, then play them to check the functionality. Backward.wav is saved vice versa, plays from the end to begin.


Reply


Messages In This Thread
SndStereoSave for PHOENIX - by Petr - 02-20-2023, 07:05 PM
RE: SndStereoSave for PHOENIX - by a740g - 02-20-2023, 07:52 PM
RE: SndStereoSave for PHOENIX - by Petr - 02-21-2023, 05:28 PM
RE: SndStereoSave for PHOENIX - by Petr - 04-24-2023, 06:25 PM
RE: SndStereoSave for PHOENIX - by mnrvovrfc - 04-25-2023, 09:22 AM



Users browsing this thread: 1 Guest(s)