Functional sound equalization live!
#20
So. The rework of the Bass EQ for Phoenix 3.5.0 from the QB64 2.02 version was done much faster than I expected.

I have a few remarks to make about this work. This program uses subsampling, as I wrote in the post earlier. Finally, since my computer samples 192000 samples per second (which is absolutely perfect), it would take far more calculations than at a sample rate of 44100. So the program has to subsample the source MEM arrays to get as close to 44100 mathematically as possible, but also my the sample rate of 192000 must be divisible by this number without a remainder. If a decimal number were to come out, the sound would slow down.
So (in my case) the audio has a sample rate of 48000 Hz after going through subsampling instead of 192000 Hz. This ratio is given by the ratio variable.

Attention! When playing with the _SNDRAW command, this command naturally expects to receive 192000 samples per second. So, if you feed it a 48000Hz subsampled signal, you get nonsense. Therefore, it is necessary to play each supplied sample 4 times with the SNDRAW command (because 192,000 / 48,000 = ratio and that is the number 4). This will upscale the signal to the same sampling rate as SNDRATE and program play as expected.


I'll add another description from the previous post to keep it together.

The equalization itself is further implemented by choosing the mix ratio between this triangular signal and the original signal. These are added up and the result is then replayed. Basically, I had it in front of me in the past when I was creating WAVSAVE, but it didn't even occur to me at the time.

Before actually trying this program, I will first warn you about 4 things.
1) I tested the program only in a 32-bit IDE
2) I do not guarantee the correctness of this procedure, although it returns a fairly decent signal at deep frequencies
3) Turn down your speakers before trying, seriously loud production this time can destroy them.
4) Place correct music file name on row 3 in source code before compiling.

Program control is described in the program:

It's fully open, so you can even listen to the triangle signal itself and change the mixing level of the original signal. An equalizer should be made in a similar way, when the individual frequency curves will be mixed together with the original curve.

If someone comes up with a better solution, let them know.

Signal mixing with keys < and >
triangle signal volume (default ist 100%) can be set with keys + and -
frequency setting with keys q,w or Q,W


Code: (Select All)
$NoPrefix
_Title "Give me more BASS!"
s$ = "e.mp3" 'PLECE HERE CORRECT MUSIC FILE NAME!
s = SndOpen(s$)
Dim As MEM LS, RS, L, R, O 'arrays with default original MP3 values
Dim As Integer L1, R1, L2, R2, NL, NR 'L1, R1 - integers contains original signal values from MEMSOUND arrays, L2, R2 - the same as L1 and R1 but shifted right by KROK value, so if is created 100 Hz signal,
'                                                                        so L2 and R2 are shifted by 441 records in MEMSOUND array to right, NL, NR - for mixing both - new and original signal to new signal
'LS = MemSound(s, 1)
'RS = MemSound(s, 2)

O = _MemSound(s, 0)
BackCompatible O, L, R
_MemFree O

'-------------------- downsampling block begin -----------------------
Proposal = 44100 'my proposal for minimal soundrate - but this is not dividible by my SndRate 192 Khz
Do Until _SndRate Mod Proposal = 0
    Proposal = Proposal + 2 '       why + 2: sound output is WAV 16 bit, 16 bit = 2 bytes, INTEGER has lenght 2 bytes and INTEGER is used in WAV data block for saving sound information (just in 16 bit WAV)
Loop
Ratio = _SndRate \ Proposal 'downsampling to 48000 Hz, my sndrate 192000 is dividible by 48000, not by 44100 (SaveSound16S is also upgraded, but it is still for saving without _SndNew)

LS = _MemNew(L.SIZE \ Ratio)
RS = _MemNew(R.SIZE \ Ratio)

Done& = 0
Do Until Done& >= L.SIZE - Ratio * 4
    L1 = _MemGet(L, L.OFFSET + Done&, Integer)
    _MemPut LS, LS.OFFSET + i&, L1

    R1 = _MemGet(R, R.OFFSET + Done&, Integer)
    _MemPut RS, RS.OFFSET + i&, R1

    i& = i& + 2
    Done& = Done& + Ratio * 2
Loop
'-------------------- downsampling block end -----------------------

_MemFree L
_MemFree R
L1 = 0: R1 = 0


'ensure that the LS and RS fields are divisible by the KROK value
Dim As Offset MaxKrok, stp, krok 'varibles for reading MEMSOUND array
Dim As _Float PropocetL, PropocetR ' variables for calculating TRIANGLE signal
krok = 220 'Default is program set to creating 100 Hz (Bass) signal


