03-03-2023, 11:53 PM
Small upgrade
Thanks to @DSMan195276 opening my eyes, I've used SndOpenRaw mixing (makes it a lot easier) and added the option I've already posted here separately, so now you can control the treble with N and M + the same as in previous). I'm assuming it's 22KHz because it's made up of two adjacent samples at a refresh rate of 44100Hz (here this program downsamples it to 44100 if the real _SndRate is higher). The middle frequencies will still be a challenge, I will also play with the bass curve, because there is no need to strictly calculate the entire course if the direction of the oscillation does not change during the period (that is, if we take, for example, 400 samples and the whole time they have falling or rising trend, just copy them, but if not, i think its best try deforming the wave just minimal to next period)
Thanks to @DSMan195276 opening my eyes, I've used SndOpenRaw mixing (makes it a lot easier) and added the option I've already posted here separately, so now you can control the treble with N and M + the same as in previous). I'm assuming it's 22KHz because it's made up of two adjacent samples at a refresh rate of 44100Hz (here this program downsamples it to 44100 if the real _SndRate is higher). The middle frequencies will still be a challenge, I will also play with the bass curve, because there is no need to strictly calculate the entire course if the direction of the oscillation does not change during the period (that is, if we take, for example, 400 samples and the whole time they have falling or rising trend, just copy them, but if not, i think its best try deforming the wave just minimal to next period)
Code: (Select All)
$NoPrefix
_Title "Give me more BASS!"
s$ = "Alkehol - dejvice.mp3" 'PLECE HERE CORRECT MUSIC FILE NAME!
s = SndOpen(s$)
Dim As MEM LS, RS, L, R, O 'arrays with default original MP3 values
Dim As Integer L1, R1, L2, R2, L3, R3, L4, R4, NL, NR 'L1, R1 - integers contains original signal values from MEMSOUND arrays, L2, R2 - the same as L1 and R1 but shifted right by KROK value, so if is created 100 Hz signal,
' so L2 and R2 are shifted by 441 records in MEMSOUND array to right, NL, NR - for mixing both - new and original signal to new signal
'LS = MemSound(s, 1)
'RS = MemSound(s, 2)
O = _MemSound(s, 0)
BackCompatible O, L, R
_MemFree O
SOR1 = _SndOpenRaw
SOR2 = _SndOpenRaw
SOR3 = _SndOpenRaw
'-------------------- 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)
LS = _MemNew(L.SIZE \ Ratio)
RS = _MemNew(R.SIZE \ Ratio)
Done& = 0
Do Until Done& >= L.SIZE - Ratio * 4
L1 = _MemGet(L, L.OFFSET + Done&, Integer)
_MemPut LS, LS.OFFSET + i&, L1
R1 = _MemGet(R, R.OFFSET + Done&, Integer)
_MemPut RS, RS.OFFSET + i&, R1
i& = i& + 2
Done& = Done& + Ratio * 2
Loop
'-------------------- downsampling block end -----------------------
_MemFree L
_MemFree R
L1 = 0: R1 = 0
'ensure that the LS and RS fields are divisible by the KROK value
Dim As Offset MaxKrok, stp, krok 'varibles for reading MEMSOUND array
Dim As _Float PropocetL, PropocetR ' variables for calculating TRIANGLE signal
krok = 220 'Default is program set to creating 100 Hz (Bass) signal
MaxKrok = LS.SIZE 'maximal steps value for MEM functions
Screen NewImage(1200, 768, 256) 'graphis screen for visualising output signal
Do Until MaxKrok Mod krok * 2 = 0 'this loop ensures that when reading the field MEMSOUND to create a new signal, the field will not overflow and Memory out of range not occur.
MaxKrok = MaxKrok - 1
Loop
'Default settings
mix = .25 'Original signal MIX level to output signal (is not volume level)
Volume = 1 'Created Signal (Created Signal) volume level
Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int((1 - mix) * 100); "%"; " "
Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); " "
Locate 2, 1: Print "Use the < and > keys to set the ratio between the original and generated signal, Q and W for freq. change, + and - for generated signal volume level. New: Use N,n and M,m for high freq."
Do Until stp >= MaxKrok - krok * 4 'read MEMSOUND array in full range
MemGet LS, LS.OFFSET + stp, L1 'read left original signal
MemGet RS, RS.OFFSET + stp, R1 'read right original signal
MemGet LS, LS.OFFSET + stp + krok * 2, L2 'read left original signal shifted to right by krok's value
MemGet RS, RS.OFFSET + stp + krok * 2, R2 'read right original signal shifted to right by krok's value
stp = stp + krok * 2 '* 2 - values in MEMSOUND array are INTEGERS, 2 Bytes long
PropocetL = (L2 - L1) / ConvertOffset(krok) 'calculation of the size of the increase or decrease of the signal to create a triangular signal [LEFT]
PropocetR = (R2 - R1) / ConvertOffset(krok) 'calculation of the size of the increase or decrease of the signal to create a triangular signal [RIGHT]
PrL = PropocetL
PrR = PropocetR
NL = L1 'reset this value (NL) to start value before create new triangle signal for left channel
NR = R1 'reset this value (NR) to start value before create new triangle signal for right channel
es = 0
If _SndRate < 48000 Then snr = 44100 Else snr = 48000
Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok
Locked = 0 'for the possibility of changing the frequency during playback
Do Until es = krok 'it only reads the slice of the memsound field in which the new signal is formed
'keyborad program setup
k$ = InKey$
Select Case k$
Case ",", "<": mix = mix + .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int(bmix * 100); "%"; " "
Case ".", ">": mix = mix - .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int(bmix * 100); "%"; " "
Case "+": Volume = Volume + .1
If Volume > 2 Then Volume = 2
Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); " " ' Volume - is created signal volume level
Case "-": Volume = Volume - .1
If Volume < 0 Then Volume = 0
Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); " "
Case "Q", "q"
If Locked = 0 Then
Locked = 1
krok = krok + 10
If krok > 550 Then krok = 550
MaxKrok = LS.SIZE
Do Until MaxKrok Mod krok * 2 = 0
MaxKrok = MaxKrok - 1
Loop
If _SndRate < 48000 Then snr = 44100 Else snr = 48000
Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok / 2 'we working with downsamples source
Exit Do
End If
Case "W", "w"
If Locked = 0 Then
Locked = 1
krok = krok - 10
If krok < 1 Then krok = 1
MaxKrok = LS.SIZE
Do Until MaxKrok Mod krok * 2 = 0
MaxKrok = MaxKrok - 1
Loop
If _SndRate < 48000 Then snr = 44100 Else snr = 48000
Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok / 2
Exit Do
End If
Case "N", "n": HighVol = HighVol + .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol > 5 Then HighVol = 5
Case "M", "m": HighVol = HighVol - .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol < 0 Then HighVol = 0
End Select
If mix < 0 Then mix = 0
If mix > 1 Then mix = 1
bmix = 1 - mix
posuvX = posuvX + 1 'variable for shift curve on the screen, just for graphic, not for own sound function
If posuvX = Width Then posuvX = 1
Line (posuvX, 70)-(posuvX, Height), 0, BF
MemGet LS, LS.OFFSET + (stp - krok * 2) + es * 2, L1 'krok and es varibles must be multiplied by two, because MEMGET reads INTEGER values.
MemGet RS, RS.OFFSET + (stp - krok * 2) + es * 2, R1
'get 22 Khz frequency in this 4 rows (for sample rate 44100!, this samples are all downsampled to 44100!)
MemGet LS, LS.OFFSET + (stp + es * 2), L3
MemGet RS, RS.OFFSET + (stp + es * 2), R3
MemGet LS, LS.OFFSET + (stp + es * 2) - 2, L4
MemGet RS, RS.OFFSET + (stp + es * 2) - 2, R4
'--------------------------------------------
hL = (L3 / -32768 + L4 / 32768) * HighVol
hR = (R3 / -32768 + R4 / 32768) * HighVol
SL = L1 * mix / 32768 '+ (NL / 32768 * bmix * Volume) 'the same as for R1 but for left channel.
sR = R1 * mix / 32768 '+ (NR / 32768 * bmix * Volume) 'R1 is original signal, mix is R1 percentage level in new signal, NR is created signal, bmix is percentage level for NR and volume is NR volume level.
sL2 = NL / 32768 * bmix * Volume
sR2 = NR / 32768 * bmix * Volume
For UpSampling = 1 To Ratio
SndRaw SL, sR, SOR1 ' original audio stream
SndRaw sL2, sR2, SOR2 ' triangle created stream
SndRaw hL, hR, SOR3
Next
NL = NL + PrL 'signal calculation - fall or rise - formation of a triangular waveform [LEFT]
NR = NR + PrR 'signal calculation - fall or rise - formation of a triangular waveform [RIGHT]
es = es + 1
Line (posuvX, (Height / 2 - SL * 100))-(posuvX, (Height / 2 + SL * 100)), , BF 'draw output signal to screen
Do Until SndRawLen(SOR1) < 0.1 'wait until all music samples are playing
_Limit 10
Loop
Loop
Loop
_SndClose s
_MemFree LS
_MemFree RS
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 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