Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Next small EQ step - EQ DONE in last example!
#5
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



Reply


Messages In This Thread
RE: Next small EQ step - by Petr - 03-31-2024, 10:39 AM
RE: Next small EQ step - by Petr - 04-07-2024, 09:07 AM
RE: Next small EQ step - by Petr - 04-07-2024, 06:35 PM
RE: Next small EQ step - by Petr - 01-06-2025, 05:19 PM



Users browsing this thread: 3 Guest(s)