MaxKrok = LS.SIZE 'maximal steps value for MEM functions

Screen NewImage(1200, 768, 256) 'graphis screen for visualising output signal

Do Until MaxKrok Mod krok * 2 = 0 'this loop ensures that when reading the field MEMSOUND to create a new signal, the field will not overflow and Memory out of range not occur.
    MaxKrok = MaxKrok - 1
Loop
'Default settings
mix = .25 'Original signal MIX level to output signal (is not volume level)
Volume = 1 'Created Signal (Created Signal) volume level

Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int((1 - mix) * 100); "%"; "           "
Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); "  "
Locate 2, 1: Print "Use the < and > keys to set the ratio between the original and generated signal, Q and W for freq. change, + and - for generated signal volume level."
Do Until stp >= MaxKrok - krok * 4 'read MEMSOUND array in full range
    MemGet LS, LS.OFFSET + stp, L1 'read left original signal
    MemGet RS, RS.OFFSET + stp, R1 'read right original signal

    MemGet LS, LS.OFFSET + stp + krok * 2, L2 'read left original signal shifted to right by krok's value
    MemGet RS, RS.OFFSET + stp + krok * 2, R2 'read right original signal shifted to right by krok's value

    stp = stp + krok * 2 '* 2 - values in MEMSOUND array are INTEGERS, 2 Bytes long

    PropocetL = (L2 - L1) / ConvertOffset(krok) 'calculation of the size of the increase or decrease of the signal to create a triangular signal [LEFT]
    PropocetR = (R2 - R1) / ConvertOffset(krok) 'calculation of the size of the increase or decrease of the signal to create a triangular signal [RIGHT]

    PrL = PropocetL
    PrR = PropocetR
    NL = L1 'reset this value (NL) to start value before create new triangle signal for left channel
    NR = R1 'reset this value (NR) to start value before create new triangle signal for right channel

    es = 0
    If _SndRate < 48000 Then snr = 44100 Else snr = 48000
    Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok

    Locked = 0 'for the possibility of changing the frequency during playback
    Do Until es = krok 'it only reads the slice of the memsound field in which the new signal is formed
        'keyborad program setup
        k$ = InKey$
        Select Case k$
            Case ",", "<": mix = mix + .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int(bmix * 100); "%"; "           "
            Case ".", ">": mix = mix - .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"; " Created Signal:"; Int(bmix * 100); "%"; "           "
            Case "+": Volume = Volume + .1
                If Volume > 2 Then Volume = 2
                Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); "  " '            Volume - is created signal volume level
            Case "-": Volume = Volume - .1
                If Volume < 0 Then Volume = 0
                Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); "  "
            Case "Q", "q"
                If Locked = 0 Then
                    Locked = 1
                    krok = krok + 10
                    If krok > 550 Then krok = 550
                    MaxKrok = LS.SIZE
                    Do Until MaxKrok Mod krok * 2 = 0
                        MaxKrok = MaxKrok - 1
                    Loop
                    If _SndRate < 48000 Then snr = 44100 Else snr = 48000
                    Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok / 2 'we working with downsamples source
                    Exit Do
                End If
            Case "W", "w"
                If Locked = 0 Then
                    Locked = 1
                    krok = krok - 10
                    If krok < 1 Then krok = 1
                    MaxKrok = LS.SIZE
                    Do Until MaxKrok Mod krok * 2 = 0
                        MaxKrok = MaxKrok - 1
                    Loop
                    If _SndRate < 48000 Then snr = 44100 Else snr = 48000
                    Locate 1, 60: Print "Frequency curve: [Hz] "; snr / krok / 2
                    Exit Do
                End If
        End Select


        If mix < 0 Then mix = 0
        If mix > 1 Then mix = 1
        bmix = 1 - mix

        posuvX = posuvX + 1 'variable for shift curve on the screen, just for graphic, not for own sound function
        If posuvX = Width Then posuvX = 1
        Line (posuvX, 40)-(posuvX, Height), 0, BF

        MemGet LS, LS.OFFSET + (stp - krok * 2) + es * 2, L1 'krok and es varibles must be multiplied by two, because MEMGET reads INTEGER values.
        MemGet RS, RS.OFFSET + (stp - krok * 2) + es * 2, R1



        SL = L1 * mix / 32768 + (NL / 32768 * bmix * Volume) 'the same as for R1 but for left channel.
        sR = R1 * mix / 32768 + (NR / 32768 * bmix * Volume) 'R1 is original signal, mix is R1 percentage level in new signal, NR is created signal, bmix is percentage level for NR and volume is NR volume level.

        For UpSampling = 1 To Ratio
            SndRaw SL, sR
        Next

        NL = NL + PrL 'signal calculation - fall or rise - formation of a triangular waveform  [LEFT]
        NR = NR + PrR 'signal calculation - fall or rise - formation of a triangular waveform [RIGHT]
        es = es + 1


        Line (posuvX, (Height / 2 - SL * 100))-(posuvX, (Height / 2 + SL * 100)), , BF 'draw output signal to screen

        Do Until SndRawLen < 0.1 'wait until all music samples are playing
        Loop
    Loop
