01-13-2025, 02:52 PM
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