02-22-2023, 05:48 PM
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....
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