02-20-2023, 08:26 PM
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