http://www.purebasic.com
https://www.purebasic.fr/english/
Thank you, Netmaestro,netmaestro wrote:That's pretty much right in my wheelhouse, I'll put something together after I get back from work. Is Windows only OK? Crossplatform isn't a problem, I just need to know ahead of time if it's a concern or not.
Code: Select all
Procedure Draw(canvas,angle.f)
width = GadgetWidth(canvas)
height = GadgetHeight(canvas)
If StartDrawing(CanvasOutput(canvas))
Box(0,0,width,height,RGB($80,$80,$80))
For i = 0 To 720 Step 20
LineXY(width*0.5+Sin((i-360)/270)*(width*0.4),height*0.8-Cos((i-360)/270)*(height*0.4),
width*0.5+Sin((i-360)/270)*(width*0.45),height*0.8-Cos((i-360)/270)*(height*0.45))
Next
LineXY(width*0.5,height*0.8,width*0.5+Sin(angle/270)*(width*0.4),height*0.8-Cos(angle/270)*(height*0.4),RGB(0,0,0))
StopDrawing()
EndIf
EndProcedure
If OpenWindow(0, 0, 0, 800, 600, "Needle", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 50, 50, 200, 200)
TrackBarGadget(1,10,10,WindowWidth(0)-20,20,0,720) : SetGadgetState(1,360)
Draw(0,0)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget And EventGadget() = 1
Draw(0,GetGadgetState(1)-360)
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
)Code: Select all
/***************************************************************************
enginevumeter.cpp - description
-------------------
copyright : (C) 2002 by Tue and Ken Haste Andersen
email :
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
#ifdef __WINDOWS__
#pragma intrinsic(fabs)
#endif
#include "engine/enginevumeter.h"
#include "controlpotmeter.h"
#include "sampleutil.h"
EngineVuMeter::EngineVuMeter(const char * group) {
// The VUmeter widget is controlled via a controlpotmeter, which means
// that it should react on the setValue(int) signal.
m_ctrlVuMeter = new ControlPotmeter(ConfigKey(group, "VuMeter"), 0., 1.);
m_ctrlVuMeter->set(0);
// left channel VU meter
m_ctrlVuMeterL = new ControlPotmeter(ConfigKey(group, "VuMeterL"), 0., 1.);
m_ctrlVuMeterL->set(0);
// right channel VU meter
m_ctrlVuMeterR = new ControlPotmeter(ConfigKey(group, "VuMeterR"), 0., 1.);
m_ctrlVuMeterR->set(0);
// Initialize the calculation:
m_iSamplesCalculated = 0;
m_fRMSvolumeL = 0;
m_fRMSvolumeSumL = 0;
m_fRMSvolumeR = 0;
m_fRMSvolumeSumR = 0;
}
EngineVuMeter::~EngineVuMeter()
{
delete m_ctrlVuMeter;
delete m_ctrlVuMeterL;
delete m_ctrlVuMeterR;
}
void EngineVuMeter::process(const CSAMPLE * pIn, const CSAMPLE *, const int iBufferSize)
{
CSAMPLE fVolSumL, fVolSumR;
SampleUtil::sumAbsPerChannel(&fVolSumL, &fVolSumR, pIn, iBufferSize);
m_fRMSvolumeSumL += fVolSumL;
m_fRMSvolumeSumR += fVolSumR;
m_iSamplesCalculated += iBufferSize/2;
// Are we ready to update the VU meter?:
if (m_iSamplesCalculated > (44100/2/UPDATE_RATE) )
{
doSmooth(m_fRMSvolumeL, log10(m_fRMSvolumeSumL/(m_iSamplesCalculated*1000)+1));
doSmooth(m_fRMSvolumeR, log10(m_fRMSvolumeSumR/(m_iSamplesCalculated*1000)+1));
const double epsilon = .0001;
// Since VU meters are a rolling sum of audio, the no-op checks in
// ControlObject will not prevent us from causing tons of extra
// work. Because of this, we use an epsilon here to be gentle on the GUI
// and MIDI controllers.
if (fabs(m_fRMSvolumeL - m_ctrlVuMeterL->get()) > epsilon)
m_ctrlVuMeterL->set(m_fRMSvolumeL);
if (fabs(m_fRMSvolumeR - m_ctrlVuMeterR->get()) > epsilon)
m_ctrlVuMeterR->set(m_fRMSvolumeR);
double fRMSvolume = (m_fRMSvolumeL + m_fRMSvolumeR) / 2.0;
if (fabs(fRMSvolume - m_ctrlVuMeter->get()) > epsilon)
m_ctrlVuMeter->set(fRMSvolume);
// Reset calculation:
m_iSamplesCalculated = 0;
m_fRMSvolumeSumL = 0;
m_fRMSvolumeSumR = 0;
}
}
void EngineVuMeter::doSmooth(FLOAT_TYPE ¤tVolume, FLOAT_TYPE newVolume)
{
if (currentVolume > newVolume)
currentVolume -= DECAY_SMOOTHING * (currentVolume - newVolume);
else
currentVolume += ATTACK_SMOOTHING * (newVolume - currentVolume);
if (currentVolume < 0)
currentVolume=0;
if (currentVolume > 1.0)
currentVolume=1.0;
}Code: Select all
Structure Meter
canvas.i
startAngle.f
angles.f
angleStep.f
value.f
currValue.f
movement.f
EndStructure
Procedure CreateMeter(*m.Meter,x,y,width,height,startAngle.f, angles.f, angleStep.f, currentAngle.f, movement.f)
If *m = 0 : ProcedureReturn : EndIf
*m\canvas = CanvasGadget(#PB_Any,x,y,width,height)
*m\value = currentAngle
*m\currValue = currentAngle
*m\startAngle = startAngle
*m\angles = angles
*m\movement = movement
*m\angleStep = angleStep
EndProcedure
Procedure DrawMeter(*m.Meter)
If *m = 0 Or *m\canvas = 0 : ProcedureReturn : EndIf
width = GadgetWidth(*m\canvas)
height = GadgetHeight(*m\canvas)
If StartDrawing(CanvasOutput(*m\canvas))
Box(0,0,width,height,RGB($80,$80,$80))
i.f = *m\startAngle
angle.f = 0
Repeat
LineXY(width*0.5+Sin(Radian(i))*(width*0.4) ,height*0.8-Cos(Radian(i))*(height*0.4),
width*0.5+Sin(Radian(i))*(width*0.45),height*0.8-Cos(Radian(i))*(height*0.45))
i + *m\angleStep
angle + *m\angleStep
Until angle > *m\angles
LineXY(width*0.5,
height*0.8,
width*0.5+Sin(Radian(*m\currValue))*(width*0.4),
height*0.8-Cos(Radian(*m\currValue))*(height*0.4),
RGB(0,0,0))
StopDrawing()
EndIf
EndProcedure
Procedure SetMeterAngle(*m.Meter, currentAngle.f)
If *m = 0 : ProcedureReturn : EndIf
*m\value = currentAngle
EndProcedure
Procedure UpdateMeter(*m.Meter)
If *m = 0 : ProcedureReturn : EndIf
If *m\currValue < *m\value
*m\currValue + *m\movement
If *m\currValue > *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
ElseIf *m\currValue > *m\value
*m\currValue - *m\movement
If *m\currValue < *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
EndIf
EndProcedure
Define.Meter vu_left, vu_right, vu_down
If OpenWindow(0, 0, 0, 800, 600, "Needle", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateMeter(@vu_left,10,10,200,200,-80,160,10,0,5)
DrawMeter(@vu_left)
CreateMeter(@vu_right,220,10,200,200,-80,160,10,0,5)
DrawMeter(@vu_right)
CreateMeter(@vu_down,430,10,200,200,-90,180,5,90,0.5)
DrawMeter(@vu_down)
SetMeterAngle(@vu_down,-90)
track1 = TrackBarGadget(#PB_Any,10,220,200,20,0,160) : SetGadgetState(track1,80)
track2 = TrackBarGadget(#PB_Any,430,220,200,20,0,180) : SetGadgetState(track2,0)
AddWindowTimer(0,1,20)
AddWindowTimer(0,2,100)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case track1: SetMeterAngle(@vu_left,GetGadgetState(track1)-80)
Case track2: SetMeterAngle(@vu_down,GetGadgetState(track2)-90)
EndSelect
ElseIf Event = #PB_Event_Timer
Select EventTimer()
Case 1
UpdateMeter(@vu_left)
UpdateMeter(@vu_right)
UpdateMeter(@vu_down)
Case 2
SetMeterAngle(@vu_right,Random(10)*16-80)
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
Code: Select all
#N = 1024 ;NUMBER OF SAMPLES
#NM1 = #N - 1
#ND2 = #N >> 1
#M = 10
#WINDOW_WIDTH = 605
;#WINDOW_WIDTH = #N / 2 ;512
#WINDOW_HEIGHT = 605
#SAMPLE_RATE = 40000 ;44100 ;8000 ;LIMIT 4000 Hz AUDIO
#TRACE_COLOR = #White
#gadText1 = 1
Structure MYWAVEFORMATEX
wFormatTag.u ;UNSIGNED FOR COMPATIBILITY WITH MICROSOFT FLAG VALUES
nChannels.w
nSamplesPerSec.l
nAvgBytesPerSec.l
nBlockAlign.w
wBitsPerSample.w
cbSize.w
EndStructure
Global Dim rex.f(#N + 1)
Global Dim imx.f(#N + 1)
Global Dim OutPutArray.f(#N + 1)
Global FFTWnd
Global alto
Structure Meter
canvas.i
startAngle.f
angles.f
angleStep.f
value.f
currValue.f
movement.f
EndStructure
Procedure CreateMeter(*m.Meter,x,y,width,height,startAngle.f, angles.f, angleStep.f, currentAngle.f, movement.f)
If *m = 0 : ProcedureReturn : EndIf
*m\canvas = CanvasGadget(#PB_Any,x,y,width,height)
*m\value = currentAngle
*m\currValue = currentAngle
*m\startAngle = startAngle
*m\angles = angles
*m\movement = movement
*m\angleStep = angleStep
EndProcedure
Procedure DrawMeter(*m.Meter)
If *m = 0 Or *m\canvas = 0 : ProcedureReturn : EndIf
width = GadgetWidth(*m\canvas)
height = GadgetHeight(*m\canvas)
If StartDrawing(CanvasOutput(*m\canvas))
Box(0,0,width,height,RGB($80,$80,$80))
i.f = *m\startAngle*1.375
angle.f = 0
Repeat
LineXY(width*0.5+Sin(Radian(i))*(width*0.4) ,height*0.8-Cos(Radian(i))*(height*0.4),width*0.5+Sin(Radian(i))*(width*0.45),height*0.8-Cos(Radian(i))*(height*0.45))
i + Log10(*m\angleStep)*3.45
angle + *m\angleStep
Until angle > *m\angles*4
LineXY(width*0.5,height*0.8,width*0.5+Sin(Radian(*m\currValue))*(width*0.4),height*0.8-Cos(Radian(*m\currValue))*(height*0.4),RGB(0,0,0))
StopDrawing()
EndIf
EndProcedure
Procedure SetMeterAngle(*m.Meter, currentAngle.f)
If *m = 0 : ProcedureReturn : EndIf
*m\value = currentAngle
EndProcedure
Procedure UpdateMeter(*m.Meter)
If *m = 0 : ProcedureReturn : EndIf
If *m\currValue < *m\value
*m\currValue + *m\movement
If *m\currValue > *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
ElseIf *m\currValue > *m\value
*m\currValue - *m\movement
If *m\currValue < *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
EndIf
EndProcedure
Structure NoteRange
Note.i
FromPos.i
ToPos.i
EndStructure
Procedure.i ShowNote_Init()
Global Dim NoteRange.NoteRange(53)
For Note=0 To 53
Read.w FromPos.w
Read.w ToPos.w
NoteRange(Note)\FromPos=FromPos
NoteRange(Note)\ToPos=ToPos
NoteRange(Note)\Note=Note
Next
Global Dim g_RealNote.s(53)
For i = 0 To 42 + 12 - 1
Read.s sRealNote.s
g_RealNote(i)=sRealNote.s
Next
EndProcedure
Procedure.s ShowNote_Get(lValue)
ProcedureReturn g_RealNote.s(lValue)
EndProcedure
ShowNote_Init()
Structure SCOPE
channel.b
left.i
top.i
width.i
height.i
middleY.i
quarterY.i
EndStructure
Structure CONFIG
hWindow.i ; Window handle
size.i ; Wave buffer size
buffer.i ; Wave buffer pointer
output.i ; WindowOutput()
wave.i ; Address of waveform-audio input device
format.MYWAVEFORMATEX ; Capturing WaveFormatEx
lBuf.i ; Capturing Buffer size
nBuf.i ; Capturing Buffer number
nDev.i ; Capturing Device identifier
nBit.i ; Capturing Resolution (8/16)
nHertz.i ; Capturing Frequency (Hertz)
nChannel.i ; Capturing Channels number (Mono/Stereo)
LScope.SCOPE ; Waveform display
RScope.SCOPE ; Waveform display
EndStructure
Global Config.CONFIG
Global Dim inHdr.WAVEHDR(16)
Config\format\wFormatTag = #WAVE_FORMAT_PCM
Procedure Record_Start()
Config\format\nChannels=1
Config\format\wBitsPerSample = 16
Config\format\nSamplesPerSec = #SAMPLE_RATE
Config\nDev = 0 ; (default MS Sound Mapper device)
Config\lBuf = 1024
Config\nBuf = 8
Config\nBit = 1
Config\format\nBlockAlign = (Config\format\nChannels * Config\format\wBitsPerSample)/8
Config\format\nAvgBytesPerSec = Config\format\nSamplesPerSec * Config\format\nBlockAlign
If #MMSYSERR_NOERROR=waveInOpen_(@Config\wave, #WAVE_MAPPER+Config\nDev, @Config\format, Config\hWindow, #Null, #CALLBACK_WINDOW | #WAVE_FORMAT_DIRECT)
For i=0 To Config\nBuf-1
inHdr(i)\lpData=AllocateMemory(Config\lBuf)
inHdr(i)\dwBufferLength=Config\lBuf
waveInPrepareHeader_(Config\wave, inHdr(i), SizeOf(WAVEHDR))
waveInAddBuffer_(Config\wave, inHdr(i), SizeOf(WAVEHDR))
Next
If #MMSYSERR_NOERROR=waveInStart_(Config\wave)
SetTimer_(Config\hWindow, 0, 1, 0)
EndIf
EndIf
EndProcedure
Procedure Record_Read(hWaveIn.i, lpWaveHdr.i)
*hWave.WAVEHDR=lpWaveHdr
Config\buffer=*hWave\lpData
Config\size=*hWave\dwBytesRecorded
waveInAddBuffer_(hWaveIn, lpWaveHdr, SizeOf(WAVEHDR))
EndProcedure
Procedure record_FindNote(Value)
For Note = 0 To 53
If Value => NoteRange(Note)\FromPos And Value <= NoteRange(Note)\ToPos
ProcedureReturn note
EndIf
Next
EndProcedure
Procedure record_doFFT(*scope.SCOPE)
Define.d TR, TI, SR, SI, UR, UI
Define.i J, K, L, cnt, MaxValue
Define.w value
; // -------- Init some values for FFT analysing --------
;THESE ARE NOW CONSTANTS AS THEY DON'T CHANGE
;N = 1024 ; // Number of samples
;NM1 = #N - 1
;ND2 = #N >> 1 ; // Optmimized, instead N / 2
;M = 10 ; // If N.w = 1024 == 10 == Same as: Int(Log(N) / 0.69314718055994529)
J = #ND2
If Config\buffer = 0
MessageRequester("Error", "No buffer available.")
Goto shutdown
EndIf
; // -------- Clear and Fill array values for analysing in just only one loop --------
buff = Config\buffer
For i = 0 To Config\size Step 2 ; // Optimized by merging clear and fill array in one loop
i2 = i >> 1
rex(i2) = 0 ; 0 to 512
imx(i2) = 0 ; 0 to 512
rex(i2 + #N >> 1) = 0 ; 513 to 1024
imx(i2 + #N >> 1) = 0 ; 513 to 1024
value.w = PeekW(buff + i)
;value.w = PeekW( Config\buffer + i + *scope\channel * 2 ) ; // Enable this For Stereo Inpus
rex(i2) = value / 32767 ; // Optimized by doing i >> 1
Next
; // -------- Start FFT --------
For i.i = 1 To #N - 2 ; // Bit reversal sorting
If i < J
TR = REX(J)
TI = IMX(J)
REX(J) = REX(i)
IMX(J) = IMX(i)
REX(i) = TR
IMX(i) = TI
EndIf
K = #ND2
While K <= J
J = J - K
K = K >> 1 ; // Optmimized, instead N / 2
Wend
J = J + K
Next
For L = 1 To #M ; // Loop for each stage
LE.i = 1 << L ; // Optimized, instead LE.i = Int( Pow( 2, L ) )
LE2.i = LE >> 1 ; // Optimized, instead N / 2
UR = 1
UI = 0
SR = Cos(#PI / LE2) ; // Calculate sine & cosine values
SI = -Sin(#PI / LE2)
For J.i = 1 To LE2 ; // Loop for each sub DFT
JM1.i = J - 1
For i = JM1 To #NM1 ; // Loop for each butterfly
IP.i = i + LE2
TR = REX(IP) * UR - IMX(IP) * UI ; // Butterfly calculation
TI = REX(IP) * UI + IMX(IP) * UR
REX(IP) = REX(i) - TR
IMX(IP) = IMX(i) - TI
REX(i) = REX(i) + TR
IMX(i) = IMX(i) + TI
i + LE - 1
Next i
TR = UR
UR = TR * SR - UI * SI
UI = TR * SI + UI * SR
Next
Next
; // -------- Calculate Outputarray and search for MaxValue of the Paket --------
alto=0
maxvalue = 0
; // Optimized by merging calculate Outputarray
; // and search MaxValue into just one loop.
For cnt = 0 To #N ;1024
outputarray(cnt) = (IMX(cnt) * IMX(cnt)) + (REX(cnt) * REX(cnt))
If maxvalue < outputarray(cnt)
maxvalue = outputarray(cnt)
alto = maxvalue
freq = cnt * (#SAMPLE_RATE / 1000)
EndIf
Next
; // -------- Draw FFT --------
;Box(0, 0, #WINDOW_WIDTH, #WINDOW_HEIGHT + 2, #Black)
For cnt = 0 To #WINDOW_WIDTH - 1
yCoord = (outputArray(cnt) / maxValue) * -#WINDOW_HEIGHT
If yCoord < 0
;Line(cnt, 400, 1, yCoord, #TRACE_COLOR)
EndIf
Next
;SetWindowTitle(1962, ShowNote_Get(record_FindNote(MaxPos)))
;SetGadgetText(#gadText1, "Frequency: " + Str(freq) + " Hz")
EndProcedure
Procedure record_CallBack(hWnd.i, Msg.i, wParam.i, lParam.i)
If Msg = #MM_WIM_DATA
record_Read(wParam, lParam): record_doFFT(Config\LScope)
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Define.Meter vu_right
FFTWnd = OpenWindow(#PB_Any, 20, 20, #WINDOW_WIDTH, #WINDOW_HEIGHT , "", #PB_Window_SystemMenu)
Config\hWindow=WindowID(FFTWnd)
Config\output=WindowOutput(FFTWnd)
CreateMeter(@vu_right,2,2,600,600,-80,160,10,0,0.9)
DrawMeter(@vu_right)
SetWindowCallback(@record_CallBack())
StartDrawing(WindowOutput(FFTWnd))
;TextGadget(#gadText1, 10, 410, 110, 20, "Frequency: ") ;DISPLAYS APPROXIMATE FREQUENCY
Record_Start()
Repeat
StopDrawing()
SetMeterAngle(@vu_right,-110+(alto/16))
UpdateMeter(@vu_right)
Until WaitWindowEvent() = #PB_Event_CloseWindow
shutdown:
StopDrawing()
For i = 0 To Config\nBuf - 1
FreeMemory(inHdr(i)\lpData) ;FREE ALLOCATED MEMORY
Next
End
DataSection
Notes :
Data.w 14, 17
Data.w 18, 18
Data.w 19, 19
Data.w 20, 20
Data.w 21, 21
Data.w 22, 23
Data.w 24, 24
Data.w 25, 26
Data.w 27, 27
Data.w 28, 29
Data.w 30, 31
Data.w 32, 32
Data.w 33, 34
Data.w 35, 37
Data.w 38, 39
Data.w 40, 41
Data.w 42, 44
Data.w 45, 46
Data.w 47, 49
Data.w 50, 52
Data.w 53, 55
Data.w 56, 59
Data.w 60, 62
Data.w 63, 66
Data.w 67, 70
Data.w 71, 74
Data.w 75, 79
Data.w 80, 83
Data.w 84, 88
Data.w 89, 94
Data.w 95, 99
Data.w 100, 105
Data.w 106, 112
Data.w 113, 118
Data.w 119, 125
Data.w 126, 133
Data.w 134, 141
Data.w 142, 149
Data.w 150, 158
Data.w 159, 168
Data.w 169, 178
Data.w 179, 188
Data.w 189, 200
Data.w 201, 212
Data.w 213, 224
Data.w 225, 238
Data.w 239, 252
Data.w 253, 267
Data.w 268, 283
Data.w 284, 300
Data.w 301, 318
Data.w 319, 337
Data.w 338, 357
Data.w 358, 375
RealNotes :
Data.s "C0", "C#0", "D0", "D#0", "E0", "F0", "F#0", "G0", "G#0"
Data.s "A0", "A#0", "B0", "C1", "C#1", "D1", "D#1", "E1", "F1", "F#1", "G1", "G#1"
Data.s "A2", "A#2", "B2", "C2", "C#2", "D2", "D#2", "E2", "F2", "F#2", "G2", "G#2"
Data.s "A3", "A#3", "B3", "C3", "C#3", "D3", "D#3", "E3", "F3", "F#3", "G3", "G#3"
Data.s "A4", "A#4", "B4", "C4", "C#4", "D4", "D#4", "E4", "F4"
EndDataSectionCode: Select all
If Config\buffer = 0
MessageRequester("Error", "No buffer available.")
Goto shutdown
EndIfCode: Select all
If Config\buffer = 0
MessageRequester("Error", "No buffer available.")
StopDrawing()
For i = 0 To Config\nBuf - 1
FreeMemory(inHdr(i)\lpData) ;FREE ALLOCATED MEMORY
Next
End
EndIfCode: Select all
; // -------- Calculate Outputarray and search for MaxValue of the Paket --------
; // Optimized by merging calculate Outputarray
; // and search MaxValue into just one loop.
For cnt = 0 To #N
outputarray(cnt) = (IMX(cnt) * IMX(cnt)) + (REX(cnt) * REX(cnt))
media1 = media1 + outputarray(cnt) ; >>>>>>> FFT average
Next
media1 = media1 / #N ;>>>>>>> FFT average
EndProcedure
Code: Select all
Let Full scale VU value be : M = 3 ; common full scale value
Let Full scale sample be : F = 32767 ; For 16 bit signed audio sample)
Let Scale factor be : SF = F / Pow(10, M/20)
Then VU value will be : VU = 20 * Log10(sample / SF)
Thanks BP, taking up the two lines of code in my previous post, i have done the 20*Log10 of the average...BasicallyPure wrote:I worked up some math that I believe is relevant to making a VU (volume unit) meter with log response.BPCode: Select all
Let Full scale VU value be : M = 3 ; common full scale value Let Full scale sample be : F = 32767 ; For 16 bit signed audio sample) Let Scale factor be : SF = F / Pow(10, M/20) Then VU value will be : VU = 20 * Log10(sample / SF)
Code: Select all
my_log_average = 20 * Log10 (media1*#N) ; *#N or /#N ??
Code: Select all
;--------------------------------------------------------------------------------------------------------------
;Authors of Main Code
;http://forums.purebasic.com/english/viewtopic.php?p=360043&sid=254d578a1ba0a5ee32c731fd4ea425f4#p360043
;and
;http://forums.purebasic.com/english/viewtopic.php?p=408302&sid=1906354192faa63f9e175292115b5bf1#p408302
;--------------------------------------------------------------------------------------------------------------
#N = 1024 ;NUMBER OF SAMPLES
#NM1 = #N - 1
#ND2 = #N >> 1
#M = 10
#WINDOW_WIDTH = 605
;#WINDOW_WIDTH = #N / 2 ;512
#WINDOW_HEIGHT = 420
#SAMPLE_RATE = 40000 ;44100 ;8000 ;LIMIT 4000 Hz AUDIO
#TRACE_COLOR = #White
#gadText1 = 1
Structure MYWAVEFORMATEX
wFormatTag.u ;UNSIGNED FOR COMPATIBILITY WITH MICROSOFT FLAG VALUES
nChannels.w
nSamplesPerSec.l
nAvgBytesPerSec.l
nBlockAlign.w
wBitsPerSample.w
cbSize.w
EndStructure
Global Dim rex.f(#N + 1)
Global Dim imx.f(#N + 1)
Global Dim OutPutArray.f(#N + 1)
Global FFTWnd
Global media1
Global myval.f
Global red_al
Global rsin
Structure Meter
canvas.i
startAngle.f
angles.f
angleStep.f
value.f
currValue.f
movement.f
EndStructure
Procedure CreateMeter(*m.Meter,x,y,width,height,startAngle.f, angles.f, angleStep.f, currentAngle.f, movement.f)
If *m = 0 : ProcedureReturn : EndIf
*m\canvas = CanvasGadget(#PB_Any,x,y,width,height)
*m\value = currentAngle
*m\currValue = currentAngle
*m\startAngle = startAngle
*m\angles = angles
*m\movement = movement
*m\angleStep = angleStep
EndProcedure
Procedure DrawMeter(*m.Meter)
If *m = 0 Or *m\canvas = 0 : StopDrawing() : ProcedureReturn : EndIf
width = GadgetWidth(*m\canvas)
height = GadgetHeight(*m\canvas)
If StartDrawing(CanvasOutput(*m\canvas))
If red_al=100
Box(0,0,width,height,RGB($F0,$80,$80))
red_al=0
Else
Box(0,0,width,height,RGB($80,$80,$80))
EndIf
i.f = *m\startAngle
angle.f = 0
Repeat
If i > -1
LineXY(width*0.5+Sin(Radian(i))*(width*0.4) ,height/1.6*0.8-Cos(Radian(i))*(height*0.4),width*0.5+Sin(Radian(i))*(width*0.45),height/1.6*0.8-Cos(Radian(i))*(height*0.45))
EndIf
i + Log10(*m\angleStep)*3.45
angle + *m\angleStep
Until angle > *m\angles*3.5
LineXY(width*0.5,height/2,width*0.5+Sin(Radian(*m\currValue))*(width*0.4),height/2-Cos(Radian(*m\currValue))*(height*0.4),RGB(0,254,0))
StopDrawing()
EndIf
EndProcedure
Procedure SetMeterAngle(*m.Meter, currentAngle.f)
If *m = 0 : ProcedureReturn : EndIf
*m\value = currentAngle
EndProcedure
Procedure UpdateMeter(*m.Meter)
If *m = 0 : ProcedureReturn : EndIf
If *m\currValue < *m\value
*m\currValue + *m\movement
If *m\currValue > *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
ElseIf *m\currValue > *m\value
*m\currValue - *m\movement
If *m\currValue < *m\value
*m\currValue = *m\value
EndIf
DrawMeter(*m)
EndIf
EndProcedure
Structure SCOPE
channel.b
left.i
top.i
width.i
height.i
middleY.i
quarterY.i
EndStructure
Structure CONFIG
hWindow.i ; Window handle
size.i ; Wave buffer size
buffer.i ; Wave buffer pointer
output.i ; WindowOutput()
wave.i ; Address of waveform-audio input device
format.MYWAVEFORMATEX ; Capturing WaveFormatEx
lBuf.i ; Capturing Buffer size
nBuf.i ; Capturing Buffer number
nDev.i ; Capturing Device identifier
nBit.i ; Capturing Resolution (8/16)
nHertz.i ; Capturing Frequency (Hertz)
nChannel.i ; Capturing Channels number (Mono/Stereo)
LScope.SCOPE ; Waveform display
RScope.SCOPE ; Waveform display
EndStructure
Global Config.CONFIG
Global Dim inHdr.WAVEHDR(16)
Config\format\wFormatTag = #WAVE_FORMAT_PCM
Procedure Record_Start()
Config\format\nChannels=1
Config\format\wBitsPerSample = 16
Config\format\nSamplesPerSec = #SAMPLE_RATE
Config\nDev = 0 ; (default MS Sound Mapper device)
Config\lBuf = 1024
Config\nBuf = 8
Config\nBit = 1
Config\format\nBlockAlign = (Config\format\nChannels * Config\format\wBitsPerSample)/8
Config\format\nAvgBytesPerSec = Config\format\nSamplesPerSec * Config\format\nBlockAlign
If #MMSYSERR_NOERROR=waveInOpen_(@Config\wave, #WAVE_MAPPER+Config\nDev, @Config\format, Config\hWindow, #Null, #CALLBACK_WINDOW | #WAVE_FORMAT_DIRECT)
For i=0 To Config\nBuf-1
inHdr(i)\lpData=AllocateMemory(Config\lBuf)
inHdr(i)\dwBufferLength=Config\lBuf
waveInPrepareHeader_(Config\wave, inHdr(i), SizeOf(WAVEHDR))
waveInAddBuffer_(Config\wave, inHdr(i), SizeOf(WAVEHDR))
Next
If #MMSYSERR_NOERROR=waveInStart_(Config\wave)
SetTimer_(Config\hWindow, 0, 1, 0)
EndIf
EndIf
EndProcedure
Procedure Record_Read(hWaveIn.i, lpWaveHdr.i)
*hWave.WAVEHDR=lpWaveHdr
Config\buffer=*hWave\lpData
Config\size=*hWave\dwBytesRecorded
waveInAddBuffer_(hWaveIn, lpWaveHdr, SizeOf(WAVEHDR))
EndProcedure
Procedure record_doFFT(*scope.SCOPE)
Define.d TR, TI, SR, SI, UR, UI
Define.i J, K, L, cnt, MaxValue
Define.w value
; // -------- Init some values for FFT analysing --------
;THESE ARE NOW CONSTANTS AS THEY DON'T CHANGE
;N = 1024 ; // Number of samples
;NM1 = #N - 1
;ND2 = #N >> 1 ; // Optmimized, instead N / 2
;M = 10 ; // If N.w = 1024 == 10 == Same as: Int(Log(N) / 0.69314718055994529)
J = #ND2
;--------------------------------------------------------------------------------------------------------------
;and
;http://forums.purebasic.com/english/viewtopic.php?p=408407&sid=1906354192faa63f9e175292115b5bf1#p408407
;--------------------------------------------------------------------------------------------------------------
If Config\buffer = 0
MessageRequester("Error", "No buffer available.")
StopDrawing()
For i = 0 To Config\nBuf - 1
FreeMemory(inHdr(i)\lpData) ;FREE ALLOCATED MEMORY
Next
End
EndIf
; // -------- Clear and Fill array values for analysing in just only one loop --------
buff = Config\buffer
For i = 0 To Config\size Step 2 ; // Optimized by merging clear and fill array in one loop
i2 = i >> 1
rex(i2) = 0 ; 0 to 512
imx(i2) = 0 ; 0 to 512
rex(i2 + #N >> 1) = 0 ; 513 to 1024
imx(i2 + #N >> 1) = 0 ; 513 to 1024
value.w = PeekW(buff + i)
;value.w = PeekW( Config\buffer + i + *scope\channel * 2 ) ; // Enable this For Stereo Inpus
rex(i2) = value / 32767 ; // Optimized by doing i >> 1
Next
; // -------- Start FFT --------
For i.i = 1 To #N - 2 ; // Bit reversal sorting
If i < J
TR = REX(J)
TI = IMX(J)
REX(J) = REX(i)
IMX(J) = IMX(i)
REX(i) = TR
IMX(i) = TI
EndIf
K = #ND2
While K <= J
J = J - K
K = K >> 1 ; // Optmimized, instead N / 2
Wend
J = J + K
Next
For L = 1 To #M ; // Loop for each stage
LE.i = 1 << L ; // Optimized, instead LE.i = Int( Pow( 2, L ) )
LE2.i = LE >> 1 ; // Optimized, instead N / 2
UR = 1
UI = 0
SR = Cos(#PI / LE2) ; // Calculate sine & cosine values
SI = -Sin(#PI / LE2)
For J.i = 1 To LE2 ; // Loop for each sub DFT
JM1.i = J - 1
For i = JM1 To #NM1 ; // Loop for each butterfly
IP.i = i + LE2
TR = REX(IP) * UR - IMX(IP) * UI ; // Butterfly calculation
TI = REX(IP) * UI + IMX(IP) * UR
REX(IP) = REX(i) - TR
IMX(IP) = IMX(i) - TI
REX(i) = REX(i) + TR
IMX(i) = IMX(i) + TI
i + LE - 1
Next i
TR = UR
UR = TR * SR - UI * SI
UI = TR * SI + UI * SR
Next
rsin= Sqr(UR)
Next
; // -------- Calculate Outputarray and search for MaxValue of the Paket --------
; // Optimized by merging calculate Outputarray
; // and search MaxValue into just one loop.
For cnt = 0 To #N
outputarray(cnt) = (IMX(cnt) * IMX(cnt)) + (REX(cnt) * REX(cnt))
media1 = media1 + outputarray(cnt)
Next
media1 = media1 / #N
myval = (20 * Log10 (media1*2))
If myval<-1
myval =0
media1=0
EndIf
media1 = 0
EndProcedure
Procedure record_CallBack(hWnd.i, Msg.i, wParam.i, lParam.i)
If Msg = #MM_WIM_DATA
record_Read(wParam, lParam): record_doFFT(Config\LScope)
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Define.Meter vu_right
FFTWnd = OpenWindow(#PB_Any, 20, 20, #WINDOW_WIDTH, #WINDOW_HEIGHT , "", #PB_Window_SystemMenu)
Config\hWindow=WindowID(FFTWnd)
Config\output=WindowOutput(FFTWnd)
CreateMeter(@vu_right,2,2,600,600,-80,160,10,0,0.92)
DrawMeter(@vu_right)
SetWindowCallback(@record_CallBack())
Record_Start()
Repeat
If StartDrawing(WindowOutput(FFTWnd))
StopDrawing()
If myval*3 > 132
red_al=100
EndIf
SetMeterAngle (@vu_right,myval*2.65)
UpdateMeter(@vu_right)
EndIf
Until WaitWindowEvent() = #PB_Event_CloseWindow
;shutdown:
StopDrawing()
For i = 0 To Config\nBuf - 1
FreeMemory(inHdr(i)\lpData) ;FREE ALLOCATED MEMORY
Next
End
You're getting old!netmaestro wrote:I'll put something together after I get back from work.
