Posts: 246
Threads: 44
Joined: May 2022
Reputation:
28
02-19-2023, 10:50 AM
(This post was last modified: 02-20-2023, 06:54 PM by Petr.)
Note, this source code runs in QB64 2.02 and older. Phoenix version comming soon.
What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.
This program tries to simulate this at random times during playback.
Before run it, please write correct music file name in source code to line 13.
Code: (Select All) _Title "Petr's scratching"
'What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.
'This program tries to simulate this at random times during playback.
misto = 44100 * 5 '5 seconds after music start playing start effect
mistoE = misto + 88200 'effect ends 2 seconds after effect start
rychlost = 88200
Dim As _MEM L, R, L2, R2
Dim As Integer LS, RS
file$ = "al.mp3"
Print "Opening sound file "; file$
f = _SndOpen(file$)
L = _MemSound(f, 1)
R = _MemSound(f, 2)
Type SND
L As Integer
R As Integer
End Type
Dim snd(_SndRate * _SndLen(f)) As SND
Print "Creating standard array"
Do Until Done& = L.SIZE
snd(i).L = _MemGet(L, L.OFFSET + Done&, Integer)
snd(i).R = _MemGet(R, R.OFFSET + Done&, Integer)
i = i + 1
Done& = Done& + 2
Loop
i = i - 2
Dim snd2(3 * UBound(snd)) As SND 'this time i do not calculate array size - because this demo use random output lenght
zacatek = misto
konec = mistoE
psi2 = _Pi(1) / (zacatek - konec)
Dim As Long misto, mistoE
copy = 0
Print "Creating pseudo mix"
Randomize Timer
Do Until copy >= UBound(snd) - 2
If original > misto And original < mistoE Then
k2 = k2 + psi2
newi = Sin(k2) * 44100
copy = ocopy + newi
original = original + Abs(Sin(k2))
Else
ocopy = copy
copy = copy + 1
original = Int(original + 1)
End If
If original > mistoE + 44100 Then 'pause between two mix hits (44100 = 1 sec)
misto = original + 44100 * Rnd 'effect start in samples (44100 x time)
mistoE = misto + 44100 * 2 * Rnd + 500 'effect end in samples
zacatek = misto
konec = mistoE
psi2 = _Pi(1 + Rnd) / (zacatek - konec)
If psi2 = 0 Then psi2 = .01
If misto > UBound(snd2) Or misto2 > UBound(snd2) Then misto = 0: mistoE = 0
End If
If original > UBound(snd2) Then Print "Snd2 overlow": Exit Do
If copy > UBound(snd) Then Print "Snd overlow"; copy; krok: Exit Do
snd2(original).L = snd(copy).L
snd2(original).R = snd(copy).R
Loop
Print "Saving mix as scratch.wav"
'For test = 0 To original
'_SndRaw snd2(test).L / 32768, snd2(test).R / 32768
'Next
Dim SNDSAVE As _MEM
SNDSAVE = _Mem(snd2())
SAVESOUND16S SNDSAVE, "scratch.wav"
Print "Playing..."
_SndPlayFile "scratch.wav"
_Delay 1
_MemFree SNDSAVE
Kill "scratch.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)
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 Function
Posts: 246
Threads: 44
Joined: May 2022
Reputation:
28
So here is the QB64 version for Phoenix 3.5.0. I used the backward compatibility routine again but also had to use subsampling because I just didn't have enough memory (I have 3.5 GB in my laptop), QB64 2.02 use 44100 samples, Phoenix 192000.... I also made an adjustment there so that the effect runs throughout the song's entire decade, because the length and time are randomly generated, so whenever the array size runs out, another ten percent is allocated to the current size.
Code: (Select All) _Title "Petr's scratching"
'What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.
'This program tries to simulate this at random times during playback.
Dim As Long misto, mistoE, zacatek, konec
misto = 44100 * 5 '5 seconds after music start playing start effect
mistoE = misto + 44100 * 2 'effect ends 2 seconds after effect start
Dim As _MEM L, R, L2, R2, O
Dim As Integer LS, RS
file$ = "02.mp3" '<------------------ INSERT CORRECT MUSIC FILE NAME HERE!
Print "Opening sound file "; file$
f = _SndOpen(file$)
O = _MemSound(f, 0)
BackCompatible O, L, R
'L = _MemSound(f, 1)
'R = _MemSound(f, 2)
_MemFree O
Type SND
L As Integer
R As Integer
End Type
Print "Creating standard array"
Dim i As Long
ratio! = CInt(_SndRate / 44100) * 2 'downsampling to 44100 samples
Dim snd(ConvertOffset(L.SIZE) \ ratio!) As SND
Do Until Done& >= L.SIZE - ratio! * 4
snd(i).L = _MemGet(L, L.OFFSET + Done&, Integer)
snd(i).R = _MemGet(R, R.OFFSET + Done&, Integer)
i = i + 1
Done& = Done& + ratio!
Loop
'Print i, UBound(snd)
'Sleep
i = i - 2
ReDim snd2(UBound(snd) * 1.3) As SND 'this time i do not calculate array size - because this demo use random output lenght
Dim As _Float original, psi2
zacatek = misto
konec = mistoE
psi2 = _Pi(1) / (zacatek - konec)
Dim As Long copy, ocopy, newi
copy = 0
Print "Creating pseudo mix"
Randomize Timer
Do Until copy = UBound(snd)
If original > misto And original < mistoE Then
k2 = k2 + psi2
newi = 1 + (Sin(k2) * 44100) \ 3
copy = ocopy + newi
original = original + Abs(Sin(k2))
Else
ocopy = copy
copy = copy + 1
original = Int(original + 1)
End If
If original > mistoE + 44100 Then 'pause between two mix hits (44100 = 1 sec)
misto = original + 44100 * Rnd 'effect start in samples (44100 x time)
mistoE = misto + 44100 * 2 * Rnd + 500 'effect end in samples
zacatek = misto
konec = mistoE
psi2 = _Pi(1 + Rnd) / (zacatek - konec)
If psi2 = 0 Then psi2 = .01
If misto > UBound(snd2) Or misto2 > UBound(snd2) Then misto = 0: mistoE = 0
End If
If original > UBound(snd2) Then Print "Snd2 overflow - adding 10% size...": ReDim _Preserve snd2(UBound(snd2) * 1.1) As SND ' Exit Do
If copy > UBound(snd) Then Print "Snd overflow"; copy; krok: Exit Do
snd2(original).L = snd(copy).L
snd2(original).R = snd(copy).R
Loop
Print "Saving mix as scratch.wav"
Dim SNDSAVE As _MEM
SNDSAVE = _Mem(snd2())
SAVESOUND16S SNDSAVE, "scratch.wav" 'just for MEM, not use for _SNDNEW directly!
Print "Playing..."
_SndPlayFile "scratch.wav"
_Delay 1
_MemFree SNDSAVE
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) ' / 44100 / 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)
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 Function
Sub BackCompatible (Snd As _MEM, Left As _MEM, Right As _MEM)
If Snd.SIZE = 0 Then
Print "Original sample data array is empty."
Exit Sub
End If
Dim SndChannels As Long, ChannelLenght As _Offset
Select Case Snd.TYPE
Case 260 ' 32-bit floating point
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
End If
Case 132 ' 32-bit integer
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
End If
Case 130: ' 16-bit integer
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
If Snd.ELEMENTSIZE = 2 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 4 Then
SndChannels = 2
End If
Case 1153: ' 8-bit unsigned integer
ChannelLenght = Snd.SIZE 'return size in INTEGERS
If Snd.ELEMENTSIZE = 1 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 2 Then
SndChannels = 2
End If
End Select
Left = _MemNew(ChannelLenght)
Right = _MemNew(ChannelLenght)
Dim As Integer LI, RI
Dim As Long Oi
Dim i As _Offset
Do Until i = Snd.SIZE - Snd.ELEMENTSIZE 'Read Phoenix MEMSOUND and convert it as back-compatible as QB64 2.02 MEMSOUND's output.
Select Case SndChannels
Case 1
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
Case 2
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single): sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128: sampR = (_MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
End Select
If SndChannels Mod 2 = 0 Then
LI = sampL * 32767
RI = sampR * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, RI
Else
LI = sampL * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, LI
End If
i = i + Snd.ELEMENTSIZE
Oi = Oi + 2
Loop
End Sub
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
(02-21-2023, 09:27 PM)Petr Wrote: I used the backward compatibility routine again but also had to use subsampling because I just didn't have enough memory (I have 3.5 GB in my laptop), QB64 2.02 use 44100 samples, Phoenix 192000....
Do you have a desktop computer with "special" sound card? Because _SNDRATE reports 44100 for me on a budget laptop. Also you must be on 32-bit Windows while right now I'm on 64-bit Manjaro Linux...
It might have to do with this "pipewire" impressive mess which has been added to lately, at least with Arch Linux and its descendants, by the creation of this "libpipewire". I keep reading in other places that Pulse Audio is not sufficient anymore for the most demanding multimedia applications; the solution is to upgrade to "pipewire-jack" or something like that, but I don't know how to do that.
It's not going to easily resolve my situation about VST plug-ins where each instance could consume 10% to 20% of CPU power. Also a freeware music creation application is going to manage those plug-ins less efficiently than a paid alternative like Bitwig Studio. Finally there is overhead out of Wine with 32-bit apps on a 64-bit system.
That said, 64-bit OpenMPT doesn't operate very efficiently on Linux with Wine even playing back only samples. It's supposed to be better at it than the 32-bit "legacy" version, however it requires Windows10.
Posts: 246
Threads: 44
Joined: May 2022
Reputation:
28
Hi, thanks for the reply. My sound card is a normal ordinary Intel IDT HDA CODEC integrated sound card. The refresh rate of the sound can be adjusted in some types of operating systems. I'm using 32 bit old Windows. That's enough for me, I'm completely satisfied.
Posts: 246
Threads: 44
Joined: May 2022
Reputation:
28
There is a downsampling error in the previous program. This is fixed in this program. Note that in the previous case the music will play somewhat slower (provided _SNDRATE returns a number higher than 44100 and that number is not evenly divisible by 44100).
Downsampling is used to reduce the file size, it also reduces the quality, but at 48000 Hz the highest frequency recorded is 24000 Hz, but the human ear can hear somewhere around 20000 Hz, so no one can tell the difference. In this case it is simply so that the computer has less calculations and less work and you have more disk space.... And that subsampling brings me to another thing....
Code: (Select All) _Title "Petr's scratching"
'What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.
'This program tries to simulate this at random times during playback.
Dim As Long misto, mistoE, zacatek, konec
misto = 44100 * 5 '5 seconds after music start playing start effect
mistoE = misto + 44100 * 2 'effect ends 2 seconds after effect start
Dim As _MEM L, R, L2, R2, O
Dim As Integer LS, RS
file$ = "vi.mp3" '<------------------ INSERT CORRECT MUSIC FILE NAME HERE!
Print "Opening sound file "; file$
f = _SndOpen(file$)
O = _MemSound(f, 0)
BackCompatible O, L, R
'L = _MemSound(f, 1) 'old use in QB64 2.02
'R = _MemSound(f, 2)
_MemFree O
Type SND
L As Integer
R As Integer
End Type
Print "Creating standard array"
Dim i As Long, Proposal As _Unsigned Integer
'-------------------- downsampling block begin -----------------------
Proposal = 44100 'my proposal for minimal soundrate - but this is not dividible by my SndRate 192 Khz
Do Until _SndRate Mod Proposal = 0
Proposal = Proposal + 2 ' why + 2: sound output is WAV 16 bit, 16 bit = 2 bytes, INTEGER has lenght 2 bytes and INTEGER is used in WAV data block for saving sound information (just in 16 bit WAV)
Loop
Ratio = _SndRate \ Proposal 'downsampling to 48000 Hz, my sndrate 192000 is dividible by 48000, not by 44100 (SaveSound16S is also upgraded, but it is still for saving without _SndNew)
Print Ratio
Dim snd(ConvertOffset(L.SIZE) \ Ratio * 2) As SND
Done& = 0
Do Until Done& >= L.SIZE - Ratio * 4
snd(i).L = _MemGet(L, L.OFFSET + Done&, Integer)
snd(i).R = _MemGet(R, R.OFFSET + Done&, Integer)
i = i + 1
Done& = Done& + Ratio * 2
Loop
'-------------------- downsampling block end -----------------------
i = i - 2
ReDim snd2(UBound(snd) * 1.3) As SND 'this time i do not calculate array size - because this demo use random output lenght
Dim As _Float original, psi2
zacatek = misto
konec = mistoE
psi2 = _Pi(1) / (zacatek - konec)
Dim As Long copy, ocopy, newi
copy = 0
Print "Creating pseudo mix"
Randomize Timer
Do Until copy = UBound(snd) 'in this loop all 44100 numbers are replace with variable Proposal
If original > misto And original < mistoE Then
k2 = k2 + psi2
newi = 1 + (Sin(k2) * Proposal) \ 3
copy = ocopy + newi
original = original + Abs(Sin(k2))
Else
ocopy = copy
copy = copy + 1
original = Int(original + 1)
End If
If original > mistoE + 2 * Proposal Then 'pause between two mix hits (44100 = 1 sec)
misto = original + Proposal * Rnd 'effect start in samples (44100 x time)
mistoE = misto + Proposal * Rnd + 500 'effect end in samples
zacatek = misto
konec = mistoE
psi2 = _Pi(1 + Rnd) / (zacatek - konec)
If psi2 = 0 Then psi2 = .01
If misto > UBound(snd2) Or misto2 > UBound(snd2) Then misto = 0: mistoE = 0
End If
If original > UBound(snd2) Then Print "Snd2 overflow - adding 10% size...": ReDim _Preserve snd2(UBound(snd2) * 1.1) As SND ' Exit Do
If copy > UBound(snd) Then Print "Snd overflow"; copy: Exit Do
snd2(original).L = snd(copy).L
snd2(original).R = snd(copy).R
Loop
Print "Saving mix as scratch.wav"
Dim SNDSAVE As _MEM
SNDSAVE = _Mem(snd2())
SAVESOUND16S SNDSAVE, Proposal, "scratch.wav" 'just for MEM, not use for _SNDNEW directly!
Print "Playing..."
_SndPlayFile "scratch.wav"
_Delay 1
_MemFree SNDSAVE
End
Sub SAVESOUND16S (arr As _MEM, SoundRate As _Unsigned Integer, 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) ' / 44100 / 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 = SoundRate
H16.ByteRate = SoundRate * 2 * 16 / 8
H16.Block = 4
H16.Bits = 16
H16.subchunk2 = "data"
H16.lenght = ConvertOffset&&(arr.SIZE)
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 Function
Sub BackCompatible (Snd As _MEM, Left As _MEM, Right As _MEM)
If Snd.SIZE = 0 Then
Print "Original sample data array is empty."
Exit Sub
End If
Dim SndChannels As Long, ChannelLenght As _Offset
Select Case Snd.TYPE
Case 260 ' 32-bit floating point
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
End If
Case 132 ' 32-bit integer
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
End If
Case 130: ' 16-bit integer
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
If Snd.ELEMENTSIZE = 2 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 4 Then
SndChannels = 2
End If
Case 1153: ' 8-bit unsigned integer
ChannelLenght = Snd.SIZE 'return size in INTEGERS
If Snd.ELEMENTSIZE = 1 Then
SndChannels = 1
ElseIf Snd.ELEMENTSIZE = 2 Then
SndChannels = 2
End If
End Select
Left = _MemNew(ChannelLenght)
Right = _MemNew(ChannelLenght)
Dim As Integer LI, RI
Dim As Long Oi
Dim i As _Offset
Do Until i = Snd.SIZE - Snd.ELEMENTSIZE 'Read Phoenix MEMSOUND and convert it as back-compatible as QB64 2.02 MEMSOUND's output.
Select Case SndChannels
Case 1
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
Case 2
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single): sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128: sampR = (_MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
End Select
If SndChannels Mod 2 = 0 Then
LI = sampL * 32767
RI = sampR * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, RI
Else
LI = sampL * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, LI
End If
i = i + Snd.ELEMENTSIZE
Oi = Oi + 2
Loop
End Sub
|