Loop
_SndClose s
_MemFree LS
_MemFree RS
End

Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
            'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
            _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function

Sub BackCompatible (Snd As _MEM, Left As _MEM, Right As _MEM)
    If Snd.SIZE = 0 Then
        Print "Original sample data array is empty."
        Exit Sub
    End If
    Dim SndChannels As Long, ChannelLenght As _Offset
    Select Case Snd.TYPE
        Case 260 ' 32-bit floating point
            ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 132 ' 32-bit integer
            ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 4 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 8 Then
                SndChannels = 2
            End If
        Case 130: ' 16-bit integer
            ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 2 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 4 Then
                SndChannels = 2
            End If
        Case 1153: ' 8-bit unsigned integer
            ChannelLenght = Snd.SIZE 'return size in INTEGERS
            If Snd.ELEMENTSIZE = 1 Then
                SndChannels = 1
            ElseIf Snd.ELEMENTSIZE = 2 Then
                SndChannels = 2
            End If
    End Select


    Left = _MemNew(ChannelLenght)
    Right = _MemNew(ChannelLenght)
    Dim As Integer LI, RI
    Dim As Long Oi
    Dim i As _Offset

    Do Until i = Snd.SIZE - Snd.ELEMENTSIZE 'Read Phoenix MEMSOUND and convert it as back-compatible as QB64 2.02 MEMSOUND's output.
        Select Case SndChannels
            Case 1
                Select Case Snd.TYPE
                    Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single) ' 32-bit floating point
                    Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648 ' 32-bit integer
                    Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768 ' 16-bit integer
                    Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
                End Select
            Case 2
                Select Case Snd.TYPE
                    Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single): sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Single) ' 32-bit floating point
                    Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Long) / 2147483648 ' 32-bit integer
                    Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Integer) / 32768 ' 16-bit integer
                    Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128: sampR = (_MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
                End Select
        End Select
        If SndChannels Mod 2 = 0 Then
            LI = sampL * 32767
            RI = sampR * 32767
            _MemPut Left, Left.OFFSET + Oi, LI
            _MemPut Right, Right.OFFSET + Oi, RI
        Else
            LI = sampL * 32767
            _MemPut Left, Left.OFFSET + Oi, LI
            _MemPut Right, Right.OFFSET + Oi, LI
        End If
        i = i + Snd.ELEMENTSIZE
        Oi = Oi + 2
    Loop
End Sub


Reply


Messages In This Thread
Functional sound equalization live! - by Petr - 08-03-2022, 03:56 PM
RE: Functional sound equalization live! - by Jack - 08-03-2022, 04:12 PM
RE: Functional sound equalization live! - by Petr - 08-03-2022, 04:19 PM
RE: Functional sound equalization live! - by Petr - 08-03-2022, 04:23 PM
RE: Functional sound equalization live! - by Petr - 08-06-2022, 01:23 PM
RE: Functional sound equalization live! - by Pete - 08-06-2022, 03:27 PM
RE: Functional sound equalization live! - by Pete - 08-06-2022, 05:37 PM
RE: Functional sound equalization live! - by Petr - 02-18-2023, 03:38 PM
RE: Functional sound equalization live! - by Petr - 02-18-2023, 08:05 PM
RE: Functional sound equalization live! - by Petr - 02-18-2023, 09:52 PM
RE: Functional sound equalization live! - by Petr - 02-19-2023, 12:40 PM
RE: Functional sound equalization live! - by Petr - 02-19-2023, 03:39 PM
RE: Functional sound equalization live! - by Petr - 02-22-2023, 07:25 PM
RE: Functional sound equalization live! - by Petr - 03-03-2023, 11:53 PM
RE: Functional sound equalization live! - by Petr - 03-04-2023, 04:21 PM
RE: Functional sound equalization live! - by Petr - 03-24-2023, 08:35 PM



Users browsing this thread: 9 Guest(s)