02-21-2023, 05:28 PM
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:
File SndSave.bm:
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 Function