+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: Petr (https://staging.qb64phoenix.com/forumdisplay.php?fid=52)
+---- Thread: SndStereoSave for PHOENIX (/showthread.php?tid=1491)
SndStereoSave for PHOENIX - Petr - 02-20-2023
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 FunctionIt is good! I was so focused on functionality that I forgot to add labels to the program
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.
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.
RE: SndStereoSave for PHOENIX - a740g - 02-20-2023
Quote: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?
It does support 32-bit floating-point WAV files. I think I know what is happening here. For floating point samples each sample has to be between -1 .. 1 (0 being the mid-point). I think during the conversion from MP3 > PCM some of these samples go way above or below that range. miniaudio deals with this by clipping the samples during playback / mixing.
Since you are writing out this unclipped data to the file, you'll have to do the clipping yourself.
Again, I may be completely wrong because I have not studied other parts of your code.
I will play with this as soon as I get some time.
RE: SndStereoSave for PHOENIX - Petr - 02-21-2023
SndStereoSave has been slightly improved and renamed to SndSave. I put the program in a .bm file so that I could just simply include it at the end of the program with the $Include statement.
The program now saves mono and stereo WAV format, 8, 16, 32 bits. Want to test it when you generate your own sounds if that click at the end of the eight bit sound will also occur or not. For now, I've solved it by truncating the WAV file by 22050 samples when saved in 8-bit, removing the click at the end. I have yet to find the reason why this happens, while saving in 16-bit or 32-bit remains fine. It almost seems like the 8 bit audio is slightly longer than it should be.
Test program:
Code: (Select All)
'SndSave by Petr for PHOENIX 3.5.0
'example how convert XM file to WAV file
' Dim Song As Long
' Song = _SndOpen("a.xm")
' Dim As _MEM N
' N = _MemSound(Song, 0)
' SndSave N, "Test.wav" 'tested on WAV 16bit stereo, XM file (stereo), MP3 (stereo), all pass
'example how to create empty streams for 8bit, 16bit and 32 bit sound records and how save it
'generate sound
t = 0
tmp$ = "Sample = ##.##### Time = ##.#####"
Locate 1, 60: Print "Rate:"; _SndRate
'declare standard arrays for saving values generated using SIN, COS...
Dim SNDREC8(_SndRate * 3.00239 * 1) As _Unsigned _Byte 'sound duration is 3.00239 seconds, use _UNSIGNED _BYTE for 8 bit record, 1 = this sound contains 1 audio channel (mono)
Dim SNDREC16(_SndRate * 3.00239 * 1) As Integer ' sound duration is 3.00239 seconds, use INTEGER for 16 bit record (the same as in old QB64), 1 = this sound contains 1 audio channel (mono)
Dim SNDREC32(_SndRate * 3.00239 * 1) As Single ' sound duration is 3.00239 seconds, use SINGLE for 32 bit record, 1 = this sound contains 1 audio channel (mono)
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
'------ ---------- -------
SNDREC8(rec) = 127 * sample + 128 ' recalculate samples for 8 bit record
SNDREC16(rec) = 32768 * sample ' recalculate samples for 16 bit record
SNDREC32(rec) = sample ' recalculate sampples for 32 bit record
rec = rec + 1
'------ ---------- -------
_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
' generated sound is done in memory, in array
' create empty streams and save data to this streams
Dim As _MEM REC8, REC16, REC32
NewSound8 = _SndNew(_SndRate * 3.00239, 1, 8) 'create stereo 8 bit snd record (sound duration, 1 channel, 8 bites)
NewSound16 = _SndNew(_SndRate * 3.00239, 1, 16)
NewSound32 = _SndNew(_SndRate * 3.00239, 1, 32)
'open created streams for access
REC8 = _MemSound(NewSound8, 0)
REC16 = _MemSound(NewSound16, 0)
REC32 = _MemSound(NewSound32, 0)
Dim WAV8 As _Unsigned _Byte, WAV16 As Integer, WAV32 As Single
'save audiodata to streams
done = 0
Do Until done = UBound(SNDREC8) 'all arrays have the same size
WAV8 = SNDREC8(done) ' load 8bit sample
WAV16 = SNDREC16(done) 'load 16bit sample
WAV32 = SNDREC32(done) 'load 32bit sample
_MemPut REC8, REC8.OFFSET + done, WAV8 'insert 8bit audio data to 8bit stream, one sample in 8 bit mono is long 1 byte, so step is 1 (+done)
_MemPut REC16, REC16.OFFSET + done * 2, WAV16 'insert 16bit audio data to 16bit stream , one sample in 16 bit mono is long 2 bytes, step is 2 (done * 2)
_MemPut REC32, REC32.OFFSET + done * 4, WAV32 'insert 32 bit audio data to 32bit stream, one sample in 32 bit mono is long 4 bytes, step is 4 (done * 4)
done = done + 1 '
Loop
Print
Print "Lenghts:"
Print REC8.SIZE
Sleep 3
'now, you can listening done outputs:
Print "Playing this sound in 8 bit... "
_SndPlay NewSound8
Do Until _SndPlaying(NewSound8) = 0: Loop
Print
Print "Playing this sound in 16 bit..."
_SndPlay NewSound16
Do Until _SndPlaying(NewSound16) = 0: Loop
Print
Print "Playing this sound in 32 bit..."
_SndPlay NewSound32
Do Until _SndPlaying(NewSound32) = 0: Loop
Print
Print "Saving sound as Test8.WAV in 8 bit quality..."
SndSave REC8, "test8.wav"
Print "Saving sound as Test16.WAV in 16 bit quality..."
SndSave REC16, "test16.wav"
Print "Saving sound as Test32.WAV in 32 bit quality..."
SndSave REC32, "test32.wav"
Sleep 3
Print
Print "SndSave modified the audio in 8-bit form to remove the clicking at the end by truncating the audio by 22050 samples. Hear the difference:"
Print "Original, in memory..."
Sleep 3
_SndPlay NewSound8
Do Until _SndPlaying(NewSound8) = 0: Loop
Sleep 4
Print "Saved on harddrive"
_SndPlayFile "test8.wav"
Do Until _SndPlaying(NewSound8) = 0: Loop
Sleep 3
Print "That`s all"
_SndClose NewSound8
_SndClose NewSound16
_SndClose NewSound32
_MemFree REC8
_MemFree REC16
_MemFree REC32
End
'$include:'SndSave.bm'File SndSave.bm:
Code: (Select All)
Sub SndSave (arr As _MEM, file As String)
'this is upgraded SndStereoSave:
' SUB renamed as SndSave
' Autodetect if input stream is mono or stereo (based on SndChannels function)
'from SndChannels function:
If arr.SIZE = 0 Then
Print "SndSave: MemSound return ZERO for audio data size!"
Exit Sub
End If
' Check the data type and then decide if the sound is stereo or mono
Dim Channels As Integer, Reduce As Integer
Select Case arr.TYPE
Case 260 ' 32-bit floating point
If arr.ELEMENTSIZE = 4 Then
Channels = 1
ElseIf arr.ELEMENTSIZE = 8 Then
Channels = 2
End If
Case 132 ' 32-bit integer
If arr.ELEMENTSIZE = 4 Then
Channels = 1
ElseIf arr.ELEMENTSIZE = 8 Then
Channels = 2
End If
Case 130: ' 16-bit integer
If arr.ELEMENTSIZE = 2 Then
Channels = 1
ElseIf arr.ELEMENTSIZE = 4 Then
Channels = 2
End If
Case 1153: ' 8-bit unsigned integer
If arr.ELEMENTSIZE = 1 Then
Channels = 1
ElseIf arr.ELEMENTSIZE = 2 Then
Channels = 2
End If
End Select
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 = Channels
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 * Channels * H16.Bits) / 8
H16.Block = (Channels * H16.Bits) / 8
H16.subchunk2 = "data"
H16.lenght = ConvertOffset(arr.SIZE)
If _FileExists(file$) Then Kill file$
If H16.Bits = 8 Then Reduce = 22050 Else Reduce = 0
Audio$ = Space$(ConvertOffset(arr.SIZE) - Reduce)
If SNDGetBites(arr) = 1 Then 'convert values from SINGLE to LONG values, because there was problem whe trying playing SINGLE values
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
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 FunctionRE: SndStereoSave for PHOENIX - Petr - 04-24-2023
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
'---------------------------------------------------------------------RE: SndStereoSave for PHOENIX - mnrvovrfc - 04-25-2023
When working with 8-bit raw, 128 is the zero-crossing not zero. Zero is the "bottom" of the waveform and 255 is the "top" when seen from Audacity or different audio editor. It's tricky after enough programming for 16-bit signed WAV. 22050 samples is a lot to fade out if using a sampling rate below 44100Hz which means a lot of "chipheads" still using ancient tracker music-creation software and players that support those formats won't use your function to create a WAV file. LOL.
Keep up the good work. I've always wanted to program stuff like this.