Posts: 233
Threads: 40
Joined: May 2022
Reputation:
27
Small upgrade
Thanks to @DSMan195276 opening my eyes, I've used SndOpenRaw mixing (makes it a lot easier) and added the option I've already posted here separately, so now you can control the treble with N and M + the same as in previous). I'm assuming it's 22KHz because it's made up of two adjacent samples at a refresh rate of 44100Hz (here this program downsamples it to 44100 if the real _SndRate is higher). The middle frequencies will still be a challenge, I will also play with the bass curve, because there is no need to strictly calculate the entire course if the direction of the oscillation does not change during the period (that is, if we take, for example, 400 samples and the whole time they have falling or rising trend, just copy them, but if not, i think its best try deforming the wave just minimal to next period)
Code: (Select All) $NoPrefix
_Title "Give me more BASS!"
s$ = "Alkehol - dejvice.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, L3, R3, L4, R4, 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
SOR1 = _SndOpenRaw
SOR2 = _SndOpenRaw
SOR3 = _SndOpenRaw
'-------------------- 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. New: Use N,n and M,m for high freq."
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
Case "N", "n": HighVol = HighVol + .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol > 5 Then HighVol = 5
Case "M", "m": HighVol = HighVol - .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol < 0 Then HighVol = 0
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, 70)-(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
'get 22 Khz frequency in this 4 rows (for sample rate 44100!, this samples are all downsampled to 44100!)
MemGet LS, LS.OFFSET + (stp + es * 2), L3
MemGet RS, RS.OFFSET + (stp + es * 2), R3
MemGet LS, LS.OFFSET + (stp + es * 2) - 2, L4
MemGet RS, RS.OFFSET + (stp + es * 2) - 2, R4
'--------------------------------------------
hL = (L3 / -32768 + L4 / 32768) * HighVol
hR = (R3 / -32768 + R4 / 32768) * HighVol
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.
sL2 = NL / 32768 * bmix * Volume
sR2 = NR / 32768 * bmix * Volume
For UpSampling = 1 To Ratio
SndRaw SL, sR, SOR1 ' original audio stream
SndRaw sL2, sR2, SOR2 ' triangle created stream
SndRaw hL, hR, SOR3
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(SOR1) < 0.1 'wait until all music samples are playing
_Limit 10
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
Posts: 233
Threads: 40
Joined: May 2022
Reputation:
27
03-04-2023, 04:21 PM
(This post was last modified: 03-04-2023, 04:22 PM by Petr.)
I've decided to release this (quite fiddly to use) source code before making any more deep and I mean major changes to it, in case anyone ever wants to try their hand at making their own equalizer. So - compared to the previous version, I added a mix of medium frequencies. It is literally a mix, in the next source code I will divide this field. In the future, I will keep the bass frequencies in the form of a triangle only up to 150 Hz. I get the mixed mids, as I would call it, by taking the original (original) signal and the triangle signal (used for the bass) and subtracting these signals from each other. This gives me a band of signals without the lowest notes. From this signal, in the continuation of this fun work, I will get the 300Hz, 500Hz and so on signals in the same way as I get the bass signal (in next release).
To try it out (don't expect dolby digital 7.2 + enhanced stereo, of course), I recommend the longest possible song - about 5 minutes long. The < and > buttons work only if the main sound stream is amplified by the V button. The Q and W buttons change the frequency of the generated triangle signal, I recommend setting it to 150 Hz. Use the + and - buttons to change the volume of the bass signal. Use the N and M keys to add/remove treble, A, C to add/remove MIX center frequencies, C, V to change the volume of the original sound. In this version, the visualization is done like this:
Black curve - course of original sound (changes according to volume)
White curve - triangle signal used for bass
Yellow-green curve - height signal
Purple curve - mix of medium frequencies
But I remind you again that what I'm doing here is just my personal guess as to how it could be - I'm literally just guessing here.
Anyway, I have to say I'm excited. I'm impressed with the amount of work you've been to do with the QB64PE with the sound. It's something absolutely amazing and I really enjoy it a lot. SndRaw that works as it should is literally my dream come true. Qb64PE has huge potential.
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, L3, R3, L4, R4, 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
SOR1 = _SndOpenRaw 'original audio stream
SOR2 = _SndOpenRaw 'triangle (bass) stream
SOR3 = _SndOpenRaw 'high stream
SOR4 = _SndOpenRaw 'middle stream
'-------------------- 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 dividible by the KROK value
Dim As Offset MaxKrok, stp, krok, oldkrok 'varibles for reading MEMSOUND array
Dim As _Float PropocetL, PropocetR ' variables for calculating TRIANGLE signal
krok = 250 '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. New: Use N,n and M,m for high freq, C,c and V,v for volume original stream A,a; S,s for middle."
Bmix = 1 '100 percent volume for original stream
mix = .3 '30 percrent volume for triangle (bass) audio stream
HighVol = .2 'percent for 22 KHz stream
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$
If k$ = "*" Then ' work not as expected
If UP < 0 Then k$ = "W" Else k$ = "Q"
UP = Sin(t)
t = t + .01
End If
Select Case k$
Case ",", "<": mix = mix + .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"
Case ".", ">": mix = mix - .01: Locate 1: Print "Original Signal:"; Int(mix * 100); "%"
'Triangle signal volue control (bass)
Case "+": Volume = Volume + .1: Locate 1, 90: Print "Created Signal Volume Level:"; Int(Volume * 100); " " ' Volume - is created signal volume level
Case "-": Volume = Volume - .1: 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
Case "N", "n": HighVol = HighVol + .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol > 5 Then HighVol = 5
Case "M", "m": HighVol = HighVol - .1: Locate 4: Print "High:"; Str$(HighVol): If HighVol < 0 Then HighVol = 0
Case "C", "c": Bmix = Bmix + .1
Case "V", "v": Bmix = Bmix - .1
Case "A", "a": MidVol = MidVol + .1
Case "S", "s": MidVol = MidVol - .1
End Select
mix = MINMAX(mix, 0, 4)
Bmix = MINMAX(Bmix, 0, 4)
MidVol = MINMAX(MidVol, 0, 4)
Volume = MINMAX(Volume, 0, 5)
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, 70)-(posuvX, Height), 40, 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
'get 22 Khz frequency in this 4 rows (for sample rate 44100!, this samples are all downsampled to 44100!)
MemGet LS, LS.OFFSET + (stp + es * 2), L3
MemGet RS, RS.OFFSET + (stp + es * 2), R3 'normalni originalni hodnota zvuku brana z originalu pri vytvareni triangle signalu
MemGet LS, LS.OFFSET + (stp + es * 2) - 2, L4
MemGet RS, RS.OFFSET + (stp + es * 2) - 2, R4
'--------------------------------------------
'get middle frequency
MidL = (L3 / 32768 - NL / 32768) * MidVol
MidR = (R3 / 32768 - NR / 32768) * MidVol
MidL = MINMAX(MidL, -1, 1)
MidR = MINMAX(MidR, -1, 1)
'middle frequency: when creating a bass signal, a triangle is created - for example, every fifth value is taken from the MemSound field
'and this is calculated between them as a gradual increase or as a gradual decrease. I then call the middle frequency in this program
'the difference between the value that I calculate in the triangular signal of the bass signal and the value of the original signal.
'--------------------------------------------
hL = (L3 / -32768 + L4 / 32768) * HighVol
hR = (R3 / -32768 + R4 / 32768) * HighVol
SL = L1 * mix / 32768 * Bmix '+ (NL / 32768 * bmix * Volume) 'the same as for R1 but for left channel.
sR = R1 * mix / 32768 * Bmix '+ (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.
sL2 = NL / 32768 * Volume
sR2 = NR / 32768 * Volume
hL = MINMAX(hL, -1, 1)
hR = MINMAX(hR, -1, 1)
SL = MINMAX(SL, -1, 1)
sR = MINMAX(sR, -1, 1)
sL2 = MINMAX(sL2, -1, 1)
sR2 = MINMAX(sR2, -1, 1)
For UpSampling = 1 To Ratio
SndRaw SL, sR, SOR1 ' original audio stream
SndRaw sL2, sR2, SOR2 ' triangle created stream
SndRaw hL, hR, SOR3 ' high signal 22KHz
SndRaw MidL, MidR, SOR4 'middle
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)), 0, BF 'draw original audio stream output to screen
Line (posuvX, (Height / 2 - MidL * 100))-(posuvX, (Height / 2 + MidL * 100)), 5, BF 'draw middle audio stream output to screen
Line (posuvX, (Height / 2 - sL2 * 100))-(posuvX, (Height / 2 + sL2 * 100)), 30, BF 'draw triangle audio stream output to screen
Line (posuvX, (Height / 2 - hL * 100))-(posuvX, (Height / 2 + hL * 100)), 70, BF 'draw 22Khz audio stream output to screen
Do Until SndRawLen(SOR1) < 0.1 'wait until all music samples are playing
_Limit 30
Loop
Loop
Loop
_SndClose s
_MemFree LS
_MemFree RS
End
Function MINMAX (Value, MinVal, MaxVal)
MINMAX = Value
If Value > MaxVal Then MINMAX = MaxVal
If Value < MinVal Then MINMAX = MinVal
End Function
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
Posts: 233
Threads: 40
Joined: May 2022
Reputation:
27
03-24-2023, 08:35 PM
(This post was last modified: 03-24-2023, 08:36 PM by Petr.)
Here is the first change - some sound waves are counted as Sine. The principle remained the same. Control is now fully mouse-based. Wave rendering is now for each freqency range. The appearance and principle of creating some waves have changed since the last version. I definitely have a lot more modifications planned.
This version uses direntry.h, so you don't need to write the name of the audio file anymore, the program will play all the audio files in the current folder (QB64PE compatible) one by one. The bass frequency is very deep, it's more like a subwoofer band. Of course, an adjustment is needed. It is necessary to use resonance. Next time.
Enjoy it.
Code: (Select All) $NoPrefix
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
ReDim Dire(0) As String
ReDim File(0) As String
ReDim Music(0) As String
GetFileList _CWD$, Dire(), File()
FilterMusicFiles File(), Music()
Type Tahlo
typ As _Byte
Xpos As Integer
Ypos As Integer
MinVal As _Float
MaxVAL As _Float
Lenght As Integer
CurrVal As _Float
DVal As Integer
End Type
ReDim Shared Pull(0) As Tahlo
Type RG
position As Integer
SO As Long
Recs As Long
End Type
ReDim Shared RG(0) As RG
ReDim Shared RG_Helper(0) As Single
_Title "preEQ-Alpha test"
SOR1 = _SndOpenRaw 'original audio stream
SOR2 = _SndOpenRaw 'triangle (bass) stream (recomended 160 Hz)
SOR3 = _SndOpenRaw 'high stream (11 KHz)
SOR4 = _SndOpenRaw 'middle stream
SOR5 = _SndOpenRaw 'Bass middle 800 Hz
mix = .25 'Original signal MIX level to output signal (is not volume level)
Volume = .3 'Created Signal (Created Signal) volume level
Vol1K = .3
Bmix = .6 '100 percent volume for original stream
mix = .2 '30 percrent volume for triangle (bass) audio stream
HighVol = .2 'percent for 22 KHz stream
MidVol800 = .2
Screen NewImage(1200, 768, 256) 'graphis screen for visualising output signal
_ScreenHide
F1 = NewPull(30, 213, 0, 5, 1, 120, 0)
F2 = NewPull(300, 213, 0, 5, .2, 120, 0)
F3 = NewPull(550, 213, 0, 5, .3, 120, 0)
F4 = NewPull(800, 213, 0, 5, .3, 120, 0)
F5 = NewPull(1050, 213, 0, 5, .5, 120, 0)
F6 = NewPull(240, 583, -1, 1, 0, 720, 2)
InitPull F1
InitPull F2
InitPull F3
InitPull F4
InitPull F5
InitPull F6
Do Until SoundIndex = UBound(Music) + 1
n2:
s$ = Music(SoundIndex) 'this version plays all files in folder automaticaly - use direntry.h for it
s = SndOpen(s$)
ReDim As MEM LS, RS, LS800, RS800, L, R, O, f1KL, f1KR ' arrays with default original MP3 values
ReDim As Integer L1, R1, L2, R2, L3, R3, L4, R4, NL, NR, Mid800L, Mid800R, Mid800Lb, Mid800Rb '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)
If O.SIZE = 0 Then SoundIndex = SoundIndex + 1: GoTo n2
BackCompatible O, L, R
_MemFree O
OriginalStream = NewRG(0, 100)
SinusBass = NewRG(0, 100)
HighStream = NewRG(0, 100)
MiddleStream = NewRG(0, 100)
MiddleBass = NewRG(0, 100)
LSPK = NewRG(0, 700)
RSPK = NewRG(0, 700)
Proposal = 0
'-------------------- 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 And 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)
LS800 = _MemNew(L.SIZE \ Ratio)
RS800 = _MemNew(R.SIZE \ Ratio)
f1KL = _MemNew(L.SIZE \ Ratio)
f1KR = _MemNew(L.SIZE \ Ratio)
i& = 0
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
Make800 LS, RS, LS800, RS800, 8
' ensure that the LS and RS fields are dividible by the KROK value
Dim As Offset MaxKrok, stp, krok, oldkrok ' varibles for reading MEMSOUND array
Dim As _Float PropocetL, PropocetR ' variables for calculating TRIANGLE signal
krok = 400 ' Default is program set to creating 110 Hz (Bass) signal (44100 / 400)
MaxKrok = LS.SIZE ' maximal steps value for MEM functions
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
ScreenShow
stp = 0
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
If L1 > L2 Then NL = L1 Else NL = L2 ' bass signal L default value
If R2 > R2 Then NR = R1 Else NR = R2 ' bass signal R default value
es = 0
If _SndRate < 48000 Then snr = 44100 Else snr = 48000
Locked = 0
StartL = L1 / 32768 * _Pi(.5)
EndL = L2 / 32768 * _Pi(.5)
StartR = R1 / 32768 * _Pi(.5)
EndR = R2 / 32768 * _Pi(.5)
If EndL < StartL Then ssgn = -1 Else ssgn = 1
If EndR < StartR Then rsgn = -1 Else rsgn = 1
Okrok = ConvertOffset(krok)
ReDim As _Float NarustL, NarustR
'pro vypocet uhlu sinusovky calculate sinus angle step
NarustL = Abs(StartL - EndL) * ssgn / Okrok
NarustR = Abs(StartR - EndR) * rsgn / Okrok
SinL = StartL 'prvni hodnoty uhlu sinusovky
SinR = StartR
' -------------------
If stpUPDT Mod 5 = 0 Then
UpdateRG OriginalStream, SL
UpdateRG SinusBass, sl2
UpdateRG HighStream, hl
UpdateRG MiddleStream, midl
UpdateRG MiddleBass, NL800
End If
stpUPDT = stpUPDT + 1
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 "N", "n": GoTo nextsong
End Select
mix = MINMAX(mix, 0, 4)
Bmix = MINMAX(Bmix, 0, 4)
MidVol = MINMAX(MidVol, 0, 4)
Volume = MINMAX(Volume, 0, 5)
MidVol800 = MINMAX(MidVol800, 0, 5)
Vol1K = MINMAX(Vol1K, 0, 3)
MemGet f1KL, f1KL.OFFSET + stp + es * 2, f1kLs
MemGet f1KR, f1KR.OFFSET + stp + es * 2, f1kRs
MemGet LS800, LS800.OFFSET + stp + 2 + es * 2, Mid800L
MemGet RS800, RS800.OFFSET + stp + 2 + es * 2, Mid800R
MemGet LS, LS.OFFSET + (stp - krok * 2) + es * 2, L1
MemGet RS, RS.OFFSET + (stp - krok * 2) + es * 2, R1
'get 22 Khz frequency in this 4 rows (for sample rate 44100!, this samples are all downsampled to 44100!)
MemGet LS, LS.OFFSET + (stp + es * 2), L3
MemGet RS, RS.OFFSET + (stp + es * 2), R3
MemGet LS, LS.OFFSET + (stp + es * 2) - 2, L4
MemGet RS, RS.OFFSET + (stp + es * 2) - 2, R4
'--------------------------------------------
'get middle frequency 800 Hz
NL800 = Mid800L / 32768 * MidVol800
NR800 = Mid800R / 32768 * MidVol800
'Other middle
midl = (L3 / 32768 - (hl - midl800)) * MidVol
midR = (R3 / 32768 - (hr - MidR800)) * MidVol
s1KL = f1kLs / 32768 * Vol1K
s1KR = f1kRs / 32768 * Vol1K
midl = MINMAX(midl, -1, 1)
midR = MINMAX(midR, -1, 1)
s1KL = MINMAX(s1KL, -1, 1)
s1KR = MINMAX(s1KR, -1, 1)
'22KHz
hl = (L3 / -32768 + L4 / 32768) * HighVol
hr = (R3 / -32768 + R4 / 32768) * HighVol
'Original stream
SL = L3 * mix / 32768 * Bmix
sR = R3 * mix / 32768 * Bmix
'bass
sl2 = (Sin(SinL)) * Volume
sr2 = (Sin(SinR)) * Volume
hl = MINMAX(hl, -1, 1)
hr = MINMAX(hr, -1, 1)
SL = MINMAX(SL, -1, 1)
sR = MINMAX(sR, -1, 1)
sl2 = MINMAX(sl2, -1, 1)
sr2 = MINMAX(sr2, -1, 1)
NL800 = MINMAX(NL800, -1, 1)
NR800 = MINMAX(NR800, -1, 1)
For UpSampling = 1 To Ratio
SndRaw SL * LeftBalance, sR * RightBalance, SOR1 ' original audio stream
SndRaw sl2 * LeftBalance, sr2 * RightBalance, SOR2 ' triangle created stream
SndRaw hl * LeftBalance, hr * RightBalance, SOR3 ' high signal 22KHz
SndRaw midl * LeftBalance, midR * RightBalance, SOR4 'middle
SndRaw NL800 * LeftBalance, NR800 * RightBalance, SOR5 'MiddleBass800
Next
es = es + 1
'my loop counter
'bass sinus get up or down
SinL = SinL + NarustL
SinR = SinR + NarustR
'MiddleBass800Hz
SinL800 = SinL800 + NarustL800
SinR800 = SinR800 + NarustR800
Do Until SndRawLen(SOR1) < 0.1 'wait until all music samples are playing
_Limit 300
Loop
Loop
SinL = 0
SinR = 0
If stp Mod 1200 = 0 Then
UpdateRG OriginalStream, SL
UpdateRG SinusBass, sl2
UpdateRG HighStream, hl
UpdateRG MiddleStream, midl
UpdateRG MiddleBass, NL800
LSOut = SL + sl2 + hl + midl + NL800
RSOut = sR + sr2 + hr + midR + NR800
LSOut = MINMAX(LSOut, -1, 1)
RSOut = MINMAX(RSOut, -1, 1)
UpdateRG LSPK, LSOut
UpdateRG RSPK, RSOut
ShowRG 40, 150, OriginalStream, "Original"
ShowRG 310, 150, SinusBass, "Bass signal"
ShowRG 560, 150, HighStream, "High - 22 KHz"
ShowRG 810, 150, MiddleStream, "Middle signal"
ShowRG 1060, 150, MiddleBass, "Middle bass"
ShowRG 250, 350, LSPK, "Left Speaker Out"
ShowRG 250, 520, RSPK, "Right Speaker Out"
'Vol1K je ponekud plonkovy
Bmix = GetPull(F1)
Volume = GetPull(F2)
HighVol = GetPull(F3)
MidVol = GetPull(F4)
MidVol800 = GetPull(F5)
Balance = GetPull(F6)
LeftBalance = 1
RightBalance = 1
If Balance > 0 Then LeftBalance = -1 * Balance + LeftBalance
If Balance < 0 Then RightBalance = RightBalance + Balance
If SoundIndex < UBound(Music) - 1 Then _PrintString (50, 5), "Press N for next audio track: " + Music(SoundIndex + 1)
_PrintString (50, 25), "Now playing: " + Music(SoundIndex)
_PrintString (50, 45), "This track lenght:" + Str$(Int(LS.SIZE / 2 / Proposal)) + " [sec], track time:" + Str$(stp \ Proposal \ 2) + " [sec] "
_Display
End If
Loop
nextsong:
es = 0
MemFree LS
_MemFree RS
_MemFree LS800
_MemFree RS800
_MemFree f1KL
_MemFree f1KR
SndClose s
SoundIndex = SoundIndex + 1
Loop
_SndClose s
_MemFree LS
_MemFree RS
End
Function MINMAX (Value, MinVal, MaxVal)
MINMAX = Value
If Value > MaxVal Then MINMAX = MaxVal
If Value < MinVal Then MINMAX = MinVal
End Function
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, temp&&
ConvertOffset&& = temp&& '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 * 2 '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
Sub Make800 (LS As _MEM, RS As _MEM, LS800 As _MEM, RS800 As _MEM, StepMem)
Dim As Integer Mid800L, MID800R, MID800Lb, MID800Rb
Dim Stp As Long
Do Until Stp >= LS.SIZE - StepMem * 4
MemGet LS, LS.OFFSET + Stp, MID800Lb
MemGet RS, RS.OFFSET + Stp, MID800Rb
StL = MID800Lb / 32768 * _Pi(.5)
StR = MID800Rb / 32768 * _Pi(.5)
MemGet LS, LS.OFFSET + Stp + StepMem, Mid800L
MemGet RS, RS.OFFSET + Stp + StepMem, MID800R 'stredobasova frekvence SIN
If MID800Lb > Mid800L Then NL800 = MID800Lb Else NL800 = Mid800L 'middle bass signal default value Left channel
If MID800Rb > MID800R Then NR800 = MID800Rb Else NR800 = MID800R
EndL800 = Mid800L / 32768 * _Pi(.5)
EndR800 = MID800R / 32768 * _Pi(.5)
If EndL800 < StL Then ssgn800 = -1 Else ssgn800 = 1
If EndR800 < StR Then rsgn800 = -1 Else rsgn800 = 1
NarustL800 = Abs(StL - EndL800) * ssgn800 / (StepMem / 2) 'sinus 800 Hz step LEFT channel
NarustR800 = Abs(StR - EndR800) * rsgn800 / (StepMem / 2) ' RIGHT
sl = MID800Lb / 32768
sr = MID800Rb / 32768
For WriteAll = Stp To Stp + StepMem Step 2
NL800 = Sin(sl) * 32768
NR800 = Sin(sr) * 32768
_MemPut LS800, LS800.OFFSET + WriteAll, NL800 As INTEGER
_MemPut RS800, RS800.OFFSET + WriteAll, NR800 As INTEGER
sl = sl + NarustL800
sr = sr + NarustR800
Next
Stp = Stp + StepMem
Loop
End Sub
Function NewRG (value, records) 'create new graph handle, reserve place in RG_Helper, write to RG_Helper array first value and this value position in RG_Helper array
u = records
u2 = UBound(RG_Helper)
u3 = UBound(RG)
RG(u3).SO = u2
RG(u3).Recs = u
RG(u3).position = 1
NewRG = u3
RG_Helper(u2) = value
ReDim _Preserve RG_Helper(u2 + u + 1) As Single
ReDim _Preserve RG(u3 + 1) As RG
End Function
Sub UpdateRG (identity, value) ' update and shift values in RG_Helper array using RG array (identity is RG array index)
Id = identity
V = value
If RG(Id).position < RG(Id).Recs Then
RG(Id).position = RG(Id).position + 1
i2 = RG(Id).position
u = RG(Id).SO
RG_Helper(u + i2) = value
Exit Sub
Else
shift = RG(Id).SO
Do Until shift = RG(Id).SO + RG(Id).Recs
RG_Helper(shift) = RG_Helper(shift + 1)
shift = shift + 1
Loop
RG_Helper(RG(Id).SO + RG(Id).Recs) = value
End If
End Sub
Sub ShowRG (x, y, id, index$) ' Draw graph to screen
xx = x
s2 = RG(id).Recs
s = RG(id).SO
_PrintMode _KeepBackground
p = xx - 10 + s2 / 2 - _PrintWidth(index$) / 2 'printstring X
Line (xx - 20, y - 70)-(xx + 20 + s2, y + 50), 30, BF
Line (xx - 17, y - 67)-(xx + 17 + s2, y + 47), , B
C = _DefaultColor
Color 0
_PrintString (p, y - 64), index$
Color C
_PrintMode _FillBackground
Line (xx - 20, y - 70)-(xx + 20 + s2, y + 50), , B
Line (xx - 17, y - 47)-(xx + 17 + s2, y + 47), , B
ss = s
Do Until ss = s2 + s - 1
v = RG_Helper(ss)
v2 = RG_Helper(ss + 1)
GoTo notthis
If Abs(v) > 1 Then
Do Until Abs(v) <= 1
v = v / 2
Loop
End If
notthis:
xx = xx + 1
Line (xx, y + v * 15)-(xx + 1, y + v2 * 15), 0
ss = ss + 1
Loop
xx = 0
End Sub
Function NewPull (x, y, ValAtMin, ValAtMax, DefaultValue, PullLen, KindOfPull)
u = UBound(Pull)
Pull(u).Xpos = x
Pull(u).Ypos = y
Pull(u).MinVal = ValAtMin
Pull(u).MaxVAL = ValAtMax
Pull(u).Lenght = PullLen
Pull(u).typ = KindOfPull
Pull(u).CurrVal = DefaultValue 'designed for range 0 to 1 - value at start
NewPull = u
ReDim _Preserve Pull(u + 1) As Tahlo
End Function
Sub GetMouse (Mx, My, Lb, Rb, Mw)
While _MouseInput
Mw = Mw + _MouseWheel
Wend
Mx = _MouseX
My = _MouseY
Lb = _MouseButton(1)
Rb = _MouseButton(2)
End Sub
Function QDetect (x1, y1, x2, y2, Xd, Yd)
If x1 > x2 Then Swap x2, x1
If y1 > y2 Then Swap y2, y1
QDetect = 0
If Xd > x1 And Xd < x2 Then
If Yd > y1 And Yd < y2 Then
QDetect = -1
End If
End If
End Function
Function CircleDetect (X&, Y&, CX&, CY&, R&)
xy& = ((X& - CX&) ^ 2) + ((Y& - CY&) ^ 2) 'Pythagorean theorem
If R& ^ 2 >= xy& Then CircleDetect = -1 Else CircleDetect = 0
End Function
Sub InitPull (P)
GetMouse mx, my, lb, rb, mw
Static GrX, GrY
X = Pull(P).Xpos
Y = Pull(P).Ypos
XX = X + Pull(P).Lenght
YY = Y + Pull(P).Lenght
If lb = -1 Then
stat = QDetect(X, Y, XX, YY, mx, my)
End If
stat = 0
Dim As Integer GrX, GrY
Select Case Pull(P).typ
Case 0
Line (X - 10, Y - 10)-(XX + 10, Y + 10), 30, BF
Line (X - 7, Y - 7)-(XX + 7, Y + 7), , B
Line (X, Y)-(XX, Y), 31
Xp = X + Pull(P).Lenght * (Pull(P).CurrVal / Pull(P).MaxVAL)
If stat Then GrX = mx Else GrX = Int(Xp)
Line (X, Y)-(GrX, Y), 22
CircleFill GrX, Y, 6, 16
CircleFill GrX, Y, 5, 28
Pull(P).DVal = Xp
Case 1
Line (X - 10, Y - 10)-(X + 10, YY + 10), 30, BF
Line (X - 7, Y - 7)-(X + 7, YY + 7), , B
Line (X, Y)-(X, YY), 31
Yp = YY - Pull(P).Lenght * (Pull(P).CurrVal / Pull(P).MaxVAL)
If stat Then GrY = my Else GrY = Int(Yp)
Line (X, YY)-(X, GrY), 22
CircleFill X, GrY, 6, 16
CircleFill X, GrY, 5, 28
Pull(P).DVal = Yp
Case 2
Line (X - 10, Y - 10)-(XX + 10, Y + 10), 30, BF
Line (X - 7, Y - 7)-(XX + 7, Y + 7), , B
Line (X, Y)-(XX, Y), 31
Xp = X + Pull(P).Lenght / 2 + (Pull(P).Lenght / 2 * (Pull(P).CurrVal / Pull(P).MaxVAL))
If stat Then GrX = mx Else GrX = Int(Xp)
Line (X + Pull(P).Lenght / 2, Y)-(GrX, Y), 22
CircleFill GrX, Y, 6, 16
CircleFill GrX, Y, 5, 28
Pull(P).DVal = Xp
Case 3
Line (X - 10, Y - 10)-(X + 10, YY + 10), 30, BF
Line (X - 7, Y - 7)-(X + 7, YY + 7), , B
Line (X, Y)-(X, YY), 31
Yp = YY - Pull(P).Lenght / 2 - (Pull(P).Lenght / 2 * (Pull(P).CurrVal / Pull(P).MaxVAL))
If stat Then GrY = my Else GrY = Int(Yp)
Line (X, YY - Pull(P).Lenght / 2)-(X, GrY), 22
CircleFill X, GrY, 6, 16
CircleFill X, GrY, 5, 28
Pull(P).DVal = Yp
End Select
End Sub
Function GetPull (p)
GetMouse mx, my, lb, rb, mw
Select Case Pull(p).typ
Case 0
If QDetect(Pull(p).Xpos - 20, Pull(p).Ypos - 20, Pull(p).Xpos + 20 + Pull(p).Lenght, Pull(p).Ypos + 20, mx, my) Then
status = CircleDetect(mx, my, Pull(p).DVal, Pull(p).Ypos, 40)
If lb = -1 Then
If status Then
GetMouse mx, my, lb, rb, mw
Pull(p).CurrVal = (mx - Pull(p).Xpos) / Pull(p).Lenght * Pull(p).MaxVAL
If Pull(p).CurrVal > Pull(p).MaxVAL Then Pull(p).CurrVal = Pull(p).MaxVAL
If Pull(p).CurrVal < Pull(p).MinVal Then Pull(p).CurrVal = Pull(p).MinVal
InitPull p
End If
End If
End If
Case 2
'asi ok
If QDetect(Pull(p).Xpos - 20, Pull(p).Ypos - 20, Pull(p).Xpos + 20 + Pull(p).Lenght, Pull(p).Ypos + 20, mx, my) Then
status = CircleDetect(mx, my, Pull(p).DVal, Pull(p).Ypos, 40)
If lb = -1 Then
If status Then
GetMouse mx, my, lb, rb, mw
If mx > Pull(p).Xpos And mx < Pull(p).Xpos + Pull(p).Lenght / 2 Then
Pull(p).CurrVal = ((mx - Pull(p).Lenght / 2) - Pull(p).Xpos) / (Pull(p).Lenght / 2) * Pull(p).MinVal * -1
If Pull(p).CurrVal < Pull(p).MinVal Then Pull(p).CurrVal = Pull(p).MinVal
End If
If mx > Pull(p).Xpos + Pull(p).Lenght / 2 And mx < Pull(p).Lenght + Pull(p).Xpos Then
Pull(p).CurrVal = (mx - Pull(p).Xpos - (Pull(p).Lenght / 2)) / (Pull(p).Lenght / 2) * Pull(p).MaxVAL
If Pull(p).CurrVal > Pull(p).MaxVAL Then Pull(p).CurrVal = Pull(p).MaxVAL
End If
InitPull p
End If
End If
End If
Case 1
x = Pull(p).Xpos
Y = Pull(p).Ypos
XX = x + Pull(p).Lenght
YY = Y + Pull(p).Lenght
If QDetect(x - 20, Y - 20, x + 20, YY, mx, my) Then
status = CircleDetect(mx, my, Pull(p).Xpos, Pull(p).DVal, 40)
If lb = -1 Then
If status Then
GetMouse mx, my, lb, rb, mw
Pull(p).CurrVal = (YY - my) / Pull(p).Lenght * Pull(p).MaxVAL
If Pull(p).CurrVal > Pull(p).MaxVAL Then Pull(p).CurrVal = Pull(p).MaxVAL
If Pull(p).CurrVal < Pull(p).MinVal Then Pull(p).CurrVal = Pull(p).MinVal
InitPull p
End If
End If
End If
Case 3
If QDetect(Pull(p).Xpos - 20, Pull(p).Ypos - 20, Pull(p).Xpos + 20, Pull(p).Ypos + 20 + Pull(p).Lenght, mx, my) Then
status = CircleDetect(mx, my, Pull(p).Xpos, Pull(p).DVal, 40)
If lb = -1 Then
If status Then
GetMouse mx, my, lb, rb, mw
If my > Pull(p).Ypos + Pull(p).Lenght / 2 Then
Pull(p).CurrVal = ((my - Pull(p).Lenght / 2) - Pull(p).Ypos) / (Pull(p).Lenght / 2) * Pull(p).MinVal
If Pull(p).CurrVal < Pull(p).MinVal Then Pull(p).CurrVal = Pull(p).MinVal
End If
If my < Pull(p).Ypos + Pull(p).Lenght / 2 Then
Pull(p).CurrVal = ((Pull(p).Lenght / 2) - (my - Pull(p).Ypos)) / (Pull(p).Lenght / 2) * Pull(p).MaxVAL
If Pull(p).CurrVal > Pull(p).MaxVAL Then Pull(p).CurrVal = Pull(p).MinVal
End If
InitPull p
End If
End If
End If
End Select
GetPull = Pull(p).CurrVal
End Function
Sub ResetMouse
While _MouseInput
Wend
Do Until _MouseButton(1) = 0
While _MouseInput
Wend
Loop
End Sub
Sub CircleFill (CX As Long, CY As Long, R As Long, C As Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
Const IS_DIR = 1
Const IS_FILE = 2
Dim flags As Long, file_size As Long
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
If load_dir(SearchDirectory) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If flags And IS_DIR Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf flags And IS_FILE Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
End If
End If
Loop Until length = -1
close_dir
Else
End If
ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub
Sub FilterMusicFiles (AllFiles() As String, Music() As String)
For f = LBound(AllFiles) To UBound(AllFiles)
coma = InStrRev(AllFiles(f), ".") + 1
ext$ = Mid$(AllFiles(f), coma, 4)
If Len(ext$) < 4 Then ext$ = ext$ + Space$(4 - Len(ext$))
Select Case LCase$(ext$)
Case "mp3 ", "wav ", "flac", "s3m ", "xm ", "mod ", "it ", "ogg ", "rad ", "mid "
Music(i) = AllFiles(f)
i = i + 1
ReDim _Preserve Music(i) As String
End Select
Next f
End Sub
Program need direntry.h library.
direntry.h (Size: 1.15 KB / Downloads: 29)
|
