+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Audio storage, stereo switching (/showthread.php?tid=1483)
Audio storage, stereo switching - Petr - 02-18-2023
Hello. I went through the forum and found some questions about saving sound and also questions about whether it is possible to create and save sound in QB64. The answer to both is yes. The attached program is from January 5, 2021, when I was actively involved. Then the forum was destroyed and I vowed not to spend time on something that would just disappear overnight. I'm here today after a long time (I'm using QB64 2.02) and I see that there might be interest in this, so I'm posting it here. My SaveSound16S will be useful, it saves your sound in stereo WAV file format and I used it for testing because SNDRAW had problems with stereo (I don't know how it is with this command now).
This program open your music file, then create WAV file from it named as TestEff3.wav (contains stereo switching) and then play it using SNDPLAYFILE statement.
Code: (Select All)
DIM left AS _MEM
DIM Right AS _MEM
DIM AudioL AS INTEGER
DIM AudioR AS INTEGER
DIM L AS INTEGER
DIM R AS INTEGER
DIM NewSound AS _MEM
INPUT "Insert music STEREO file name"; snd$
IF _FILEEXISTS(snd$) THEN
snd = _SNDOPEN(snd$)
IF snd > 0 THEN
left = _MEMSOUND(snd, 1)
Right = _MEMSOUND(snd, 2)
IF Right.SIZE > 0 THEN
NewSound = _MEMNEW(left.SIZE * 2)
DO UNTIL s& = left.SIZE
_MEMGET left, left.OFFSET + s&, AudioL
_MEMGET Right, Right.OFFSET + s&, AudioR
L = AudioL * ABS(SIN(sinus)) ' SINUS is LEFT/RIGHT CHANNEL SWITCH :)
R = AudioR * ABS(COS(sinus))
_MEMPUT NewSound, NewSound.OFFSET + t&, L
_MEMPUT NewSound, NewSound.OFFSET + t& + 2, R
sinus = sinus + .00001
s& = s& + 2
t& = t& + 4
LOOP
ELSE
PRINT "This sound file is not stereo!"
END
END IF
ELSE
PRINT "File exists, bud this music format is not supported."
END
END IF
ELSE
PRINT "File "; snd$; " not found."
END
END IF
SAVESOUND16S NewSound, "TestEff3.wav"
_SNDPLAYFILE "TestEff3.wav"
END
SUB SAVESOUND16S (arr AS _MEM, file AS STRING)
TYPE head16
chunk AS STRING * 4 ' 4 bytes (RIFF)
size AS LONG ' 4 bytes (file size)
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 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) / _SNDRATE / 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
H16.fomat = "WAVE"
H16.sub1 = "fmt "
H16.subchunksize = 16
H16.format = 1
H16.channels = 2
H16.rate = 44100
H16.ByteRate = 44100 * 2 * 16 / 8
H16.Block = 4
H16.Bits = 16
H16.subchunk2 = "data"
H16.lenght = ConvertOffset&&(arr.SIZE)
' $END IF
IF _FILEEXISTS(file$) THEN KILL file$
Audio$ = SPACE$(ConvertOffset&&(arr.SIZE))
_MEMGET arr, arr.OFFSET, Audio$
OPEN file$ FOR BINARY AS #ch
PUT #ch, , H16
PUT #ch, , Audio$
Audio$ = ""
CLOSE ch
END SUB
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 FUNCTIONand to querstion 2 - is possible creating and saving sound using QB64? YES:
Code: (Select All)
'this program is from SNDRAW help, create sound using QB64, modifie so, it also save this sound.
t = 0
tmp$ = "Sample = ##.##### Time = ##.#####"
Locate 1, 60: Print "Rate:"; _SndRate
'------ modification -------
Dim SNDREC(44100 * 3.1) As Integer 'sound duration is 3 seconds, use 44100 samples/sec
'------ modification -------
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
_SndRaw sample
'------ modification -------
SNDREC(rec) = 32768 * sample
rec = rec + 1
'------ modification -------
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 rec
'------ modification -------
Dim L As _MEM
Dim LR As _MEM
Dim REC As Integer
L = _Mem(SNDREC())
'because created sound is MONO but we recording it as stereo, create here pseudo stereo memory array:
LR = _MemNew(L.SIZE * 2)
done = 0
Do Until done = L.SIZE
_MemGet L, L.OFFSET + done, REC
_MemPut LR, LR.OFFSET + RECINDEX, REC 'left
_MemPut LR, LR.OFFSET + RECINDEX + 2, REC 'right
done = done + 2 'switch by 2 bytes in L MEM array
RECINDEX = RECINDEX + 4 'switch by 4 bytes in LR MEM array
Loop
_MemFree L
Print "Saving sound as ding.wav..."
SAVESOUND16S LR, "ding.wav"
_MemFree LR
Print "Playing created file ding.wav..."
_SndPlayFile "ding.wav"
End
Sub SAVESOUND16S (arr As _MEM, file As String)
Type head16
chunk As String * 4 ' 4 bytes (RIFF)
size As Long ' 4 bytes (file size)
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 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) / _SndRate / 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
H16.fomat = "WAVE"
H16.sub1 = "fmt "
H16.subchunksize = 16
H16.format = 1
H16.channels = 2
H16.rate = 44100
H16.ByteRate = 44100 * 2 * 16 / 8
H16.Block = 4
H16.Bits = 16
H16.subchunk2 = "data"
H16.lenght = ConvertOffset&&(arr.SIZE)
' $END IF
If _FileExists(file$) Then Kill file$
Audio$ = Space$(ConvertOffset&&(arr.SIZE))
_MemGet arr, arr.OFFSET, Audio$
Open file$ For Binary As #ch
Put #ch, , H16
Put #ch, , Audio$
Audio$ = ""
Close ch
End Sub
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 FunctionProgram create sound (used for this is program from QB64 SNDRAW help) and then easily modified for saving this sound in WAV format.
RE: Audio storage, stereo switching - mnrvovrfc - 02-18-2023
Thank you for this. Even though we now have _SNDNEW (QB64PE v3.5 required) there is still no "built-in" way to commit it to a file on disk. Your routines will be useful to me.
RE: Audio storage, stereo switching - Petr - 02-20-2023
First of all, sorry for the confusion, the above method of saving audio only works in older versions. I looked into it and here's a way to save the audio 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, of course you can save it in better quality (16 bit stereo or 32 bit stereo, SndStereoSave can handle that. The only thing I couldn't debug is the popping at the end in the saved file. I'll solving it later, but if someone beats me to it, I'll be happy
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