Posts: 310
Threads: 51
Joined: May 2022
Reputation:
35
01-12-2025, 07:43 PM
(This post was last modified: 01-12-2025, 08:18 PM by Petr.)
Don't be afraid to report bugs! Didn't you notice that one speaker is silent after my answer for a740g? The bug has been found and fixed. There was a typo (just before the commented end of the answer) here: NewRealPartR(i) = RealPartRInterpolatedR
NewImagPartR(i) = ImagPartRInterpolatedR
Do you see that one extra R there? That's a cheeky letter R! Very bad cheeky!  Fixed to
NewRealPartR(i) = RealPartInterpolatedR
NewImagPartR(i) = ImagPartInterpolatedR
and now playing in stereo.
Do you want a rough bass? The volume is monitored by this loop:
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 4 Then Eq(EqVolsTest) = 4 '4 is optimal value
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
You have a value other than 4. But don't come to me with bills for new speakers.
I'm working on removing the cracking.
Posts: 310
Threads: 51
Joined: May 2022
Reputation:
35
Well, I did what I could. If you overdo a certain frequency, the crackling will still be heard. When used outside the extreme limits, I think it's a little better. I added two effects to it. Key 3 turns the ping pong effect on/off, and keys 4, 5, 6, 7 set its parameters. 4 and 5 for Delay Time and 6 and 7 for FeddBack. The second effect is inactive until you turn it up, then turn it down to deactivate it (keys 1 and 2). Oh, and it plays in stereo. Work is still ongoing.
Code: (Select All)
_Title "QB64PE Sound Equalizer v. 2"
Zdroj = _SndOpen("b.mp3") 'USE MP3 here (MEM read singles from _Memsound block)
Dim Zvuk As _MEM
Dim A As Long
UU = 4095 ' 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
ReDim Shared delayBufferL(0) As Single, delayBufferR(0) 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
' NormalizeSignal RealPart()
' NormalizeSignal RealPartR()
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 10 To 64: Vol = Eq(0): VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Eq(0) * Korekce(0)
Case 60 To 120: Vol = Eq(1): VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Eq(1) * Korekce(1)
Case 110 To 250: Vol = Eq(2): VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Eq(2) * Korekce(2)
Case 230 To 500: Vol = Eq(3): VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Eq(3) * Korekce(3)
Case 480 To 1000: Vol = Eq(4): VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Eq(4) * Korekce(4)
Case 900 To 2000: Vol = Eq(5): VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Eq(5) * Korekce(5)
Case 1900 To 4000: Vol = Eq(6): VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Eq(6) * Korekce(6)
Case 3700 To 8000: Vol = Eq(7): VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Eq(7) * Korekce(7)
Case 7000 To 16000: Vol = Eq(8): VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Eq(8) * Korekce(8)
Case 14000 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) = RealPartInterpolatedR
NewImagPartR(i) = ImagPartInterpolatedR
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)
StereoAutoPanner NewRealPart(), NewRealPartR(), sp, _SndRate
If pong Then
PingPongDelay NewRealPart(), NewRealPartR(), delaytime, feedback, _SndRate
End If
LowPassFilterInPlace NewRealPart(), 14000, _SndRate
LowPassFilterInPlace NewRealPartR(), 14000, _SndRate
NormalizeSignal NewRealPart()
NormalizeSignal NewRealPartR()
'Play created signal
For i = 0 To N - 1
_SndRaw NewRealPart(i), NewRealPartR(i)
Next i
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / N ' Normalize
BarHeight = VisualEq(EqBand) * 80 ' 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
Case "*": Fk = 1
Case "1": sp = sp + 0.01
Case "2": sp = sp - 0.01
Case "3": pong = Not pong: _Delay .01
Case "4": delaytime = delaytime + .01
Case "5": delaytime = delaytime - .01
Case "6": feedback = feedback + .01
Case "7": feedback = feedback - .01
End Select
If Fk < .1 Then Fk = .1
If Fk > 1.9 Then Fk = 1.9
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2 to 64 Hz] "; Int(Eq(0) / 8 * 100); "% "
Print " w/s [65 to 125 Hz] "; Int(Eq(1) / 8 * 100); "% "
Print " e/d [126 to 250 Hz] "; Int(Eq(2) / 8 * 100); "% "
Print " r/f [251 to 500 Hz] "; Int(Eq(3) / 8 * 100); "% "
Print " t/g [501 to 1000 Hz] "; Int(Eq(4) / 8 * 100); "% "
Print " y/h [1001 to 2000 Hz] "; Int(Eq(5) / 8 * 100); "% "
Print " u/j [2001 to 4000 Hz] "; Int(Eq(6) / 8 * 100); "% "
Print " i/k [4001 to 8000 Hz] "; Int(Eq(7) / 8 * 100); "% "
Print " o/l [8001 to 16000 Hz] "; Int(Eq(8) / 8 * 100); "% "
Print " p/; [16001 to 22000 Hz] "; Int(Eq(9) / 8 * 100); "% "
Print " + or - for changing frequency shift, * for reset back "
Print " 1, 2 for Stereo panner"; Int(sp * 100) / 100
Print "3, 4, 5, 6, 7 for Ping-Pong effect "; pong; Int(delaytime * 100) / 100; Int(feedback * 100) / 100
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 8 Then Eq(EqVolsTest) = 8
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
'---------------------------------------------------------------------
Sub NormalizeSignal (arr() As Single)
Dim maxVal As Single
Dim i As Long
' Najít maximální absolutní hodnotu Find maximal value in signal Find maximum absolute value Find maximum value in signal
maxVal = 0
For i = LBound(arr) To UBound(arr)
If Abs(arr(i)) > maxVal Then maxVal = Abs(arr(i))
Next
' Pokud je maximální hodnota větší než 1.0, normalizovat signál if maximal value is bigger than 1, normalize signal
If maxVal > 1 Then
For i = LBound(arr) To UBound(arr)
arr(i) = arr(i) / maxVal
Next
End If
End Sub
Sub LowPassFilterInPlace (signalArray() As Single, cutoffFreq As Single, sampleRate As Single)
Dim alpha As Single
Dim prevOutput As Single
alpha = 1.0 / (1.0 + (sampleRate / (2 * _Pi * cutoffFreq)))
prevOutput = signalArray(0)
For i = 1 To UBound(signalArray)
signalArray(i) = alpha * signalArray(i) + (1 - alpha) * prevOutput
prevOutput = signalArray(i)
Next
End Sub
Sub StereoAutoPanner (leftArray() As Single, rightArray() As Single, panSpeed As Single, sampleRate As Single)
Static t As Single ' Časová proměnná pro oscilaci
For i = 0 To UBound(leftArray)
Dim pan As Single
pan = 0.5 * (1 + Sin(t * 2 * _Pi * panSpeed / sampleRate)) ' Sinusová vlna (0 až 1) Sine wave (0 to 1)
' Změna hlasitosti kanálů podle pan
Dim original As Single
original = (leftArray(i) + rightArray(i)) * 0.5 ' Mono mix pro efekt Mono mix for effect
leftArray(i) = original * (1 - pan)
rightArray(i) = original * pan
t = t + 1
Next
' Udržení času v rámci jednoho cyklu (optimalizace) Maintaining time within one cycle (optimization
If t > sampleRate / panSpeed Then t = 0
End Sub
Sub PingPongDelay (leftArray() As Single, rightArray() As Single, delayTime As Single, feedback As Single, sampleRate As Single)
Static delayIndex As Long
' Kontrola platnosti vstupních parametrů Checking the validity of input parameters
If delayTime <= 0 Or feedback <= 0 Or sampleRate <= 0 Then
Exit Sub ' Pokud jsou parametry neplatné, efekt se nevykoná If the parameters are invalid, the effect will not be executed
End If
' Výpočet velikosti zpoždění v počtu vzorků Calculating the size of the delay in the number of samples
Dim delaySamples As Long
delaySamples = Int(delayTime * sampleRate)
' Kontrola a přizpůsobení velikosti bufferů Checking and adjusting buffer sizes
If UBound(delayBufferL) < delaySamples Then
ReDim _Preserve delayBufferL(0 To delaySamples)
ReDim _Preserve delayBufferR(0 To delaySamples)
End If
' Zpracování zvukových dat Audio data processing
For i = 0 To UBound(leftArray)
Dim dryL As Single, dryR As Single
Dim wetL As Single, wetR As Single
' Původní signál (suchý zvuk) Original signal (dry sound)
dryL = leftArray(i)
dryR = rightArray(i)
' Načtení ozvěny z bufferu Read echo from buffer
wetL = delayBufferL(delayIndex)
wetR = delayBufferR(delayIndex)
' Kombinace suchého a efektového signálu Combination of dry and effect signal
leftArray(i) = dryL + wetR * 0.5
rightArray(i) = dryR + wetL * 0.5
' Aktualizace bufferů Buffer updates
delayBufferL(delayIndex) = dryL + wetR * feedback
delayBufferR(delayIndex) = dryR + wetL * feedback
' Posun indexu Index shift
delayIndex = (delayIndex + 1) Mod delaySamples
Next
End Sub
Posts: 310
Threads: 51
Joined: May 2022
Reputation:
35
Among other things, I worked on removing the clicks. I succeeded. Three times and each time differently. Source codes as they are: First version - uses Hanning window. But there is audible sound floating, which is of course an undesirable effect, but I'm putting it here anyway. It's simply the first development branch. In the source code, find: factor = 0.85 - 0.15 * Cos(2 * 3.14159265359 * i / (N - 1)) and here, by adjusting the ratio (rewriting the numbers 0.85 and 0.15), adjust the strength of the Hanning window. Too small a window means less sound floating and more audible pops, if they occur, but on the other hand, with the opposite ratio, the sound will float without pops. Here it's a difficult compromise. So I continued on, to the second source code: It's the same thing, but with the addition of smooth frequency filtering:
In the transition zones between bands (e.g. between 64 and 65 Hz, 125 and 126 Hz, etc.), a linear interpolation is used to calculate the gain, which makes the sudden changes that caused the clicks appear. Then there's RMS normalization with exponential smoothing:
After the IFFT, the RMS value of the original (unprocessed) block and the processed block is calculated. The new normalization factor is smoothed using the previous value (smoothing factor set to 0.8) to make the sudden changes in volume appear.
This version has the problem that it can still cause clicks at really extreme values, and above all, that when using only the bass band, the higher frequency band is also heard. Then I found out what was not clear to me (there is much more):
In order to really filter without popping, the Overlap-Add method was added. This solution uses a block transformation with overlap (usually 50% overlap, i.e. for a block of 2048 samples, each block is shifted by 1024 samples). After processing each block, the resulting (inverse FFT) block is added to the synthesis buffer. The first 1024 samples are then sent from this buffer and the rest are shifted to the beginning of the buffer. Next, the second half of the previous block is added to the input block (for further processing) and supplemented with new samples from the sound memory. This solution eliminated the floating sound even with a sharp Hannig window (50 by 50). Then, in the third version, the sound equalization had to be adjusted so that it does not equalize somewhere from 2Hz but from 40 Hz. The reason was that when this band was boosted to maximum and the other bands were turned to minimum, a sound at another higher frequency was also heard (necessary for remove the pops). Since this behavior was undesirable, I set the lowest frequency from 40 Hz and then added a filter that removes higher frequencies when boosting the bass band. All three versions are available here so that everyone can adjust it to their own liking.
Source code 1:
Code: (Select All)
'==============================================
' QB64PE Sound Equalizer with RMS Normalization & Exponential Smoothing
'==============================================
_Title "QB64PE Sound Equalizer with RMS Smoothing"
' Open the sound file (the file "b.mp3" must be available)
Zdroj = _SndOpen("b.mp3")
Dim Zvuk As _MEM
Dim A As Long
UU = 2047 ' We work with 2048 samples (indices 0 to 2047)
Dim Blok(UU) As Single ' Original left channel samples for RMS measurement
Dim BlokR(UU) As Single ' Original right channel samples (can also be used for measurement)
Dim RealPart(UU) As Single, ImagPart(UU) As Single ' FFT data – left channel
Dim RealPartR(UU) As Single, ImagPartR(UU) As Single ' FFT data – right channel
Dim Eq(9) As Single
Dim Shared N As Long
Dim VzorkovaciFrekvence As Single ' Audio sampling frequency
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)
' Correction factors (Fletcher-Munson) – boost or attenuate specific frequency bands
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' 2 to 64 Hz
Korekce(1) = 1.8 ' 65 to 125 Hz
Korekce(2) = 1.5 ' 126 to 250 Hz
Korekce(3) = 1.2 ' 251 to 500 Hz
Korekce(4) = 1.0 ' 501 to 1000 Hz
Korekce(5) = 0.8 ' 1001 to 2000 Hz
Korekce(6) = 0.7 ' 2001 to 4000 Hz
Korekce(7) = 0.6 ' 4001 to 8000 Hz
Korekce(8) = 0.5 ' 8001 to 16000 Hz
Korekce(9) = 0.4 ' 16001 to 22000 Hz
N = UU + 1 ' The FFT block has 2048 samples
Zvuk = _MemSound(Zdroj, 0)
VzorkovaciFrekvence = _SndRate
Screen _NewImage(800, 600, 32)
' Initialize equalizer values (default value = 2)
For FillEq = 0 To 9
Eq(FillEq) = 2
Next
' Global variable for the smoothed normalization factor
Dim prevScaleFactor As Single
prevScaleFactor = 1
'==============================================
' Main processing loop
Do Until A >= Zvuk.SIZE
' Reset the visualization array
For EqBand = 0 To 9
VisualEq(EqBand) = 0
Next EqBand
' Load a block of samples
For i = 0 To N - 1
If A >= Zvuk.SIZE Then Exit For
Dim LevaStopa As Single, PravaStopa As Single
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single)
' Save the original signal for later RMS normalization
Blok(i) = LevaStopa
BlokR(i) = PravaStopa
' Prepare data for FFT – set the imaginary part to 0
RealPart(i) = LevaStopa
RealPartR(i) = PravaStopa
ImagPart(i) = 0
ImagPartR(i) = 0
A = A + 8 ' 8 bytes = 2*4 (left and right channel)
Next i
'-------------------------------
' 1. Apply the Hanning window to the time-domain block
' (reduces leakage and improves continuity)
For i = 0 To N - 1
factor = 0.75 - 0.25 * Cos(2 * 3.14159265359 * i / (N - 1)) 'check ratio 0.75 / 0.25 (total must be 1) for setup clicking / sound swimming
RealPart(i) = RealPart(i) * factor
RealPartR(i) = RealPartR(i) * factor
Next i
'-------------------------------
' 2. Perform FFT on both channels (convert signal to the frequency domain)
Call FFT(RealPart(), ImagPart(), N)
Call FFT(RealPartR(), ImagPartR(), N)
' 3. Frequency filtering with smooth transitions between bands
For k = 0 To N - 1
Frekvence = k * VzorkovaciFrekvence / N
Dim Vol As Single, t As Single
' Determine the gain for the current frequency band using linear interpolation
' in the transition zones between bands
If Frekvence < 2 Or Frekvence > 22000 Then
Vol = 1
ElseIf Frekvence < 64 Then
Vol = Eq(0) * Korekce(0)
ElseIf Frekvence < 65 Then
t = (Frekvence - 64) / 1
Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1))
ElseIf Frekvence < 125 Then
Vol = Eq(1) * Korekce(1)
ElseIf Frekvence < 126 Then
t = (Frekvence - 125) / 1
Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2))
ElseIf Frekvence < 250 Then
Vol = Eq(2) * Korekce(2)
ElseIf Frekvence < 251 Then
t = (Frekvence - 250) / 1
Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3))
ElseIf Frekvence < 500 Then
Vol = Eq(3) * Korekce(3)
ElseIf Frekvence < 501 Then
t = (Frekvence - 500) / 1
Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4))
ElseIf Frekvence < 1000 Then
Vol = Eq(4) * Korekce(4)
ElseIf Frekvence < 1001 Then
t = (Frekvence - 1000) / 1
Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5))
ElseIf Frekvence < 2000 Then
Vol = Eq(5) * Korekce(5)
ElseIf Frekvence < 2001 Then
t = (Frekvence - 2000) / 1
Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6))
ElseIf Frekvence < 4000 Then
Vol = Eq(6) * Korekce(6)
ElseIf Frekvence < 4001 Then
t = (Frekvence - 4000) / 1
Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7))
ElseIf Frekvence < 8000 Then
Vol = Eq(7) * Korekce(7)
ElseIf Frekvence < 8001 Then
t = (Frekvence - 8000) / 1
Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8))
ElseIf Frekvence < 16000 Then
Vol = Eq(8) * Korekce(8)
ElseIf Frekvence < 16001 Then
t = (Frekvence - 16000) / 1
Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9))
Else
Vol = Eq(9) * Korekce(9)
End If
' Update visualization – accumulate the amplitude for each frequency band
Select Case Frekvence
Case 2 To 64: VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Vol
Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol
Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol
Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol
Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol
Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol
Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol
Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol
Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol
Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol
End Select
' Apply the calculated gain to the frequency components of both channels
RealPart(k) = RealPart(k) * Vol
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
' 4. Inverse FFT – reconstruct the signal in the time domain
Call IFFT(RealPart(), ImagPart(), N)
Call IFFT(RealPartR(), ImagPartR(), N)
' 5. RMS normalization with exponential smoothing
' Compute the RMS of the original (unprocessed) block and the processed block,
' then calculate a new scaling factor that is smoothed with the previous factor.
Dim origRMS As Single, newRMS As Single
origRMS = 0: newRMS = 0
For i = 0 To N - 1
origRMS = origRMS + (Blok(i) * Blok(i))
newRMS = newRMS + (RealPart(i) * RealPart(i))
Next i
origRMS = Sqr(origRMS / N)
newRMS = Sqr(newRMS / N)
Dim newScale As Single
If newRMS > 0 Then
newScale = origRMS / newRMS
Else
newScale = 1
End If
Dim smoothing As Single
smoothing = 0.3 ' Sets the smoothness of changes (closer to 1 means slower changes)
Dim scaleFactor As Single
scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale
prevScaleFactor = scaleFactor
For i = 0 To N - 1
RealPart(i) = RealPart(i) * scaleFactor
RealPartR(i) = RealPartR(i) * scaleFactor
Next i
' 6. Playback of the processed block (limit the amplitude to avoid clipping)
For i = 0 To N - 1
If RealPart(i) > 0.95 Then RealPart(i) = 0.95
If RealPart(i) < -0.95 Then RealPart(i) = -0.95
If RealPartR(i) > 0.95 Then RealPartR(i) = 0.95
If RealPartR(i) < -0.95 Then RealPartR(i) = -0.95
_SndRaw RealPart(i), RealPartR(i)
Next i
' 7. Equalizer visualization – draw bars based on the amplitude of each frequency band
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / N
BarHeight = VisualEq(EqBand) * 400
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next EqBand
' 8. Keyboard control for adjusting the equalizer settings
Do Until _SndRawLen < 0.05
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + 0.1
Case "a": Eq(0) = Eq(0) - 0.1
Case "w": Eq(1) = Eq(1) + 0.1
Case "s": Eq(1) = Eq(1) - 0.1
Case "e": Eq(2) = Eq(2) + 0.1
Case "d": Eq(2) = Eq(2) - 0.1
Case "r": Eq(3) = Eq(3) + 0.1
Case "f": Eq(3) = Eq(3) - 0.1
Case "t": Eq(4) = Eq(4) + 0.1
Case "g": Eq(4) = Eq(4) - 0.1
Case "y": Eq(5) = Eq(5) + 0.1
Case "h": Eq(5) = Eq(5) - 0.1
Case "u": Eq(6) = Eq(6) + 0.1
Case "j": Eq(6) = Eq(6) - 0.1
Case "i": Eq(7) = Eq(7) + 0.1
Case "k": Eq(7) = Eq(7) - 0.1
Case "o": Eq(8) = Eq(8) + 0.1
Case "l": Eq(8) = Eq(8) - 0.1
Case "p": Eq(9) = Eq(9) + 0.1
Case ";": Eq(9) = Eq(9) - 0.1
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2-64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65-125 Hz] "; Int((Eq(1) - 2) * 100); "% "
Print " e/d [126-250 Hz] "; Int((Eq(2) - 2) * 100); "% "
Print " r/f [251-500 Hz] "; Int((Eq(3) - 2) * 100); "% "
Print " t/g [501-1000 Hz] "; Int((Eq(4) - 2) * 100); "% "
Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 2) * 100); "% "
Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 2) * 100); "% "
Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 2) * 100); "% "
Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 2) * 100); "% "
Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 2) * 100); "% "
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
Loop
_MemFree Zvuk
End
'==============================================
' FFT subroutine (classical implementation)
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
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
'==============================================
' IFFT subroutine (inverse FFT)
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Invert the signs of the imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Call FFT (this performs the inverse transformation)
Call FFT(RealPart(), ImagPart(), N)
' Normalize and restore 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
Version 2 - Better, but not best
Code: (Select All)
'==============================================
' QB64PE Sound Equalizer with RMS Normalization, Exponential Smoothing, and Overlap-Add
'==============================================
_Title "QB64PE Sound Equalizer with Overlap-Add"
' Open the sound file (the file "b.mp3" must be available)
Zdroj = _SndOpen("b.mp3")
Dim Zvuk As _MEM
Zvuk = _MemSound(Zdroj, 0)
' Define constants for Overlap-Add
Const blockSize = 2048 ' FFT block size
Const hopSize = blockSize / 2 ' Hop size (50% overlap)
Dim A As Long ' Position in the sound memory (in bytes)
' Arrays for input block (for overlap-add processing)
Dim InL(blockSize - 1) As Single ' Left channel input block
Dim InR(blockSize - 1) As Single ' Right channel input block
' Synthesis (overlap-add) buffers for output
Dim synthesisL(blockSize - 1) As Single ' Synthesis buffer for left channel
Dim synthesisR(blockSize - 1) As Single ' Synthesis buffer for right channel
' FFT processing arrays (blockSize = 2048)
Dim RealPart(blockSize - 1) As Single, ImagPart(blockSize - 1) As Single ' Left channel FFT data
Dim RealPartR(blockSize - 1) As Single, ImagPartR(blockSize - 1) As Single ' Right channel FFT data
' Equalizer settings (10 bands)
Dim Eq(9) As Single
For FillEq = 0 To 9
Eq(FillEq) = 2
Next
' Get audio sampling rate
Dim VzorkovaciFrekvence As Single
VzorkovaciFrekvence = _SndRate
' Visualization arrays and colors
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)
' Correction factors (Fletcher-Munson) for each frequency band
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' 2 to 64 Hz
Korekce(1) = 1.8 ' 65 to 125 Hz
Korekce(2) = 1.5 ' 126 to 250 Hz
Korekce(3) = 1.2 ' 251 to 500 Hz
Korekce(4) = 1.0 ' 501 to 1000 Hz
Korekce(5) = 0.8 ' 1001 to 2000 Hz
Korekce(6) = 0.7 ' 2001 to 4000 Hz
Korekce(7) = 0.6 ' 4001 to 8000 Hz
Korekce(8) = 0.5 ' 8001 to 16000 Hz
Korekce(9) = 0.4 ' 16001 to 22000 Hz
Screen _NewImage(800, 600, 32)
' Global variable for smoothed normalization factor (exponential smoothing)
Dim prevScaleFactor As Single
prevScaleFactor = 1
'===================================================
' Initialization: read the first full input block from the sound memory
For i = 0 To blockSize - 1
If A >= Zvuk.SIZE Then Exit For
Dim LevaStopa As Single, PravaStopa As Single
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single)
InL(i) = LevaStopa
InR(i) = PravaStopa
A = A + 8 ' 8 bytes = 2*4 (left and right channel)
Next i
' Initialize the synthesis buffers to 0
For i = 0 To blockSize - 1
synthesisL(i) = 0
synthesisR(i) = 0
Next i
'===================================================
' Main processing loop with Overlap-Add
Do While A < Zvuk.SIZE
' Reset the visualization accumulation array for each block
For EqBand = 0 To 9
VisualEq(EqBand) = 0
Next EqBand
' ------------------------------
' Step 1: Prepare the processing block.
' For each iteration, the input block consists of the previous block's second half (overlap)
' and new samples read from the sound memory.
' ------------------------------
' (The current input block is already in arrays InL() and InR())
' Copy the input block into the FFT processing arrays
For i = 0 To blockSize - 1
RealPart(i) = InL(i)
RealPartR(i) = InR(i)
ImagPart(i) = 0
ImagPartR(i) = 0
Next i
' ------------------------------
' Step 2: Apply a Hanning window to the time-domain block.
' This reduces spectral leakage and improves block continuity.
' (Note: here the window has been modified; you can adjust the parameters.)
' ------------------------------
For i = 0 To blockSize - 1
factor = 0.5 - 0.5 * Cos(2 * 3.14159265359 * i / (blockSize - 1))
RealPart(i) = RealPart(i) * factor
RealPartR(i) = RealPartR(i) * factor
Next i
' ------------------------------
' Step 3: Perform FFT on both channels (convert time-domain signal to frequency domain).
' ------------------------------
Call FFT(RealPart(), ImagPart(), blockSize)
Call FFT(RealPartR(), ImagPartR(), blockSize)
' ------------------------------
' Step 4: Frequency-domain processing (equalizer filtering).
' Here, we calculate a gain (Vol) for each frequency bin using linear interpolation
' between adjacent bands for smooth transitions.
' ------------------------------
For k = 0 To blockSize - 1
Frekvence = k * VzorkovaciFrekvence / blockSize
Dim Vol As Single, t As Single
If Frekvence < 2 Or Frekvence > 22000 Then
Vol = 1
ElseIf Frekvence < 64 Then
Vol = Eq(0) * Korekce(0)
ElseIf Frekvence < 65 Then
t = (Frekvence - 64) / 1
Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1))
ElseIf Frekvence < 125 Then
Vol = Eq(1) * Korekce(1)
ElseIf Frekvence < 126 Then
t = (Frekvence - 125) / 1
Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2))
ElseIf Frekvence < 250 Then
Vol = Eq(2) * Korekce(2)
ElseIf Frekvence < 251 Then
t = (Frekvence - 250) / 1
Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3))
ElseIf Frekvence < 500 Then
Vol = Eq(3) * Korekce(3)
ElseIf Frekvence < 501 Then
t = (Frekvence - 500) / 1
Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4))
ElseIf Frekvence < 1000 Then
Vol = Eq(4) * Korekce(4)
ElseIf Frekvence < 1001 Then
t = (Frekvence - 1000) / 1
Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5))
ElseIf Frekvence < 2000 Then
Vol = Eq(5) * Korekce(5)
ElseIf Frekvence < 2001 Then
t = (Frekvence - 2000) / 1
Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6))
ElseIf Frekvence < 4000 Then
Vol = Eq(6) * Korekce(6)
ElseIf Frekvence < 4001 Then
t = (Frekvence - 4000) / 1
Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7))
ElseIf Frekvence < 8000 Then
Vol = Eq(7) * Korekce(7)
ElseIf Frekvence < 8001 Then
t = (Frekvence - 8000) / 1
Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8))
ElseIf Frekvence < 16000 Then
Vol = Eq(8) * Korekce(8)
ElseIf Frekvence < 16001 Then
t = (Frekvence - 16000) / 1
Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9))
Else
Vol = Eq(9) * Korekce(9)
End If
' Accumulate amplitude per frequency band for visualization
Select Case Frekvence
Case 2 To 64: VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Vol
Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol
Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol
Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol
Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol
Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol
Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol
Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol
Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol
Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol
End Select
' Apply the calculated gain to both channels' frequency components
RealPart(k) = RealPart(k) * Vol
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
' ------------------------------
' Step 5: Perform the inverse FFT to reconstruct the time-domain signal.
' ------------------------------
Call IFFT(RealPart(), ImagPart(), blockSize)
Call IFFT(RealPartR(), ImagPartR(), blockSize)
' ------------------------------
' Step 6: RMS normalization with exponential smoothing.
' Here we compare the RMS of the input block (InL) with the processed block (RealPart)
' and adjust the gain smoothly.
' ------------------------------
Dim origRMS As Single, newRMS As Single
origRMS = 0: newRMS = 0
For i = 0 To blockSize - 1
origRMS = origRMS + (InL(i) * InL(i)) ' Reference RMS from input block
newRMS = newRMS + (RealPart(i) * RealPart(i))
Next i
origRMS = Sqr(origRMS / blockSize)
newRMS = Sqr(newRMS / blockSize)
Dim newScale As Single
If newRMS > 0 Then
newScale = origRMS / newRMS
Else
newScale = 1
End If
Dim smoothing As Single
smoothing = 0.3 ' Smoothing factor (closer to 1 means slower changes)
Dim scaleFactor As Single
scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale
prevScaleFactor = scaleFactor
For i = 0 To blockSize - 1
RealPart(i) = RealPart(i) * scaleFactor
RealPartR(i) = RealPartR(i) * scaleFactor
Next i
' ------------------------------
' Step 7: Overlap-Add synthesis.
' Add the processed block into the synthesis buffers.
' ------------------------------
For i = 0 To blockSize - 1
synthesisL(i) = synthesisL(i) + RealPart(i)
synthesisR(i) = synthesisR(i) + RealPartR(i)
Next i
' Output the first hopSize samples from the synthesis buffers.
For i = 0 To hopSize - 1
Dim outL As Single, outR As Single
outL = synthesisL(i)
outR = synthesisR(i)
' Limit amplitude to avoid clipping
If outL > 0.95 Then outL = 0.95
If outL < -0.95 Then outL = -0.95
If outR > 0.95 Then outR = 0.95
If outR < -0.95 Then outR = -0.95
_SndRaw outL, outR
Next i
' Shift the synthesis buffers: remove the first hopSize samples and shift the remaining samples to the beginning.
For i = 0 To blockSize - hopSize - 1
synthesisL(i) = synthesisL(i + hopSize)
synthesisR(i) = synthesisR(i + hopSize)
Next i
For i = blockSize - hopSize To blockSize - 1
synthesisL(i) = 0
synthesisR(i) = 0
Next i
' ------------------------------
' Step 8: Prepare the next input block.
' Shift the second half of the current input block into the first half,
' then fill the remainder with new samples from the sound memory.
' ------------------------------
For i = 0 To hopSize - 1
InL(i) = InL(i + hopSize)
InR(i) = InR(i + hopSize)
Next i
For i = hopSize To blockSize - 1
If A >= Zvuk.SIZE Then
InL(i) = 0
InR(i) = 0
Else
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single)
InL(i) = LevaStopa
InR(i) = PravaStopa
A = A + 8
End If
Next i
' ------------------------------
' Step 9: Visualization and keyboard control.
' The accumulated visualization data (VisualEq) is scaled and drawn as bars.
' The user can adjust equalizer settings via the keyboard.
' ------------------------------
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / blockSize
BarHeight = VisualEq(EqBand) * 400
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next EqBand
Do Until _SndRawLen < 0.05
Dim i As String
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + 0.1
Case "a": Eq(0) = Eq(0) - 0.1
Case "w": Eq(1) = Eq(1) + 0.1
Case "s": Eq(1) = Eq(1) - 0.1
Case "e": Eq(2) = Eq(2) + 0.1
Case "d": Eq(2) = Eq(2) - 0.1
Case "r": Eq(3) = Eq(3) + 0.1
Case "f": Eq(3) = Eq(3) - 0.1
Case "t": Eq(4) = Eq(4) + 0.1
Case "g": Eq(4) = Eq(4) - 0.1
Case "y": Eq(5) = Eq(5) + 0.1
Case "h": Eq(5) = Eq(5) - 0.1
Case "u": Eq(6) = Eq(6) + 0.1
Case "j": Eq(6) = Eq(6) - 0.1
Case "i": Eq(7) = Eq(7) + 0.1
Case "k": Eq(7) = Eq(7) - 0.1
Case "o": Eq(8) = Eq(8) + 0.1
Case "l": Eq(8) = Eq(8) - 0.1
Case "p": Eq(9) = Eq(9) + 0.1
Case ";": Eq(9) = Eq(9) - 0.1
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2-64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65-125 Hz] "; Int((Eq(1) - 2) * 100); "% "
Print " e/d [126-250 Hz] "; Int((Eq(2) - 2) * 100); "% "
Print " r/f [251-500 Hz] "; Int((Eq(3) - 2) * 100); "% "
Print " t/g [501-1000 Hz] "; Int((Eq(4) - 2) * 100); "% "
Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 2) * 100); "% "
Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 2) * 100); "% "
Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 2) * 100); "% "
Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 2) * 100); "% "
Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 2) * 100); "% "
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
Loop
_MemFree Zvuk
End
'==============================================
' FFT subroutine (classical implementation)
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
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
'==============================================
' IFFT subroutine (inverse FFT)
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Invert the signs of the imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Call FFT (this performs the inverse transformation)
Call FFT(RealPart(), ImagPart(), N)
' Normalize and restore 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
Version three - best. No clicking!
Code: (Select All)
'==============================================
' QB64PE Sound Equalizer with RMS Normalization, Exponential Smoothing, and Overlap-Add
'==============================================
_Title "QB64PE Sound Equalizer with Overlap-Add"
' Open the sound file (the file "b.mp3" must be available)
Zdroj = _SndOpen("b.mp3")
Dim Zvuk As _MEM
Zvuk = _MemSound(Zdroj, 0)
' Define constants for Overlap-Add
Const blockSize = 4096 ' FFT block size
Const hopSize = blockSize / 2 ' Hop size (50% overlap)
Dim A As Long ' Position in the sound memory (in bytes)
' Arrays for input block (for overlap-add processing)
Dim InL(blockSize - 1) As Single ' Left channel input block
Dim InR(blockSize - 1) As Single ' Right channel input block
' Synthesis (overlap-add) buffers for output
Dim synthesisL(blockSize - 1) As Single ' Synthesis buffer for left channel
Dim synthesisR(blockSize - 1) As Single ' Synthesis buffer for right channel
' FFT processing arrays (blockSize = 2048)
Dim RealPart(blockSize - 1) As Single, ImagPart(blockSize - 1) As Single ' Left channel FFT data
Dim RealPartR(blockSize - 1) As Single, ImagPartR(blockSize - 1) As Single ' Right channel FFT data
' Equalizer settings (10 bands)
Dim Eq(9) As Single
For FillEq = 0 To 9
Eq(FillEq) = 3
Next
' Get audio sampling rate
Dim VzorkovaciFrekvence As Single
VzorkovaciFrekvence = _SndRate
' Visualization arrays and colors
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)
' Correction factors (Fletcher-Munson) for each frequency band
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' 2 to 64 Hz
Korekce(1) = 1.8 ' 65 to 125 Hz
Korekce(2) = 1.5 ' 126 to 250 Hz
Korekce(3) = 1.2 ' 251 to 500 Hz
Korekce(4) = 1.0 ' 501 to 1000 Hz
Korekce(5) = 0.8 ' 1001 to 2000 Hz
Korekce(6) = 0.7 ' 2001 to 4000 Hz
Korekce(7) = 0.6 ' 4001 to 8000 Hz
Korekce(8) = 0.5 ' 8001 to 16000 Hz
Korekce(9) = 0.4 ' 16001 to 22000 Hz
Screen _NewImage(800, 600, 32)
' Global variable for smoothed normalization factor (exponential smoothing)
Dim prevScaleFactor As Single
prevScaleFactor = 1
'===================================================
' Initialization: read the first full input block from the sound memory
For i = 0 To blockSize - 1
If A >= Zvuk.SIZE Then Exit For
Dim LevaStopa As Single, PravaStopa As Single
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single)
InL(i) = LevaStopa
InR(i) = PravaStopa
A = A + 8 ' 8 bytes = 2*4 (left and right channel)
Next i
' Initialize the synthesis buffers to 0
For i = 0 To blockSize - 1
synthesisL(i) = 0
synthesisR(i) = 0
Next i
'===================================================
' Main processing loop with Overlap-Add
Do While A < Zvuk.SIZE
' Reset the visualization accumulation array for each block
For EqBand = 0 To 9
VisualEq(EqBand) = 0
Next EqBand
' ------------------------------
' Step 1: Prepare the processing block.
' For each iteration, the input block consists of the previous block's second half (overlap)
' and new samples read from the sound memory.
' ------------------------------
' (The current input block is already in arrays InL() and InR())
' Copy the input block into the FFT processing arrays
For i = 0 To blockSize - 1
RealPart(i) = InL(i)
RealPartR(i) = InR(i)
ImagPart(i) = 0
ImagPartR(i) = 0
Next i
' ------------------------------
' Step 2: Apply a Hanning window to the time-domain block.
' This reduces spectral leakage and improves block continuity.
' (Note: here the window has been modified; you can adjust the parameters.)
' ------------------------------
For i = 0 To blockSize - 1
factor = 0.5 - 0.5 * Cos(2 * 3.14159265359 * i / (blockSize - 1))
RealPart(i) = RealPart(i) * factor
RealPartR(i) = RealPartR(i) * factor
Next i
' ------------------------------
' Step 3: Perform FFT on both channels (convert time-domain signal to frequency domain).
' ------------------------------
Call FFT(RealPart(), ImagPart(), blockSize)
Call FFT(RealPartR(), ImagPartR(), blockSize)
' ------------------------------
' Step 4: Frequency-domain processing (equalizer filtering).
' Here, we calculate a gain (Vol) for each frequency bin using linear interpolation
' between adjacent bands for smooth transitions.
' ------------------------------
For k = 0 To blockSize - 1
Frekvence = k * VzorkovaciFrekvence / blockSize
Dim Vol As Single, t As Single
' Instead of starting the first band at 2 Hz, we now define it to cover frequencies below 40 Hz.
' This implements a low-pass filter for the bass boost.
If Frekvence < 40 Then
Vol = Eq(0) * Korekce(0)
ElseIf Frekvence < 41 Then
' Interpolate between the bass band (up to 40 Hz) and the second band (starting at 41 Hz)
t = (Frekvence - 40) / 1
Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1))
ElseIf Frekvence < 125 Then
Vol = Eq(1) * Korekce(1)
ElseIf Frekvence < 126 Then
t = (Frekvence - 125) / 1
Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2))
ElseIf Frekvence < 250 Then
Vol = Eq(2) * Korekce(2)
ElseIf Frekvence < 251 Then
t = (Frekvence - 250) / 1
Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3))
ElseIf Frekvence < 500 Then
Vol = Eq(3) * Korekce(3)
ElseIf Frekvence < 501 Then
t = (Frekvence - 500) / 1
Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4))
ElseIf Frekvence < 1000 Then
Vol = Eq(4) * Korekce(4)
ElseIf Frekvence < 1001 Then
t = (Frekvence - 1000) / 1
Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5))
ElseIf Frekvence < 2000 Then
Vol = Eq(5) * Korekce(5)
ElseIf Frekvence < 2001 Then
t = (Frekvence - 2000) / 1
Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6))
ElseIf Frekvence < 4000 Then
Vol = Eq(6) * Korekce(6)
ElseIf Frekvence < 4001 Then
t = (Frekvence - 4000) / 1
Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7))
ElseIf Frekvence < 8000 Then
Vol = Eq(7) * Korekce(7)
ElseIf Frekvence < 8001 Then
t = (Frekvence - 8000) / 1
Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8))
ElseIf Frekvence < 16000 Then
Vol = Eq(8) * Korekce(8)
ElseIf Frekvence < 16001 Then
t = (Frekvence - 16000) / 1
Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9))
Else
Vol = Eq(9) * Korekce(9)
End If
' Update visualization and apply the gain to the FFT data for both channels:
Select Case Frekvence
' Case 40 To 64: VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Vol ' Visualization for the bass band
Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol
Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol
Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol
Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol
Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol
Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol
Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol
Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol
Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol
End Select
RealPart(k) = RealPart(k) * Vol
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
' ------------------------------
' Step 5: Perform the inverse FFT to reconstruct the time-domain signal.
' ------------------------------
Call IFFT(RealPart(), ImagPart(), blockSize)
Call IFFT(RealPartR(), ImagPartR(), blockSize)
' ------------------------------
' Step 6: RMS normalization with exponential smoothing.
' Here we compare the RMS of the input block (InL) with the processed block (RealPart)
' and adjust the gain smoothly.
' ------------------------------
Dim origRMS As Single, newRMS As Single
origRMS = 0: newRMS = 0
For i = 0 To blockSize - 1
origRMS = origRMS + (InL(i) * InL(i)) ' Reference RMS from input block
newRMS = newRMS + (RealPart(i) * RealPart(i))
Next i
origRMS = Sqr(origRMS / blockSize)
newRMS = Sqr(newRMS / blockSize)
Dim newScale As Single
If newRMS > 0 Then
newScale = origRMS / newRMS
Else
newScale = 1
End If
Dim smoothing As Single
smoothing = 0.3 ' Smoothing factor (closer to 1 means slower changes)
Dim scaleFactor As Single
scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale
prevScaleFactor = scaleFactor
For i = 0 To blockSize - 1
RealPart(i) = RealPart(i) * scaleFactor
RealPartR(i) = RealPartR(i) * scaleFactor
Next i
' ------------------------------
' Step 7: Overlap-Add synthesis.
' Add the processed block into the synthesis buffers.
' ------------------------------
For i = 0 To blockSize - 1
synthesisL(i) = synthesisL(i) + RealPart(i)
synthesisR(i) = synthesisR(i) + RealPartR(i)
Next i
' Output the first hopSize samples from the synthesis buffers.
For i = 0 To hopSize - 1
Dim outL As Single, outR As Single
outL = synthesisL(i)
outR = synthesisR(i)
' Limit amplitude to avoid clipping
If outL > 0.95 Then outL = 0.95
If outL < -0.95 Then outL = -0.95
If outR > 0.95 Then outR = 0.95
If outR < -0.95 Then outR = -0.95
_SndRaw outL, outR
Next i
' Shift the synthesis buffers: remove the first hopSize samples and shift the remaining samples to the beginning.
For i = 0 To blockSize - hopSize - 1
synthesisL(i) = synthesisL(i + hopSize)
synthesisR(i) = synthesisR(i + hopSize)
Next i
For i = blockSize - hopSize To blockSize - 1
synthesisL(i) = 0
synthesisR(i) = 0
Next i
' ------------------------------
' Step 8: Prepare the next input block.
' Shift the second half of the current input block into the first half,
' then fill the remainder with new samples from the sound memory.
' ------------------------------
For i = 0 To hopSize - 1
InL(i) = InL(i + hopSize)
InR(i) = InR(i + hopSize)
Next i
For i = hopSize To blockSize - 1
If A >= Zvuk.SIZE Then
InL(i) = 0
InR(i) = 0
Else
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single)
InL(i) = LevaStopa
InR(i) = PravaStopa
A = A + 8
End If
Next i
' ------------------------------
' Step 9: Visualization and keyboard control.
' The accumulated visualization data (VisualEq) is scaled and drawn as bars.
' The user can adjust equalizer settings via the keyboard.
' ------------------------------
Cls
For EqBand = 1 To 9
VisualEq(EqBand) = VisualEq(EqBand) / blockSize
BarHeight = VisualEq(EqBand) * 400
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next EqBand
Do Until _SndRawLen < 0.05
Dim i As String
i$ = InKey$
Select Case LCase$(i$)
' Case "q": Eq(0) = Eq(0) + 0.1
' Case "a": Eq(0) = Eq(0) - 0.1
Case "w": Eq(1) = Eq(1) + 0.1
Case "s": Eq(1) = Eq(1) - 0.1
Case "e": Eq(2) = Eq(2) + 0.1
Case "d": Eq(2) = Eq(2) - 0.1
Case "r": Eq(3) = Eq(3) + 0.1
Case "f": Eq(3) = Eq(3) - 0.1
Case "t": Eq(4) = Eq(4) + 0.1
Case "g": Eq(4) = Eq(4) - 0.1
Case "y": Eq(5) = Eq(5) + 0.1
Case "h": Eq(5) = Eq(5) - 0.1
Case "u": Eq(6) = Eq(6) + 0.1
Case "j": Eq(6) = Eq(6) - 0.1
Case "i": Eq(7) = Eq(7) + 0.1
Case "k": Eq(7) = Eq(7) - 0.1
Case "o": Eq(8) = Eq(8) + 0.1
Case "l": Eq(8) = Eq(8) - 0.1
Case "p": Eq(9) = Eq(9) + 0.1
Case ";": Eq(9) = Eq(9) - 0.1
End Select
Locate 4
Print " Use keys for equalize:"
Print
' Print " q/a [2-64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65-125 Hz] "; Int((Eq(1) - 3) * 100); "% "
Print " e/d [126-250 Hz] "; Int((Eq(2) - 3) * 100); "% "
Print " r/f [251-500 Hz] "; Int((Eq(3) - 3) * 100); "% "
Print " t/g [501-1000 Hz] "; Int((Eq(4) - 3) * 100); "% "
Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 3) * 100); "% "
Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 3) * 100); "% "
Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 3) * 100); "% "
Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 3) * 100); "% "
Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 3) * 100); "% "
_Display
For EqVolsTest = 1 To 9
If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
Loop
_MemFree Zvuk
End
'==============================================
' FFT subroutine (classical implementation)
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
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
'==============================================
' IFFT subroutine (inverse FFT)
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Invert the signs of the imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Call FFT (this performs the inverse transformation)
Call FFT(RealPart(), ImagPart(), N)
' Normalize and restore 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: 2,461
Threads: 249
Joined: Apr 2022
Reputation:
125
Three sound examples of sound examples.
+2
Pete
|
