Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
03-30-2024, 08:50 PM
(This post was last modified: Yesterday, 05:28 PM by Petr.)
The following program performs a sound effect by rapidly changing the frequency of the sound being played. It's a small thing that occurred to me today while traveling by car. It does not have filtered harmonic frequencies, so even lower frequencies creep into the sound above 1000Hz (well, that's how I explain it). I'm writing something completely different now, this was just an escape attempt for distraction.
Try value 10, 300, use MP3 (need single array type created with MemSound)
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
S = SndOpen("belfast.mp3")
Dim m As MEM
Dim As Single L, R, L2, R2
Dim As Long X, f
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
Input "Insert start and end freq (start, end); 2 to 10600:"; U, D
If D > U Then Swap D, U
If D > 10600 Then D = 10600
If U < 2 Then U = 2
'try U = 10, D = 300
X = D
Stp = 4 'frequency step
Y = Stp
Do Until n& >= m.SIZE - SndRate
If n& Mod SndRate \ 6 = 0 Then 'set speed for setting freq
X = X + Y
If X > U Then Y = -Stp
If X < D Then Y = Stp
End If
f = _SndRate / X 'get freqency in samples
Do Until f Mod 4 = 0 'set f dividible by 4 for use with mem
f = f + 1
Loop
MemGet m, m.OFFSET + n&, L
MemGet m, m.OFFSET + n& + 4, R
MemGet m, m.OFFSET + n& + f, L2
MemGet m, m.OFFSET + n& + f + 4, R2
SndRaw (L2 - L), (R2 - R)
Do Until SndRawLen <= .2
Locate 2
Print X
Limit 20
Loop
n& = n& + 8
Loop
SndClose S
MemFree m
System
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
I played with it a bit more, so here are two similar outputs.
Rapid anti-phase change - weak "quack" form - best heard on stringed instruments
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
S = SndOpen("08.mp3")
Dim m As MEM
Dim As Single L, R, L2, R2
Dim As Long X, f
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
Stp = 1 'frequency step
Y = 1
Do Until n& >= m.SIZE - SndRate
OldX = X
If n& Mod SndRate \ 30 = 0 Then X = X + Y
If X > 18 Then Y = -1
If X < 6 Then Y = 1
'get freqency in samples
f = _SndRate \ 2 \ X
So& = n& + 16 * X
MemGet m, m.OFFSET + n&, L
MemGet m, m.OFFSET + n& + 4, R
MemGet m, m.OFFSET + So&, L2
MemGet m, m.OFFSET + So& + 4, R2
SndRaw (L2 - L), (R2 - R)
Do Until SndRawLen <= .1
Locate 2
Print "Antiphase Freqency:"; f; "Hz "
Loop
n& = n& + 8
Loop
SndClose S
MemFree m
System
And here is the predecessor:
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
S = SndOpen("103.mp3")
Dim m As MEM
Dim As Single L, R, L2, R2
Dim As Long X, f
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
Stp = 1 'frequency step
Y = 1
Do Until n& >= m.SIZE - SndRate
OldX = X
If n& Mod SndRate \ 20 = 0 Then X = X + Y
If X > 99 Then Y = -1
If X < 3 Then Y = 1
'get freqency in samples
f = _SndRate \ 2 \ X
So& = n& + 16 * X
MemGet m, m.OFFSET + n&, L
MemGet m, m.OFFSET + n& + 4, R
MemGet m, m.OFFSET + So&, L2
MemGet m, m.OFFSET + So& + 4, R2
SndRaw (L2 - L), (R2 - R)
Do Until SndRawLen <= .1
Locate 2
Print "Antiphase Freqency:"; f; "Hz "
Loop
n& = n& + 8
Loop
SndClose S
MemFree m
System
The difference between them is only in the width of the changed antiphase frequency and also in the speed with which the change is made.
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
Next version - Here you can hold the automatically changing audio frequency by tapping the space bar. The program reads the harmonic frequencies to the selected frequency (if I understood the theory correctly) to make the sound more detailed.
So, now for equalization. When this program is taken and the individual bands are read, one should (probably) just set their volume and then via SNDOPENRAW, so that there is no mixing of the signals, the equalizer should be assembled. However, it is still necessary to solve the removal of higher frequencies from the signal with depths.
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
S = SndOpen("10.mp3")
Dim m As MEM
Dim As Single L(5), R(5), L2(5), R2(5), L, R
Dim As Long f, Y(5)
Dim As Single X(5)
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
For a = 1 To 5
Y(a) = 1 ' increase / decrease frequency (1 / -1)
X(a) = a * 2 'frequency indicator. So, if the number is 2, the signal value is read from the MEMSOUND field
' by 32 bytes further than the start of the signal
Next
'The program (if written correctly) should read two harmonic frequencies above and two below the selected frequency
'to make the sound denser
FreqChange = -1
Do Until n& >= m.SIZE - SndRate
If KeyHit = 32 Then FreqChange = Not FreqChange
If FreqChange Then
If n& Mod SndRate / 2 = 0 Then
a = 1
Do Until a = 5
X(a) = X(a) + Y(a)
If X(a) > 300 Then Y(a) = -1 'higher number here = lower minimal frequency
If X(a) < 2 Then Y(a) = 1 '2 is maximal value for high frequency (1/2 SndRate)
a = a + 1
Loop
End If
End If
a = 1
Do Until a = 5
'get freqency in samples
f& = _SndRate \ 2 \ X(a)
So& = n& + 8 * X(a)
MemGet m, m.OFFSET + n&, L(a)
MemGet m, m.OFFSET + n& + 4, R(a)
MemGet m, m.OFFSET + So&, L2(a)
MemGet m, m.OFFSET + So& + 4, R2(a)
L = L - (L(a) - L2(a))
R = R - (R(a) - R2(a))
a = a + 1
Loop
SndRaw L, R
L = 0
R = 0
Do Until SndRawLen <= .01
Locate 2
Print "Antiphase Freqency:"; f&; "Hz "
Print "Press space for hold / autochange frequency"
Loop
n& = n& + 8
Loop
SndClose S
MemFree m
System
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
04-07-2024, 06:35 PM
(This post was last modified: 04-07-2024, 06:40 PM by Petr.)
So here's something as the equalizer style. I was lazy to do with the graphics and adjust the sliders here.... so I did it using the keyboard, or repeatedly press V to start or end the quick adjustment of the equalization.
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
Title "Equalizer"
S = SndOpen("10.mp3")
Dim m As MEM
Dim Shared As Single L(5), R(5), L2(5), R2(5), Le(10), Ri(10), LVol(10), RVol(10), X(10)
Dim As Long f
Dim As Long Raw(10)
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
eff = 0
X(1) = SetFreq(80)
X(2) = SetFreq(125)
X(3) = SetFreq(180)
X(4) = SetFreq(250)
X(5) = SetFreq(500)
X(6) = SetFreq(1000)
X(7) = SetFreq(2000)
X(8) = SetFreq(4000)
X(8) = SetFreq(8000)
X(9) = SetFreq(12000)
X(10) = SetFreq(16000)
For SetVol = 1 To 10
LVol(SetVol) = 0.1
RVol(SetVol) = 0.1
Next
For R = 1 To 10
Raw(R) = SndOpenRaw
Next
'The program (if written correctly) should read two harmonic frequencies above and two below the selected frequency
'to make the sound denser
FreqChange = -1
Do Until n& >= m.SIZE - SndRate
eq = 1
Do Until eq = 10
a = 1
Le(eq) = 0
Ri(eq) = 0
Do Until a = 5
'get freqency in samples
So& = n& + 8 * X(eq)
MemGet m, m.OFFSET + n&, L(a)
MemGet m, m.OFFSET + n& + 4, R(a)
MemGet m, m.OFFSET + So&, L2(a)
MemGet m, m.OFFSET + So& + 4, R2(a)
Le(eq) = Le(eq) - (L(a) - L2(a))
Ri(eq) = Ri(eq) - (R(a) - R2(a))
a = a + 1
Loop
Le(eq) = Le(eq) * LVol(eq)
Ri(eq) = Ri(eq) * RVol(eq)
eq = eq + 1
Loop
For eq = 1 To 10
SndRaw Le(eq), Ri(eq), Raw(eq) ', Raw(eq)
Next
If eff Then
If n& Mod SndRate / 20 = 0 Then
omega = omega + .1
For eq = 1 To 10
LVol(eq) = Abs(Sin(omega + eq * Pi / 20))
RVol(eq) = Abs(Sin(omega + eq * Pi / 20))
Next
End If
End If
Do Until SndRawLen(Raw(10)) <= .1
i$ = InKey$
Select Case LCase$(i$)
Case "q": SetEqVolP 1
Case "a": SetEqVolM 1
Case "w": SetEqVolP 2
Case "s": SetEqVolM 2
Case "e": SetEqVolP 3
Case "d": SetEqVolM 3
Case "r": SetEqVolP 4
Case "f": SetEqVolM 4
Case "t": SetEqVolP 5
Case "g": SetEqVolM 5
Case "y": SetEqVolP 6
Case "h": SetEqVolM 6
Case "u": SetEqVolP 7
Case "j": SetEqVolM 7
Case "i": SetEqVolP 8
Case "k": SetEqVolM 8
Case "o": SetEqVolP 9
Case "l": SetEqVolM 9
Case "p": SetEqVolP 10
Case "ů": SetEqVolM 10
Case "v": eff = Not eff
End Select
Locate 2
Print "First equalizer."
Print "Press: q,w,e,r,t,y,u,i,o,p for eq volume up"
Print " a,s,d,f,g,h,j,k,l,ů for eq volume down"
For eqva = 1 To 10
Print "Freq: "; SndRate \ X(eqva); " vol:"; LVol(eqva); " "
Next
Loop
n& = n& + 8
Loop
SndClose S
MemFree m
System
Sub SetEqVolM (i)
LVol(i) = LVol(i) - .1
If LVol(i) < 0 Then LVol(i) = 0
RVol(i) = LVol(i)
End Sub
Sub SetEqVolP (i)
LVol(i) = LVol(i) + .1
If LVol(i) > 1.4 Then LVol(i) = 1.4
RVol(i) = LVol(i)
End Sub
Function SetFreq (f)
SetFreq = SndRate \ 2 \ f
End Function
Finally is used SndOpenRaw too.
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
Yesterday, 05:19 PM
(This post was last modified: Yesterday, 08:19 PM by Petr.)
All previous programs in this thread were attempts to achieve the desired result. So here is the final program. It is a real equalizer, controlled from the keyboard. What to press is directly written on the screen after starting. It uses FFT and IFFT and for run requires one of your stereo MP3 file.
Code: (Select All)
_Title "QB64PE Sound Equalizer"
Zdroj = _SndOpen("b.mp3") 'USE MP3 here (MEM read singles from _Memsound block)
Dim Zvuk As _MEM
Dim A As Long
UU = 8191 ' We detecting frequency from 8192 samples (0 to 8191)
Dim Blok(UU) As Single ' Block for FFT samples - Left channel
Dim BlokR(UU) As Single ' Right
Dim RealPart(UU) As Single, ImagPart(UU) As Single ' Real and imaginary signal values for FFT - Left
Dim RealPartR(UU) As Single, ImagPartR(UU) As Single ' - Right
Dim Eq(9) As Single
Dim Shared N As Long
Dim VzorkovaciFrekvence As Single ' SoundRate
N = UU + 1 ' FFT Block size
Zvuk = _MemSound(Zdroj, 0)
VzorkovaciFrekvence = _SndRate
For FillEq = 0 To 9
Eq(FillEq) = 1
Next
Do Until A& = Zvuk.SIZE
' Načtení bloku vzorků
For i = 0 To N - 1
If A& >= Zvuk.SIZE Then Exit For
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A&, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A& + 4, Single)
Blok(i) = LevaStopa ' Left Track
BlokR(i) = PravaStopa ' Right Track
RealPart(i) = LevaStopa ' Left Track AudioData RealPart must contains sound data
RealPartR(i) = PravaStopa ' Right Track AudioData
ImagPart(i) = 0 ' Left Track imaginary data
ImagPartR(i) = 0 ' Right Track imaginary data
A& = A& + 8 ' go to next sample (8 bytes = 2 * 4 (left, right))
Next i
' Apply FFT to block
Call FFT(RealPart(), ImagPart(), N) ' shift sound from time run to frequency run - Left Track
Call FFT(RealPartR(), ImagPartR(), N) ' the same - Right Track
'spectrum filtration
For k = 0 To N - 1
Frekvence = k * VzorkovaciFrekvence / N 'Frequency calculation (k * _SndRate / N)
Vol = 0
Select Case Frekvence 'use frequency for equalizing!
Case 32 To 64: Vol = Eq(0)
Case 65 To 125: Vol = Eq(1)
Case 126 To 250: Vol = Eq(2)
Case 251 To 500: Vol = Eq(3)
Case 501 To 1000: Vol = Eq(4)
Case 1001 To 2000: Vol = Eq(5)
Case 2001 To 4000: Vol = Eq(6)
Case 4001 To 8000: Vol = Eq(7)
Case 8001 To 16000: Vol = Eq(8)
Case 16001 To 22000: Vol = Eq(9)
End Select
RealPart(k) = RealPart(k) * Vol 'update frequency so, as is equalization set
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
'create new audio signal using IFFT (from this block)
Call IFFT(RealPart(), ImagPart(), N)
Call IFFT(RealPartR(), ImagPartR(), N)
'Play created signal
For i = 0 To N - 1
If RealPart(i) > .95 Then RealPart(i) = .95
If RealPart(i) < -.95 Then RealPart(i) = -.95
If RealPartR(i) > .95 Then RealPartR(i) = .95
If RealPartR(i) < -.95 Then RealPartR(i) = -.95
_SndRaw RealPart(i), RealPartR(i)
Next i
Do Until _SndRawLen < .1 'wait until is possible playing next block and it this time use keyboard
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + .1
Case "a": Eq(0) = Eq(0) - .1
Case "w": Eq(1) = Eq(1) + .1
Case "s": Eq(1) = Eq(1) - .1
Case "e": Eq(2) = Eq(2) + .1
Case "d": Eq(2) = Eq(2) - .1
Case "r": Eq(3) = Eq(3) + .1
Case "f": Eq(3) = Eq(3) - .1
Case "t": Eq(4) = Eq(4) + .1
Case "g": Eq(4) = Eq(4) - .1
Case "y": Eq(5) = Eq(5) + .1
Case "h": Eq(5) = Eq(5) - .1
Case "u": Eq(6) = Eq(6) + .1
Case "j": Eq(6) = Eq(6) - .1
Case "i": Eq(7) = Eq(7) + .1
Case "k": Eq(7) = Eq(7) - .1
Case "o": Eq(8) = Eq(8) + .1
Case "l": Eq(8) = Eq(8) - .1
Case "p": Eq(9) = Eq(9) + .1
Case ";": Eq(9) = Eq(9) - .1
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [32 to 64 Hz] "; Int((Eq(0) - 1) * 100); "% "
Print " w/s [65 to 125 Hz] "; Int((Eq(1) - 1) * 100); "% "
Print " e/d [126 to 250 Hz] "; Int((Eq(2) - 1) * 100); "% "
Print " r/f [251 to 500 Hz] "; Int((Eq(3) - 1) * 100); "% "
Print " t/g [501 to 1000 Hz] "; Int((Eq(4) - 1) * 100); "% "
Print " y/h [1001 to 2000 Hz] "; Int((Eq(5) - 1) * 100); "% "
Print " u/j [2001 to 4000 Hz] "; Int((Eq(6) - 1) * 100); "% "
Print " i/k [4001 to 8000 Hz] "; Int((Eq(7) - 1) * 100); "% "
Print " o/l [8001 to 16000 Hz] "; Int((Eq(8) - 1) * 100); "% "
Print " p/; [16001 to 22000 Hz] "; Int((Eq(9) - 1) * 100); "% "
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 2 Then Eq(EqVolsTest) = 2
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
Loop
_MemFree Zvuk
End
Sub FFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long, j As Long, k As Long, m As Long, stp As Long
Dim angle As Double
Dim tReal As Double, tImag As Double, uReal As Double, uImag As Double
' Bit-reverse permutation (That sounds really good, doesn't it?) Don't ask me what that means, okay? ))
j = 0
For i = 0 To N - 1
If i < j Then
Swap RealPart(i), RealPart(j)
Swap ImagPart(i), ImagPart(j)
End If
k = N \ 2
Do While (k >= 1 And j >= k)
j = j - k
k = k \ 2
Loop
j = j + k
Next i
m = 1
Do While m < N
stp = m * 2
angle = -3.14159265359 / m
For k = 0 To m - 1
uReal = Cos(k * angle)
uImag = Sin(k * angle)
For i = k To N - 1 Step stp
j = i + m
tReal = uReal * RealPart(j) - uImag * ImagPart(j)
tImag = uReal * ImagPart(j) + uImag * RealPart(j)
RealPart(j) = RealPart(i) - tReal
ImagPart(j) = ImagPart(i) - tImag
RealPart(i) = RealPart(i) + tReal
ImagPart(i) = ImagPart(i) + tImag
Next i
Next k
m = stp
Loop
End Sub
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Reversing the signs of imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Performing FFT
Call FFT(RealPart(), ImagPart(), N)
'Normalization and re-rotation of the signs of the imaginary components
For i = 0 To N - 1
RealPart(i) = RealPart(i) / N
ImagPart(i) = -ImagPart(i) / N
Next i
End Sub
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
Yesterday, 08:19 PM
(This post was last modified: Yesterday, 08:20 PM by Petr.)
Here is version with frequency visualisation, including recalculation of visualization depending on how the ear perceives different frequencies.
Code: (Select All)
_Title "QB64PE Sound Equalizer"
Zdroj = _SndOpen("b.mp3") 'USE MP3 here (MEM read singles from _Memsound block)
Dim Zvuk As _MEM
Dim A As Long
UU = 2047 ' We detecting frequency from 8192 samples (0 to 8191)
Dim Blok(UU) As Single ' Block for FFT samples - Left channel
Dim BlokR(UU) As Single ' Right
Dim RealPart(UU) As Single, ImagPart(UU) As Single ' Real and imaginary signal values for FFT - Left
Dim RealPartR(UU) As Single, ImagPartR(UU) As Single ' - Right
Dim Eq(9) As Single
Dim Shared N As Long
Dim VzorkovaciFrekvence As Single ' SoundRate
Dim VisualEq(9) As Single
Dim Colors(9) As _Unsigned Long
Colors(0) = _RGB32(255, 0, 0)
Colors(1) = _RGB32(255, 127, 0)
Colors(2) = _RGB32(255, 255, 0)
Colors(3) = _RGB32(127, 255, 0)
Colors(4) = _RGB32(0, 255, 0)
Colors(5) = _RGB32(0, 255, 127)
Colors(6) = _RGB32(0, 255, 255)
Colors(7) = _RGB32(0, 127, 255)
Colors(8) = _RGB32(0, 0, 255)
Colors(9) = _RGB32(127, 0, 255)
' Scales for correcting the sensitivity of the human ear (Fletcher-Munson)
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' We amplify bass frequencies (2 to 64 Hz)
Korekce(1) = 1.8 ' We will amplify low bass (65 to 125 Hz)
Korekce(2) = 1.5 ' Middle bass (126 to 250 Hz)
Korekce(3) = 1.2 ' Lower midrange (251 to 500 Hz)
Korekce(4) = 1.0 ' Mindrange (501 to 1000 Hz)
Korekce(5) = 0.8 ' Higher Mindrange (1001 to 2000 Hz)
Korekce(6) = 0.7 ' Lower treble (2001 to 4000 Hz)
Korekce(7) = 0.6 ' Treble (4001 to 8000 Hz)
Korekce(8) = 0.5 ' Higher treble (8001 to 16000 Hz)
Korekce(9) = 0.4 ' Ultrasonic frequencies (16001 to 22000 Hz) are suppressed
N = UU + 1 ' FFT Block size
Zvuk = _MemSound(Zdroj, 0)
VzorkovaciFrekvence = _SndRate
Screen _NewImage(800, 600, 32) ' Create a new window for visualization
For FillEq = 0 To 9
Eq(FillEq) = 2
Next
Do Until A& = Zvuk.SIZE
' Naètení bloku vzorkù
For i = 0 To N - 1
If A& >= Zvuk.SIZE Then Exit For
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A&, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A& + 4, Single)
Blok(i) = LevaStopa ' Left Track
BlokR(i) = PravaStopa ' Right Track
RealPart(i) = LevaStopa ' Left Track AudioData RealPart must contains sound data
RealPartR(i) = PravaStopa ' Right Track AudioData
ImagPart(i) = 0 ' Left Track imaginary data
ImagPartR(i) = 0 ' Right Track imaginary data
A& = A& + 8 ' go to next sample (8 bytes = 2 * 4 (left, right))
Next i
' Apply FFT to block
Call FFT(RealPart(), ImagPart(), N) ' shift sound from time run to frequency run - Left Track
Call FFT(RealPartR(), ImagPartR(), N) ' the same - Right Track
'spectrum filtration
For k = 0 To N - 1
Frekvence = k * VzorkovaciFrekvence / N 'Frequency calculation (k * _SndRate / N)
Vol = 0
Select Case Frekvence 'use frequency for equalizing!
Case 2 To 64: Vol = Eq(0): VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Eq(0) * Korekce(0)
Case 65 To 125: Vol = Eq(1): VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Eq(1) * Korekce(1)
Case 126 To 250: Vol = Eq(2): VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Eq(2) * Korekce(2)
Case 251 To 500: Vol = Eq(3): VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Eq(3) * Korekce(3)
Case 501 To 1000: Vol = Eq(4): VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Eq(4) * Korekce(4)
Case 1001 To 2000: Vol = Eq(5): VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Eq(5) * Korekce(5)
Case 2001 To 4000: Vol = Eq(6): VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Eq(6) * Korekce(6)
Case 4001 To 8000: Vol = Eq(7): VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Eq(7) * Korekce(7)
Case 8001 To 16000: Vol = Eq(8): VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Eq(8) * Korekce(8)
Case 16001 To 22000: Vol = Eq(9): VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Eq(9) * Korekce(9)
End Select
RealPart(k) = RealPart(k) * Vol 'update frequency so, as is equalization set
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
'create new audio signal using IFFT (from this block)
Call IFFT(RealPart(), ImagPart(), N)
Call IFFT(RealPartR(), ImagPartR(), N)
'Play created signal
For i = 0 To N - 1
If RealPart(i) > .95 Then RealPart(i) = .95
If RealPart(i) < -.95 Then RealPart(i) = -.95
If RealPartR(i) > .95 Then RealPartR(i) = .95
If RealPartR(i) < -.95 Then RealPartR(i) = -.95
_SndRaw RealPart(i), RealPartR(i)
Next i
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / N ' Normalize
BarHeight = VisualEq(EqBand) * 400 ' Scale to fit screen
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next
Do Until _SndRawLen < .05 'wait until is possible playing next block and it this time use keyboard
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + .1
Case "a": Eq(0) = Eq(0) - .1
Case "w": Eq(1) = Eq(1) + .1
Case "s": Eq(1) = Eq(1) - .1
Case "e": Eq(2) = Eq(2) + .1
Case "d": Eq(2) = Eq(2) - .1
Case "r": Eq(3) = Eq(3) + .1
Case "f": Eq(3) = Eq(3) - .1
Case "t": Eq(4) = Eq(4) + .1
Case "g": Eq(4) = Eq(4) - .1
Case "y": Eq(5) = Eq(5) + .1
Case "h": Eq(5) = Eq(5) - .1
Case "u": Eq(6) = Eq(6) + .1
Case "j": Eq(6) = Eq(6) - .1
Case "i": Eq(7) = Eq(7) + .1
Case "k": Eq(7) = Eq(7) - .1
Case "o": Eq(8) = Eq(8) + .1
Case "l": Eq(8) = Eq(8) - .1
Case "p": Eq(9) = Eq(9) + .1
Case ";": Eq(9) = Eq(9) - .1
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2 to 64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65 to 125 Hz] "; Int((Eq(1) - 2) * 100); "% "
Print " e/d [126 to 250 Hz] "; Int((Eq(2) - 2) * 100); "% "
Print " r/f [251 to 500 Hz] "; Int((Eq(3) - 2) * 100); "% "
Print " t/g [501 to 1000 Hz] "; Int((Eq(4) - 2) * 100); "% "
Print " y/h [1001 to 2000 Hz] "; Int((Eq(5) - 2) * 100); "% "
Print " u/j [2001 to 4000 Hz] "; Int((Eq(6) - 2) * 100); "% "
Print " i/k [4001 to 8000 Hz] "; Int((Eq(7) - 2) * 100); "% "
Print " o/l [8001 to 16000 Hz] "; Int((Eq(8) - 2) * 100); "% "
Print " p/; [16001 to 22000 Hz] "; Int((Eq(9) - 2) * 100); "% "
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 4 Then Eq(EqVolsTest) = 4
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
'_Display
Loop
_MemFree Zvuk
End
Sub FFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long, j As Long, k As Long, m As Long, stp As Long
Dim angle As Double
Dim tReal As Double, tImag As Double, uReal As Double, uImag As Double
' Bit-reverse permutation (That sounds really good, doesn't it?) Don't ask me what that means, okay? ))
j = 0
For i = 0 To N - 1
If i < j Then
Swap RealPart(i), RealPart(j)
Swap ImagPart(i), ImagPart(j)
End If
k = N \ 2
Do While (k >= 1 And j >= k)
j = j - k
k = k \ 2
Loop
j = j + k
Next i
m = 1
Do While m < N
stp = m * 2
angle = -3.14159265359 / m
For k = 0 To m - 1
uReal = Cos(k * angle)
uImag = Sin(k * angle)
For i = k To N - 1 Step stp
j = i + m
tReal = uReal * RealPart(j) - uImag * ImagPart(j)
tImag = uReal * ImagPart(j) + uImag * RealPart(j)
RealPart(j) = RealPart(i) - tReal
ImagPart(j) = ImagPart(i) - tImag
RealPart(i) = RealPart(i) + tReal
ImagPart(i) = ImagPart(i) + tImag
Next i
Next k
m = stp
Loop
End Sub
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Reversing the signs of imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Performing FFT
Call FFT(RealPart(), ImagPart(), N)
'Normalization and re-rotation of the signs of the imaginary components
For i = 0 To N - 1
RealPart(i) = RealPart(i) / N
ImagPart(i) = -ImagPart(i) / N
Next i
End Sub
Posts: 391
Threads: 24
Joined: May 2022
Reputation:
67
This is cool stuff! I'll check it out after work. Have you tried doing pitch shifts?
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
If you mean frequency shifting of the entire song, or specific change of one frequency to another, then I will try that. In that case, it is purely about adjusting a specific frequency range. Muting or amplifying by multiplication.
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
3 hours ago
(This post was last modified: 2 hours ago by Petr.)
(Yesterday, 08:48 PM)a740g Wrote: This is cool stuff! I'll check it out after work. Have you tried doing pitch shifts?
So I already tried it  This code changes the frequency itself continuously: (in code is the new part commented as reply for you)
Code: (Select All)
_Title "QB64PE Sound Equalizer"
Zdroj = _SndOpen("s.mp3") 'USE MP3 here (MEM read singles from _Memsound block)
Dim Zvuk As _MEM
Dim A As Long
UU = 2047 ' We detecting frequency from 8192 samples (0 to 8191)
Dim Blok(UU) As Single ' Block for FFT samples - Left channel
Dim BlokR(UU) As Single ' Right
Dim RealPart(UU) As Single, ImagPart(UU) As Single ' Real and imaginary signal values for FFT - Left
Dim RealPartR(UU) As Single, ImagPartR(UU) As Single ' - Right
Dim Eq(9) As Single
ReDim NewRealPartR(UU) As Single
ReDim NewImagPartR(UU) As Single
ReDim NewRealPart(UU) As Single
ReDim NewImagPart(UU) As Single
Dim Shared N As Long
Dim VzorkovaciFrekvence As Single ' SoundRate
Dim VisualEq(9) As Single
Dim Colors(9) As _Unsigned Long
Colors(0) = _RGB32(255, 0, 0)
Colors(1) = _RGB32(255, 127, 0)
Colors(2) = _RGB32(255, 255, 0)
Colors(3) = _RGB32(127, 255, 0)
Colors(4) = _RGB32(0, 255, 0)
Colors(5) = _RGB32(0, 255, 127)
Colors(6) = _RGB32(0, 255, 255)
Colors(7) = _RGB32(0, 127, 255)
Colors(8) = _RGB32(0, 0, 255)
Colors(9) = _RGB32(127, 0, 255)
' Scales for correcting the sensitivity of the human ear (Fletcher-Munson)
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' We amplify bass frequencies (2 to 64 Hz)
Korekce(1) = 1.8 ' We will amplify low bass (65 to 125 Hz)
Korekce(2) = 1.5 ' Middle bass (126 to 250 Hz)
Korekce(3) = 1.2 ' Lower midrange (251 to 500 Hz)
Korekce(4) = 1.0 ' Mindrange (501 to 1000 Hz)
Korekce(5) = 0.8 ' Higher Mindrange (1001 to 2000 Hz)
Korekce(6) = 0.7 ' Lower treble (2001 to 4000 Hz)
Korekce(7) = 0.6 ' Treble (4001 to 8000 Hz)
Korekce(8) = 0.5 ' Higher treble (8001 to 16000 Hz)
Korekce(9) = 0.4 ' Ultrasonic frequencies (16001 to 22000 Hz) are suppressed
N = UU + 1 ' FFT Block size
Fk = 1
Zvuk = _MemSound(Zdroj, 0)
VzorkovaciFrekvence = _SndRate
Screen _NewImage(800, 600, 32) ' Create a new window for visualization
For FillEq = 0 To 9
Eq(FillEq) = 2
Next
Do Until A& = Zvuk.SIZE
' Načtení bloku vzorků
For i = 0 To N - 1
If A& >= Zvuk.SIZE Then Exit For
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A&, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A& + 4, Single)
Blok(i) = LevaStopa ' Left Track
BlokR(i) = PravaStopa ' Right Track
RealPart(i) = LevaStopa ' Left Track AudioData RealPart must contains sound data
RealPartR(i) = PravaStopa ' Right Track AudioData
ImagPart(i) = 0 ' Left Track imaginary data
ImagPartR(i) = 0 ' Right Track imaginary data
A& = A& + 8 ' go to next sample (8 bytes = 2 * 4 (left, right))
Next i
' Apply FFT to block
Call FFT(RealPart(), ImagPart(), N) ' shift sound from time run to frequency run - Left Track
Call FFT(RealPartR(), ImagPartR(), N) ' the same - Right Track
'spectrum filtration
For k = 0 To N - 1
Frekvence = k * VzorkovaciFrekvence / N 'Frequency calculation (k * _SndRate / N)
Vol = 0
Select Case Frekvence 'use frequency for equalizing!
Case 2 To 64: Vol = Eq(0): VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Eq(0) * Korekce(0)
Case 65 To 125: Vol = Eq(1): VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Eq(1) * Korekce(1)
Case 126 To 250: Vol = Eq(2): VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Eq(2) * Korekce(2)
Case 251 To 500: Vol = Eq(3): VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Eq(3) * Korekce(3)
Case 501 To 1000: Vol = Eq(4): VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Eq(4) * Korekce(4)
Case 1001 To 2000: Vol = Eq(5): VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Eq(5) * Korekce(5)
Case 2001 To 4000: Vol = Eq(6): VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Eq(6) * Korekce(6)
Case 4001 To 8000: Vol = Eq(7): VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Eq(7) * Korekce(7)
Case 8001 To 16000: Vol = Eq(8): VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Eq(8) * Korekce(8)
Case 16001 To 22000: Vol = Eq(9): VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Eq(9) * Korekce(9)
End Select
RealPart(k) = RealPart(k) * Vol 'update frequency so, as is equalization set
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
'-------------------------------- A 740g wrote: This is cool stuff! I'll check it out after work. Have you tried doing pitch shifts? ---------------------------------------
'REPLY:
'Changing the size of the spectrum according to the new tuning
For i = 0 To N - 1
'Recalculation of the new index
newIndex = i * Fk
'Verifying that newIndex is within a valid range
If newIndex > N - 1 Then
newIndex = N - 1
End If
' Find two adjacent indices for interpolation
index1 = Int(newIndex) 'Nearest smaller or equal index
index2 = index1 + 1 ' Nearest larger index
' Verify that index2 is also in a valid range
If index2 > N - 1 Then
index2 = index1
End If
' Weight for linear interpolation
weight = newIndex - index1
'Linear interpolation of real and imaginary parts - left channel
RealPartInterpolated = RealPart(index1) + weight * (RealPart(index2) - RealPart(index1))
ImagPartInterpolated = ImagPart(index1) + weight * (ImagPart(index2) - ImagPart(index1))
'Linear interpolation - right channel
RealPartInterpolatedR = RealPartR(index1) + weight * (RealPartR(index2) - RealPartR(index1))
ImagPartInterpolatedR = ImagPartR(index1) + weight * (ImagPartR(index2) - ImagPartR(index1))
'Saving interpolated values to a new spectrum
NewRealPart(i) = RealPartInterpolated
NewImagPart(i) = ImagPartInterpolated
NewRealPartR(i) = RealPartRInterpolatedR
NewImagPartR(i) = ImagPartRInterpolatedR
Next i
'-------------------------------------------------------- REPLY END ---------------------------------------------------------------------------------------------------------
'Unlike the previous code, here continue with the NewRealPart and NewImagPart fields
'create new audio signal using IFFT (from this block)
Call IFFT(NewRealPart(), NewImagPart(), N)
Call IFFT(NewRealPartR(), NewImagPartR(), N)
'Play created signal
For i = 0 To N - 1
If NewRealPart(i) > .95 Then NewRealPart(i) = .95
If NewRealPart(i) < -.95 Then NewRealPart(i) = -.95
If NewRealPartR(i) > .95 Then NewRealPartR(i) = .95
If NewRealPartR(i) < -.95 Then NewRealPartR(i) = -.95
_SndRaw NewRealPart(i), NewRealPartR(i)
Next i
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / N ' Normalize
BarHeight = VisualEq(EqBand) * 400 ' Scale to fit screen
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next
Do Until _SndRawLen < .05 'wait until is possible playing next block and it this time use keyboard
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + .1
Case "a": Eq(0) = Eq(0) - .1
Case "w": Eq(1) = Eq(1) + .1
Case "s": Eq(1) = Eq(1) - .1
Case "e": Eq(2) = Eq(2) + .1
Case "d": Eq(2) = Eq(2) - .1
Case "r": Eq(3) = Eq(3) + .1
Case "f": Eq(3) = Eq(3) - .1
Case "t": Eq(4) = Eq(4) + .1
Case "g": Eq(4) = Eq(4) - .1
Case "y": Eq(5) = Eq(5) + .1
Case "h": Eq(5) = Eq(5) - .1
Case "u": Eq(6) = Eq(6) + .1
Case "j": Eq(6) = Eq(6) - .1
Case "i": Eq(7) = Eq(7) + .1
Case "k": Eq(7) = Eq(7) - .1
Case "o": Eq(8) = Eq(8) + .1
Case "l": Eq(8) = Eq(8) - .1
Case "p": Eq(9) = Eq(9) + .1
Case ";": Eq(9) = Eq(9) - .1
Case "+": Fk = Fk + .01
Case "-": Fk = Fk - .01
If Fk < .1 Then Fk = .1
If Fk > 2 Then Fk = 2
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2 to 64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65 to 125 Hz] "; Int((Eq(1) - 2) * 100); "% "
Print " e/d [126 to 250 Hz] "; Int((Eq(2) - 2) * 100); "% "
Print " r/f [251 to 500 Hz] "; Int((Eq(3) - 2) * 100); "% "
Print " t/g [501 to 1000 Hz] "; Int((Eq(4) - 2) * 100); "% "
Print " y/h [1001 to 2000 Hz] "; Int((Eq(5) - 2) * 100); "% "
Print " u/j [2001 to 4000 Hz] "; Int((Eq(6) - 2) * 100); "% "
Print " i/k [4001 to 8000 Hz] "; Int((Eq(7) - 2) * 100); "% "
Print " o/l [8001 to 16000 Hz] "; Int((Eq(8) - 2) * 100); "% "
Print " p/; [16001 to 22000 Hz] "; Int((Eq(9) - 2) * 100); "% "
Print " + or - for changing frequency shift! "
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 4 Then Eq(EqVolsTest) = 4
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
'_Display
Loop
_MemFree Zvuk
End
Sub FFT (iRealPart() As Single, iImagPart() As Single, N As Long)
Dim i As Long, j As Long, k As Long, m As Long, stp As Long
Dim angle As Double
Dim tReal As Double, tImag As Double, uReal As Double, uImag As Double
' Bit-reverse permutation
j = 0
For i = 0 To N - 1
If i < j Then
Swap iRealPart(i), iRealPart(j)
Swap iImagPart(i), iImagPart(j)
End If
k = N \ 2
Do While (k >= 1 And j >= k)
j = j - k
k = k \ 2
Loop
j = j + k
Next i
m = 1
Do While m < N
stp = m * 2
angle = -3.14159265359 / m
For k = 0 To m - 1
uReal = Cos(k * angle)
uImag = Sin(k * angle)
For i = k To N - 1 Step stp
j = i + m
tReal = uReal * iRealPart(j) - uImag * iImagPart(j)
tImag = uReal * iImagPart(j) + uImag * iRealPart(j)
iRealPart(j) = iRealPart(i) - tReal
iImagPart(j) = iImagPart(i) - tImag
iRealPart(i) = iRealPart(i) + tReal
iImagPart(i) = iImagPart(i) + tImag
Next i
Next k
m = stp
Loop
End Sub
Sub IFFT (iRealPart() As Single, iImagPart() As Single, N As Long)
Dim i As Long
' Reversing the signs of imaginary components
For i = 0 To N - 1
iImagPart(i) = -iImagPart(i)
Next i
' Performing FFT
Call FFT(iRealPart(), iImagPart(), N)
'Normalization and re-rotation of the signs of the imaginary components
For i = 0 To N - 1
iRealPart(i) = iRealPart(i) / N
iImagPart(i) = -iImagPart(i) / N
Next i
End Sub
USE + and - 
Posts: 286
Threads: 46
Joined: May 2022
Reputation:
29
1 hour ago
(This post was last modified: 1 hour ago by Petr.)
Maybe for best output set UU variable (row 6) to 4095. This variable specifies the length of the field for the Fourier transform. This variable must be set in exponents of two minus 1 (1, 3, 7, 15, 31, 63..... 1023, 2047, 4095, 8191). Those with a powerful computer can go even higher. For me, 4095 is optimal on my old computer. The higher the number, the better the signal detection, but also the higher the processor requirements. If id set 4095, compuiter "see" total 4096 frequencies. You will probably notice the sound cracking sometimes. This is caused by the discontinuity of the signal. To be more precise - example: One frequency range is set to +200 and the other to -200. As it is written now, an edge is created at the interface of the frequencies. For smooth equalization, a linear gradual transition will have to be added (so I see it as setting, for example, 0 to 80 Hz and the next one will be 120 - 160 Hz. The band between 80 and 120 will linearly decrease or increase according to the settings of these bands. Well, I might have thought of it earlier, however, it will still apply in this thread - latest source code = latest version.
|
