04-24-2023, 06:25 PM
Released new upgraded version SoundSave for QB64 Phoenix!
Options:
- the possibility of saving with an optional sampling frequency
- save as mono / stereo / pseudo stereo / sound on left / sound on right
- supported output WAV file formats: 8bit, 16bit, 24bit, 32bit
- possibility to insert echo
Program is wroted for _SndNew or _SndOpen handles, so is possible saving own sounds created in QB64 or music loaded with SndOpen save as WAV file.
Since there is a new option to choose the sampling frequency, just remind you that too low a sampling frequency has a significant effect on the sound quality. The default was 44100, of course, if your sound card supports it, you can save the sound at a higher sample rate. You get the maximum if you put _SndRate in the SoundRate parameter of the SoundSave function.
- the possibility of saving with an optional sampling frequency
- save as mono / stereo / pseudo stereo / sound on left / sound on right
- supported output WAV file formats: 8bit, 16bit, 24bit, 32bit
- possibility to insert echo
Program is wroted for _SndNew or _SndOpen handles, so is possible saving own sounds created in QB64 or music loaded with SndOpen save as WAV file.
Since there is a new option to choose the sampling frequency, just remind you that too low a sampling frequency has a significant effect on the sound quality. The default was 44100, of course, if your sound card supports it, you can save the sound at a higher sample rate. You get the maximum if you put _SndRate in the SoundRate parameter of the SoundSave function.
Code: (Select All)
'SaveSound for QB64PE version 3.0
'wroted Petr Preclik
' - support all possible soundrate in output wav file (maximum is your soundcard _SndRate),
' - support 8 bites, 16 bites, 24 bites and 32 bites Wav files as output format,
' - contains build - in soundrate automaticaly correction,
' - support for Mono / Stereo / PseudoStereo / Left mono and Right silent, Right mono and left silent
' - can add echo to record
'usage: SaveSound (snd handle&, output file name$, options for saving (on next row), record sound rate - higher = better quality, higher size, output Wav file Biterate (8, 16, 24 or 32))
'options for saving:
'
' Stereo - save sound in stereo format.
' BothMono - output wav file contains one channel, players play it then in both speakers as mono music
' MonoLeft - output wav file contains two channels, right is silent, left contains music data, output format is stereo
' MonoRight - output wav file contains two channels, right contains music data, left is silent, output format is stereo
' PseudoStereo - on input can be used stereo or mono sound file, this option copy left channel and shift it in time to right channel - create small echo delay
' Stereo Or Echo - save sound as stereo format and create small echo
' BothMono Or Echo - save sound to one channel and create echo
' MonoLeft Or Echo - save sound to left channel and create echo, right channel is silent
' MonoRight Or Echo - save sound to right channel and create echo, left channel is silent
' PseudoStereo Or Echo - copy shifted left channel as right channel and create longer echo delay
'------------ SndSave.bi ---------------
' DO NOT CHANGE CONST!
Const MonoLeft = 1
Const MonoRight = 2
Const Stereo = 4
Const BothMono = 8
Const PseudoStereo = 16
Const Echo = 32
Const Enabled = 1
Const Disabled = 0
'---------------------------------------
'Warning. This program can create 24bit WAVE files. QB64 can it open and play, BUT _MEMSOUND work not with this type (expected returned values 3 and 6 are not writed in help about _MEMSOUND)
'Mono record element size is 3 byte, stereo record element size lenght is 6 bytes.
'https://stackoverflow.com/questions/24151973/reading-24-bit-samples-from-a-wav-file
Dim snd As Long
snd = _SndOpen("w.mod")
'or, for your own music handle please use QB64PE function _SndNew
Print "Music file opened", snd
Status = SaveSound(snd, "w-mod.wav", Stereo Or Echo, 44100, 24)
SSSH Status
hnd = _SndOpen("w-mod.wav")
Print hnd
_SndPlay hnd
' ----------------------------- SndSave.bm -------------------------------
Sub SSSH (Status)
Select Case Status
Case 1: Print "All ok, operation complete"
Case -100: Print "Sound card sound rate is lower than sound rate used for SaveSound!"
Case -101: Print "This biterate format is not supported."
Case -102: Print "m.SIZE is ZERO. Warning, 24bit Wave are not compatible with MEMSOUND, but are compatible with _SndOpen!, or is used invalid handle."
End Select
End Sub
Function SaveSound (Handle As Long, SaveAS$, Parameter, SoundRate, BiteRate) 'for SNDNEW or SNDOPEN handles
ParameterD = Parameter
AddEcho = Disabled
Select Case Parameter
Case 33, 34, 36, 40, 48
AddEcho = Enabled
ParameterD = Parameter Xor Echo
End Select
If ParameterD = 8 Then OutChannels = 1 Else OutChannels = 2
If SoundRate > _SndRate Then SaveSound = -100: Exit Function 'upsampling is not supported
Select Case BiteRate
Case 8, 16, 24, 32
Case Else
SaveSound = -101: Exit Function 'supported output WAVE format is 8bit or 16bit or 32bit
End Select
BR3 = BiteRate
'---------------------------
SoundR = SoundRate
Do Until _SndRate Mod SoundR = 0
SoundR = SoundR + 1
Loop
Ratio = _SndRate / SoundR 'step for downsampling from original
' Print "Real usable (and used) samplerate is: "; Ratio; _SndRate / Ratio
'----------------------------------
'ziskat informace o zdrojovem zvuku
Dim m As _MEM
m = _MemSound(Handle, 0)
If m.SIZE = 0 Then SaveSound = -102: Exit Function 'music handle is not valid
'get info about channels number
Select Case m.TYPE
Case 260 ' 32-bit floating point
If m.ELEMENTSIZE = 4 Then
Channels = 1
ElseIf m.ELEMENTSIZE = 8 Then
Channels = 2
End If
Case 132 ' 32-bit integer
If m.ELEMENTSIZE = 4 Then
Channels = 1
ElseIf m.ELEMENTSIZE = 8 Then
Channels = 2
End If
Case 130: ' 16-bit integer
If m.ELEMENTSIZE = 2 Then
Channels = 1
ElseIf m.ELEMENTSIZE = 4 Then
Channels = 2
End If
Case 1153: ' 8-bit unsigned integer
If m.ELEMENTSIZE = 1 Then
Channels = 1
ElseIf m.ELEMENTSIZE = 2 Then
Channels = 2
End If
Case Else
Print "Sorry, unknown m.TYPE for sound file on input: "; m.TYPE
End Select
'get biterate source signal (8 bit, 16 bit or 32 bit)
Type Snd32
Left As Single
Right As Single
End Type
Select Case SNDGetBites(m)
Case 1, 2
Bites = 32
Size& = ConvertOffset(m.SIZE) \ 4 \ Channels
Dim SndIn(Size&) As Snd32
Case 3
Bites = 16
Size& = ConvertOffset(m.SIZE) \ 2 \ Channels
Dim SndIn(Size&) As Snd32 'all input sound data are calculated to SINGLE array, so later this can be compiled to all other sound type
Case 4
Bites = 8
Size& = ConvertOffset(m.SIZE) \ Channels
Dim SndIn(Size&) As Snd32
End Select
Dim i As Long
Do Until done& = m.SIZE
Select Case Bites
Case 32
SndIn(i).Left = _MemGet(m, m.OFFSET + Step32&, Single)
If Channels = 2 Then
Step32& = Step32& + 4
SndIn(i).Right = _MemGet(m, m.OFFSET + Step32&, Single)
Else
SndIn(i).Right = SndIn(i).Left
End If
Step32& = Step32& + 4
done& = Step32&
Case 16
SndIn(i).Left = (_MemGet(m, m.OFFSET + Step16&, Integer) / 32768) 'netestovany VSTUP
If Channels = 2 Then
Step16& = Step16& + 2
SndIn(i).Right = (_MemGet(m, m.OFFSET + Step16&, Integer) / 32768) 'netestovany VSTUP
Else
SndIn(i).Right = SndIn(i).Left
End If
Step16& = Step16& + 2
done& = Step16&
Case 8
SndIn(i).Left = (-128 + _MemGet(m, m.OFFSET + Step8&, _Unsigned _Byte)) / 255 'netestovany VSTUP
If Channels = 2 Then
Step8& = Step8& + 1
SndIn(i).Right = (-128 + _MemGet(m, m.OFFSET + Step8&, _Unsigned _Byte)) / 255 'netestovany VSTUP
Else
SndIn(i).Right = SndIn(i).Left
End If
Step8& = Step8& + 1
done& = Step8&
End Select
i = i + 1
Loop
'sound is now saved in SINGLE SndIn array, mem handle m can be deleted...
SizeNew& = Size& * (BiteRate / 8) / Ratio 'if downsamplingm then new memory block size is smaller than original
If AddEcho Then SizeNew& = SizeNew& + (_SndRate / Ratio) * Channels
_MemFree m
Delay = .35 * (_SndRate / Ratio) 'delay for echo effect
Dim em As Long
If AddEcho = Enabled Then
For em = Delay To UBound(SndIn)
SndIn(em).Left = SndIn(em).Left * .5 + LeftBack * .5
SndIn(em).Right = SndIn(em).Right * .5 + RightBack * .5
Next
End If
Dim SndOut As _MEM
SndOut = _MemNew(SizeNew& * OutChannels)
RecLen = BiteRate / 8
BR = BiteRate
i& = 0
'resolution if output is 8bit/16bit/24bit/32bit
Dim ReadIt As Long
AudioCH = 2
For ReadIt = 0 To UBound(SndIn) - (_SndRate / Ratio) Step Ratio
Select Case BR
Case 8
left = -128 - SndIn(ReadIt).Left * 127
right = -128 - SndIn(ReadIt).Right * 127
If ReadIt > Delay Then PseudoRight = -128 - SndIn(ReadIt - Delay).Left * 127
Case 16
left = SndIn(ReadIt).Left * 32768
right = SndIn(ReadIt).Right * 32768
If ReadIt > Delay Then PseudoRight = SndIn(ReadIt - Delay).Left * 32768
Case 24
Left& = SndIn(ReadIt).Left * 8388607
Right& = SndIn(ReadIt).Right * 8388607
If ReadIt& > Delay Then PseudoRight& = SndIn(ReadIt& - Delay).Left * 8388607
Case 32
Left& = SndIn(ReadIt).Left * 2147483648
Right& = SndIn(ReadIt).Right * 2147483648
If ReadIt& > Delay Then PseudoRight& = SndIn(ReadIt& - Delay).Left * 2147483648
End Select
Select Case ParameterD
Case 1 '
' Monoleft - left channel contains data, right nothing
Select Case RecLen
Case 1 '8 bit
Dim LeftUB As _Unsigned _Byte
LeftUB = left
_MemPut SndOut, SndOut.OFFSET + i&, LeftUB ' left channel contains sound data 8bit
_MemPut SndOut, SndOut.OFFSET + i& + 1, 0 As _UNSIGNED _BYTE ' right channel is silent
i& = i& + 2
Case 2 '16 bit
Dim LeftIB As Integer
LeftIB = left
_MemPut SndOut, SndOut.OFFSET + i&, LeftIB ' left channel contains sound data 16bit
_MemPut SndOut, SndOut.OFFSET + i& + 2, 0 As INTEGER ' right channel is silent
i& = i& + 4
Case 3 '24 bit
_MemPut SndOut, SndOut.OFFSET + i&, Left& 'SB ' left channel contains sound data 32bit
_MemPut SndOut, SndOut.OFFSET + i& + 3, 0 As LONG ' right channel is silent
i& = i& + 6
Case 4 '32 bit
_MemPut SndOut, SndOut.OFFSET + i&, Left& 'SB ' left channel contains sound data 32bit
_MemPut SndOut, SndOut.OFFSET + i& + 4, 0 As LONG ' right channel is silent
i& = i& + 8
End Select
Case 2
' MonoRight - right channel contains audiodata, left nothing
Select Case RecLen
Case 1 'tvori se 8 bitovy WAV
Dim RightUB As _Unsigned _Byte
RightUB = right
_MemPut SndOut, SndOut.OFFSET + i&, 0 As _UNSIGNED _BYTE ' left channel is silent
_MemPut SndOut, SndOut.OFFSET + i& + 1, RightUB ' right channel contains sound data 8bit
i& = i& + 2
Case 2
Dim RightIB As Integer
RightIB = right
_MemPut SndOut, SndOut.OFFSET + i&, 0 As INTEGER ' left channel is silent
_MemPut SndOut, SndOut.OFFSET + i& + 2, RightIB ' right channel contains sound data 16bit
i& = i& + 4
Case 3
_MemPut SndOut, SndOut.OFFSET + i&, 0 As LONG ' left channel is silent
_MemPut SndOut, SndOut.OFFSET + i& + 3, Right& ' right channel contains sound data 32 bit
i& = i& + 6
Case 4
_MemPut SndOut, SndOut.OFFSET + i&, 0 As LONG ' left channel is silent
_MemPut SndOut, SndOut.OFFSET + i& + 4, Right& 'SB ' right channel contains sound data 32 bit
i& = i& + 8
End Select
Case 4
'Stereo
Select Case RecLen
Case 1 '8 bite WAV
Dim As _Unsigned _Byte Rub, Lub
Rub = right
Lub = left
_MemPut SndOut, SndOut.OFFSET + i&, Lub ' left channel contains left audio data
_MemPut SndOut, SndOut.OFFSET + i& + 1, Rub ' right channel contains right audio data 8bit
i& = i& + 2
Case 2
Dim As Integer RIB, LIB
RIB = right
LIB = left
_MemPut SndOut, SndOut.OFFSET + i&, LIB ' left channel contains sound data 16 bit left
_MemPut SndOut, SndOut.OFFSET + i& + 2, RIB ' right channel contains sound data 16bit right
i& = i& + 4
Case 3
_MemPut SndOut, SndOut.OFFSET + i&, Left& ' left channel contains sound data 32 bit
_MemPut SndOut, SndOut.OFFSET + i& + 3, Right& ' right channel contains sound data 32 bit
i& = i& + 6
Case 4
_MemPut SndOut, SndOut.OFFSET + i&, Left& ' left channel contains sound data 32 bit
_MemPut SndOut, SndOut.OFFSET + i& + 4, Right& ' right channel contains sound data 32 bit
i& = i& + 8
End Select
Case 8
'BothMono (1 channel)
Select Case RecLen
Case 1 '8 bite WAV
Dim As _Unsigned _Byte UBmono
UBmono = (right + left) / 2
_MemPut SndOut, SndOut.OFFSET + i&, UBmono ' left channel contains left audio data, track contains just one channel (is real MONO)
i& = i& + 1
Case 2 '16 bite WAV
Dim As Integer Imono
Imono = (right + left) / 2
_MemPut SndOut, SndOut.OFFSET + i&, Imono ' left channel contains sound data 16 bit, track contains just one channel (MONO)
i& = i& + 2
Case 3 '24 bite WAV
'
Smono& = (Right& + Left&) / 2
_MemPut SndOut, SndOut.OFFSET + i&, Smono& ' left channel contains sound data 32 bit, track contains just one channel
i& = i& + 3
Case 4 '32 bite WAV
Smono& = (Right& + Left&) / 2
_MemPut SndOut, SndOut.OFFSET + i&, Smono& ' left channel contains sound data 32 bit, track contains just one channel
i& = i& + 4
End Select
Case 16
'PseudoStereo - PseudoRight defined upper
Select Case RecLen
Case 1 '
Dim As _Unsigned _Byte pRub, pLub
pRub = PseudoRight
pLub = left
_MemPut SndOut, SndOut.OFFSET + i&, pLub ' left channel contains left audio data
_MemPut SndOut, SndOut.OFFSET + i& + 1, pRub ' right channel contains right audio data - shifted by DELAY 8bit
i& = i& + 2
Case 2
Dim As Integer pRIB, pLIB
pRIB = PseudoRight
pLIB = left
_MemPut SndOut, SndOut.OFFSET + i&, pLIB ' left channel contains sound data 16 bit left
_MemPut SndOut, SndOut.OFFSET + i& + 2, pRIB ' right channel contains sound data 16bit right
i& = i& + 4
Case 3
_MemPut SndOut, SndOut.OFFSET + i&, Left& ' left channel contains sound data 32 bit
_MemPut SndOut, SndOut.OFFSET + i& + 3, PseudoRight& ' right channel contains sound data 32 bit
i& = i& + 6
Case 4
_MemPut SndOut, SndOut.OFFSET + i&, Left& ' left channel contains sound data 32 bit
_MemPut SndOut, SndOut.OFFSET + i& + 4, PseudoRight& ' right channel contains sound data 32 bit
i& = i& + 8
End Select
End Select
Next ReadIt
'own save
Type WAVhead
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 WH As WAVhead
WH.chunk = "RIFF"
WH.size = 44 + ConvertOffset(SndOut.SIZE) - 8
WH.fomat = "WAVE"
WH.sub1 = "fmt "
WH.subchunksize = 16
WH.format = 1
WH.channels = OutChannels
WH.rate = SoundR
WH.ByteRate = SoundR * OutChannels * (BR \ 8)
WH.Block = OutChannels * (BR \ 8)
WH.Bits = BR
WH.subchunk2 = "data"
WH.lenght = ConvertOffset(SndOut.SIZE)
ff = FreeFile
Open SaveAS$ For Binary As #ff
tracklen$ = Space$(ConvertOffset(SndOut.SIZE))
_MemGet SndOut, SndOut.OFFSET, tracklen$
Put ff, , WH
Put ff, , tracklen$
tracklen$ = ""
_MemFree SndOut
Close ff
SaveSound = 1
End Function
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 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, Temp&& 'Get the contents of the memblock and put the values into Integer64 variable first
ConvertOffset&& = temp&&
$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
'---------------------------------------------------------------------