Code: Select all
; AudioGenerator.pb
; by BasicallyPure
; 08.17.2015
; windows only
; PB 5.31
EnableExplicit
;{ Constants
#MainWin = 0
#OutDevice_1 = 0
#PIx2 = 2*#PI
#Mono = 1
#Stereo = 2
#ScopeBkgndColor = $276724
#LeftColor = $27CF24
#RighttColor = $27E4D3
#SpinLostFocus = 512
#Input_Finished = #PB_EventType_FirstCustomValue
; gadgets
#BtnHop = 0
#BtnPause = 1
#SpinLeft = 2
#SpinRight = 3
#TrackLeft = 4
#TrackRight = 5
#Rsquare = 6
#Lsquare = 7
; menus
#Menu_1 = 0
;}
;{ Procedure declarations
Declare WinCallback(hwnd, uMsg, wParam, lParam)
Declare StartSoundOutput()
Declare StopSoundOutput()
Declare MAKE_WAVE(*SBuf)
Declare Init_GUI()
Declare EventLoop()
Declare ProcessSpin(nGad,*Freq)
;}
;{ Global variables
Global SampleClock = 44100 ; Sampling frequency in 'samples per second'
Global BlockSize = 8192 ; Number of samples in block
Global BytesPerSample = 2 ; Number of bytes needed for each sample, don't change this
Global Channels = #Stereo ; Number of channels, 1 for mono, 2 for stereo.
Global nBuf = 8 ; Number of buffers
Global DevOut = 1 ; default audio output device
Global Frequency_Left = 1000
Global Frequency_Right = 440
Global Volume_Left.f = 0.25 * 32767
Global Volume_Right.f = 0.25 * 32767
Global hWaveOut
Global Hop = #False
Global Pause = #False
Global Lsquare = #False
Global Rsquare = #False
Global NumOutDevs
Global PlayFormat.WAVEFORMATEX
Global MyOutDevs.WAVEOUTCAPS
Global Dim outHdr.WAVEHDR(nBuf)
;}
If Init_GUI()
EventLoop()
StopSoundOutput()
EndIf
End
Procedure Init_GUI()
Protected n, result = 1
If OpenWindow(#MainWin,0,0,350,120,"Audio generator",#PB_Window_SystemMenu |#PB_Window_ScreenCentered)
ButtonGadget(#BtnHop,10,10,50,25,"Hop",#PB_Button_Toggle)
ButtonGadget(#BtnPause,70,10,50,25,"Pause",#PB_Button_Toggle)
SpinGadget(#SpinLeft,130,02,70,25,100,5000)
SetGadgetState(#SpinLeft,Frequency_Left) : SetGadgetText(#SpinLeft,Str(Frequency_Left))
SetGadgetColor(#SpinLeft,#PB_Gadget_BackColor,#LeftColor)
SpinGadget(#SpinRight,235,02,70,25,100,5000)
SetGadgetState(#SpinRight,Frequency_Right) : SetGadgetText(#SpinRight,Str(Frequency_Right))
SetGadgetColor(#SpinRight,#PB_Gadget_BackColor,#RighttColor)
TrackBarGadget(#TrackLeft,125,30,100,25,0,100) : SetGadgetState(#TrackLeft,Volume_Left / 327.67)
TrackBarGadget(#TrackRight,230,30,100,25,0,100) : SetGadgetState(#TrackRight,Volume_Right /327.67)
CheckBoxGadget(#Lsquare,135,60,100,25,"L square")
CheckBoxGadget(#Rsquare,240,60,100,25,"R square")
CreateMenu(#Menu_1, WindowID(#MainWin))
; locate all sound output devices
OpenSubMenu("Sound Output Devices")
NumOutDevs = waveOutGetNumDevs_()
If NumOutDevs <> 0
For n = 0 To NumOutDevs - 1
If waveOutGetDevCaps_(n,@MyOutDevs,SizeOf(WAVEOUTCAPS)) = 0
MenuItem(n + #OutDevice_1,PeekS(@MyOutDevs\szPname))
EndIf
Next
CloseSubMenu()
SetMenuItemState(#Menu_1,#OutDevice_1,#True)
SetWindowCallback(@WinCallback()) ; Handle Sound Output callback
StartSoundOutput()
Else
MessageRequester("Error!","No audio output device found.")
result = 0
EndIf
Else
result = 0
EndIf
ProcedureReturn result
EndProcedure
Procedure EventLoop()
Protected menuSelection, ActiveGadget, n, Quit = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_Gadget
Select EventGadget()
Case #BtnHop
Hop = GetGadgetState(#BtnHop)
Frequency_Left = GetGadgetState(#SpinLeft)
Frequency_Right = GetGadgetState(#SpinRight)
Case #BtnPause
Pause = GetGadgetState(#BtnPause)
If Pause
waveOutPause_(hWaveOut)
Else
waveOutRestart_(hWaveOut)
EndIf
Case #SpinLeft : ProcessSpin(#SpinLeft, @Frequency_Left)
Case #SpinRight : ProcessSpin(#SpinRight, @Frequency_Right)
Case #TrackLeft : Volume_Left = GetGadgetState(#TrackLeft) * 327.67
Case #TrackRight : Volume_Right = GetGadgetState(#TrackRight) * 327.67
Case #Rsquare : Rsquare = GetGadgetState(#Rsquare)
Case #Lsquare : Lsquare = GetGadgetState(#Lsquare)
EndSelect
Case #PB_Event_Menu
menuSelection = EventMenu()
If GetMenuItemState(#Menu_1,menuSelection) = #False
Select menuSelection
Case #OutDevice_1 To #OutDevice_1 + NumOutDevs - 1 ; Output device selection
For n = #OutDevice_1 To #OutDevice_1 + NumOutDevs - 1
If n = menuSelection
SetMenuItemState(#Menu_1,menuSelection,#True)
Else
SetMenuItemState(#Menu_1,n,#False)
EndIf
Next
DevOut = menuSelection - #OutDevice_1 + 1
StopSoundOutput()
StartSoundOutput()
EndSelect
EndIf
Case #WM_KEYUP
ActiveGadget = GetActiveGadget()
Select ActiveGadget
Case #SpinLeft To #SpinRight
If EventwParam() = #VK_RETURN
PostEvent(#PB_Event_Gadget,#MainWin,ActiveGadget,#Input_Finished)
EndIf
EndSelect
EndSelect
Until Quit = #True
EndProcedure
Procedure WinCallback(hwnd, uMsg, wParam, lParam)
; Window callback to service sound output message
Static *hWaveO.WAVEHDR
Select uMsg
Case #MM_WOM_DONE ; Sound output, a play buffer has been returned.
*hWaveO.WAVEHDR = lParam ; lParam has the address of WAVEHDR
MAKE_WAVE(*hWaveO\lpData) ; send pointer where to write NEW data
*hWaveO\dwBytesRecorded = BlockSize ; Number of bytes written into buffer
waveOutWrite_(hWaveOut,lParam, SizeOf(WAVEHDR)) ; Send to sound device => jack socket => cable =>
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure StartSoundOutput()
Protected T,i, *P
Static *OutBufMem
With PlayFormat
\wFormatTag = #WAVE_FORMAT_PCM
\nChannels = Channels
\wBitsPerSample = BytesPerSample * 8
\nSamplesPerSec = SampleClock
\nBlockAlign = Channels * BytesPerSample
\nAvgBytesPerSec = \nSamplesPerSec * \nBlockAlign
EndWith
If *OutBufMem : FreeMemory(*OutBufMem) : EndIf ; Free a prior assignement
*OutBufMem = AllocateMemory(BlockSize * nBuf) ; Reserve memory for all the buffers
T = waveOutOpen_(@hWaveOut, #WAVE_MAPPER+DevOut, @PlayFormat, WindowID(#MainWin), #True, #CALLBACK_WINDOW | #WAVE_FORMAT_DIRECT)
If T = #MMSYSERR_NOERROR
*P = *OutBufMem ; Pointer to start of memory
For i = 0 To nBuf-1 ; For each buffer
outHdr(i)\lpData = *P ; start of buffer
outHdr(i)\dwBufferLength = BlockSize ; size of buffer
outHdr(i)\dwFlags = 0
outHdr(i)\dwLoops = 0
T | waveOutPrepareHeader_(hWaveOut, outHdr(i), SizeOf(WAVEHDR))
*P + BlockSize
Next
For i = 0 To nBuf-1
PostMessage_(WindowID(#MainWin),#MM_WOM_DONE,0,outHdr(i))
Next
EndIf
If T = #MMSYSERR_NOERROR : ProcedureReturn 1 : Else : ProcedureReturn 0 : EndIf
EndProcedure
Procedure StopSoundOutput()
Protected i
waveOutReset_(hWaveOut)
For i = 0 To nBuf - 1
waveOutUnprepareHeader_(hWaveOut, outHdr(i), SizeOf(WAVEHDR))
Next
waveOutClose_(hWaveOut)
EndProcedure
Procedure MAKE_WAVE(*SBuf)
; This routine generates Left and Right waveforms.
Static.d Angle, Kl, Kr, La, Ra
Static.i sample
Static.l Vl, Vr
If Hop
Frequency_Left = Random(1220,220)
Frequency_Right = Random(1220,220)
EndIf
; Calculate the frequency scaling factors
Kl = #PIx2 * Frequency_Left / SampleClock
Kr = #PIx2 * Frequency_Right / SampleClock
sample = 1
Repeat ; Generate waveform data
; Left sample
If Lsquare
Vl = Sign(#PI-La) * Volume_Left
Else
Vl = Sin(La) * Volume_Left
EndIf
La + Kl ; calculate angle for next time
If La > #PIx2 : La - #PIx2 : EndIf ; limit to 2*PI radians
PokeW(*SBuf,Vl) ; Put point in buffer
*SBuf + BytesPerSample ; move buffer pointer to next sample
; Right sample
If Rsquare
Vr = Sign(#PI-Ra) * Volume_Right
Else
Vr = Sin(Ra) * Volume_Right
EndIf
Ra + Kr
If Ra > #PIx2 : Ra - #PIx2 : EndIf
PokeW(*SBuf,Vr)
*SBuf + BytesPerSample
sample + PlayFormat\nBlockAlign
Until sample > BlockSize
EndProcedure
Procedure ProcessSpin(nGad,*Freq)
Select EventType()
Case #PB_EventType_Up, #PB_EventType_Down
SetGadgetText(nGad, Str(GetGadgetState(nGad)))
PokeI(*Freq, GetGadgetState(nGad))
Case #Input_Finished, #SpinLostFocus
SetGadgetState(nGad,Val(GetGadgetText(nGad)))
SetGadgetText(nGad, Str(GetGadgetState(nGad)))
PokeI(*Freq, GetGadgetState(nGad))
EndSelect
EndProcedure