After searching the PureArea code archive I found references to an interesting property of IsSound() that provides access to the internal working of the DirectX functions being used by PB. I lifted some DirectX code from another of my projects and was then able to write into the buffers that are being used to play the sound. However, I hear occasional glitches that make me think I am not doing things right. (My code is probably colliding with PlaySound() accessing the same buffer area.... but no debug error returns???)
I am not a DirectX expert so unable to take this any further. Here is where I got to... including various debug outputs and commented-off items that I was using to research the 'glitches'. Yes, a full DirectX solution would be perfectly glitch free, but my intention was to build a tone generator on the foundations of the existing PureBasic sound facilities.
Code: Select all
; ********************************************************************************
; Sound Generator - A stereo sound generator with independent channel controls and a few
; extra features.
; (c)2013 of the author RichardL.
; Free to copy, use or ignore!
; 1.1 Put on PB website 13:55 21st April 2013
; 1.2 22nd April 2013
; Changed to ScrollBar()s - Nicer behaved. Added horizontal grid lines - Looks better!
; Added Y 'scope sliders. Re-styled lots of code. Temporary mono WAV player
; on Left channel... which 'works' if you can find a 16 bit mono PCM WAV file.
; 1.3 23rd April 2013
; 'Scope now triggered by Right channel when Left is Off.
; Output level now Zero when Off, was constant at full negative.
; Correction to WAVPath$ after a file is selected
; ********************************************************************************
Declare WinCallback(hwnd, uMsg, wParam, lParam) ;- Window callback
Declare Thread_CalcWave(Z) ;- Calculate the waveform for left / right channels
Global BLKSIZE, hSound, Channels, BytesPerSample,BufSize
Global LockLR, LockOffset
Global ThreadID,ScopeImage
Global La.f, Ra.f , DoDP, DoDF
Global hWAV
WAVPath$ = "C:\Temp\"
#PIx2 = #PI * 2
Enumeration 1000 ; Windows, Gadgets, Hot keys
#Win_SNDWin
#Gad_Scope
#Gad_WavL
#Gad_WavR
#Gad_SwitchL
#Gad_SwitchR
#Gad_FreqL
#Gad_FreqR
#Gad_VolumeL
#Gad_VolumeR
#Gad_Lock
#Gad_LockOfs
#Gad_SwitchDF
#Gad_SwitchDP
#Gad_PlayWAV
#Gad_LeftY
#Gad_RightY
EndEnumeration
Structure Waves
WaveForm.i
Frequency.i
Volume.f
Switch.i
YPos.i
EndStructure
Global left.Waves
Global right.Waves
;{- Control panel
ScopeImage = CreateImage(#PB_Any,512,256)
; Buttons etc.
OpenWindow(#Win_SNDWin,0,0,600,400,"Sound Generator - R1.3 (c) RichardL 2013",#PB_Window_SystemMenu |#PB_Window_ScreenCentered)
ImageGadget(#Gad_Scope,41,10,512+6,256+6,ImageID(ScopeImage),#PB_Image_Border)
ScrollBarGadget(#Gad_LeftY,28,4,10,269,0,256,1,#PB_ScrollBar_Vertical)
ScrollBarGadget(#Gad_RightY,512+47,4,10,269,0,256,1,#PB_ScrollBar_Vertical)
ComboBoxGadget(#Gad_WavL,44,276,80,20)
ComboBoxGadget(#Gad_WavR,356,276,80,20)
CheckBoxGadget(#Gad_SwitchL,164, 276,80, 20,"Left On/Off")
CheckBoxGadget(#Gad_SwitchR,474,276,80,20,"Right On/Off",#PB_CheckBox_Right)
TextGadget(#PB_Any,244,306,110,20,"Frequency",#PB_Text_Center)
ScrollBarGadget(#Gad_FreqL,44, 306,200,20,100,10000,1)
ScrollBarGadget(#Gad_FreqR,356,306,200,20,100,10000,1)
TextGadget(#PB_Any,244,336,110,20,"Amplitude",#PB_Text_Center)
ScrollBarGadget(#Gad_VolumeL,44 ,336,200,20,0,100,1)
ScrollBarGadget(#Gad_VolumeR,356,336,200,20,0,100,1)
CheckBoxGadget(#Gad_Lock,44,366,80,20,"Lock L+R")
StringGadget(#Gad_LockOfs,134,366,60,20,"0", #PB_String_Numeric)
OptionGadget(#Gad_SwitchDF,204,358,100,20,"Freq offset (Hz)")
OptionGadget(#Gad_SwitchDP,204,379,110,20,"Phase offset (Deg)")
ButtonGadget(#Gad_PlayWAV,356,366,200,20,"Play WAV")
; Waveform choices
WaveType$ = "Sine|Square|Sawtooth|Noise|WAV File|"
For n = 1 To CountString(WaveType$,"|")
AddGadgetItem(#Gad_WavL,-1,StringField(WaveType$,n,"|"))
AddGadgetItem(#Gad_WavR,-1,StringField(WaveType$,n,"|"))
Next
; Initial frequencies etc
With left ; 1000 Hz Sinewave on left, On
\Frequency = 1000
\Volume = 0.2
\Switch = #True
\WaveForm = 0
\YPos = 127
EndWith
With right
\Frequency = 300 ; 300 Hz Sinewave on right, Off
\Volume = 0.2
\Switch = #False
\WaveForm = 0
\YPos = 127
EndWith
LockLR = #False ; Option to lock RIGHT frequency to LEFT frequency (With frequency or phase offset.)
DoDF = #True ; When L&R frequencies are BOTH controlled by the LEFT channel there is an
DoDP = #False ; option for having a phase or frequency offset.
; Set controls to match initial conditions
SetGadgetState(#Gad_FreqL,left\Frequency) : SetGadgetState(#Gad_VolumeL,100*left\Volume) : SetGadgetState(#Gad_SwitchL,left\Switch)
SetGadgetState(#Gad_FreqR,right\Frequency) : SetGadgetState(#Gad_VolumeR,100*right\Volume): SetGadgetState(#Gad_SwitchR,right\Switch)
SetGadgetState(#Gad_WavL,left\WaveForm) : SetGadgetState(#Gad_WavR,right\WaveForm)
SetGadgetState(#Gad_Lock,LockLR)
SetGadgetState(#Gad_SwitchDF,DoDF) : SetGadgetState(#Gad_SwitchDP,DoDP)
DisableGadget(#Gad_PlayWAV,#True)
SetGadgetState(#Gad_LeftY, left\YPos)
SetGadgetState(#Gad_RightY,right\YPos)
; Create a backdrop for the oscilloscope with 1mSec grid lines
StartDrawing(ImageOutput(ScopeImage))
FrontColor($0089C89)
X = 0
f.f = 512/(1000*2048/(44100*4)) ; Scale factor for 1 mSec grid
While X <512
LineXY(X,0,X,255)
X + f.f
Wend
Y = 0 ; Horizontal lines are purely cosmetic!
While Y < 128
LineXY(0,128-Y,512,128-Y)
LineXY(0,128+Y,512,128+Y)
Y + f.f
Wend
StopDrawing()
SetGadgetState(#Gad_Scope,ImageID(ScopeImage))
;}
;{- Prep and start
;{ Create stereo sound header plus buffer
; http://www.sonicspot.com/guide/wavefiles.html#fact Useful item about the WAV/RIFF header...
; Sound replay
CAPTURECLOCK = 44100 ; Sampling/Replay frequency in 'samples per second'
BLKSIZE = 2048 ; Number of samples in capture/play block
BytesPerSample = 2 ; Number of bytes needed for each sample
Channels = 2 ; Number of channels, 1 for mono, 2 for stereo.
BufSize = (BytesPerSample * Channels * BLKSIZE * 2) ; Buffer to hold TWO blocks
*Header = AllocateMemory(BufSize + 12 + 16 + 8) ; Memory for header and buffer
*P = *Header
; 'RIFF' chunk descriptor - 12 bytes
PokeS(*P,"RIFF",4) : *P + 4 ; 00-03 Chunk ID 4
PokeL(*P,0) : *P + 4 ; 04-07 Chunk data size (Place holder) 4
PokeS(*P,"WAVE",4) : *P + 4 ; 08-11 'RIFF type' 4
; 'fmt' Subchunk - 16 bytes
PokeS(*P,"fmt ",4) : *P+ 4 ; 12-15 'SubChunk ID'
PokeL(*P,16) : *P+ 4 ; 16-19 'Chunk data size'
*Q=*P
PokeW(*P,1) : *P+ 2 ; 20-21 'Compression code' 1=Non-compressed data PCM 2
PokeW(*P,2) : *P+ 2 ; 22-24 'Number of channels' 2
PokeL(*P,CAPTURECLOCK) : *P+ 4 ; 24-27 'Sample rate' 4
PokeL(*P,Channels * BytesPerSample * CAPTURECLOCK) : *P+ 4 ; 28-31 'Average bytes per second' 4
PokeW(*P,BytesPerSample * Channels) : *P+ 2 ; 32-33 'Block align' Bytes per sample slice 2
PokeW(*P,8 * BytesPerSample ) : *P+ 2 ; 34-35 'Significant bits per sample' 2
; 'data' Subchunk - 8 bytes (+Buffer)
PokeS(*P,"data",4) : *P + 4 ; 'SubChunk ID' 4
PokeL(*P,BufSize) : *P + 4 ; Length of my data 4
FillMemory(*P,BufSize,0,#PB_Word) ; Clear the buffer
;}
If InitSound()= 0 ; Initialise sound environment
MessageRequester("ERROR","Cannot initialise sound resources")
End
EndIf
hSound = CatchSound(#PB_Any,*Header) ; Set up a sound
PlaySound(hSound, #PB_Sound_Loop) ; Start playing the buffer
ThreadID = CreateThread(@Thread_CalcWave(),1) ; Start generating waveform in *Buf
SetWindowCallback(@WinCallback()) ; Callback used to manage the slider controls
;}
;{- Dispatch
Finish = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow ;{ Close window
Finish = #True
;}
Case #PB_Event_Gadget ;{ Buttons and gadgets
Select EventGadget()
Case #Gad_SwitchL : left\Switch = GetGadgetState(#Gad_SwitchL)
Case #Gad_SwitchR : right\Switch = GetGadgetState(#Gad_SwitchR)
Case #Gad_Lock
LockLR = GetGadgetState(#Gad_Lock)
DisableGadget(#Gad_FreqR,LockLR)
If LockLR = #False
right\Frequency = GetGadgetState(#Gad_FreqR)
Else
La.f = Ra.f + 3.142
EndIf
Case #Gad_SwitchDF, #Gad_SwitchDP
DoDF = GetGadgetState(#Gad_SwitchDF) ; A flip-flop pair
DoDP = DoFR ! 1
Case #Gad_WavL
left\WaveForm = GetGadgetState(#Gad_WavL)
If left\WaveForm = 4
WAVFile$ = OpenFileRequester("Load a WAV File",WAVPath$,"WAV Files|*.WAV",0)
If WAVFile$
WAVPath$ = GetPathPart(WAVFile$)
DisableGadget(#Gad_PlayWAV,#False)
SetGadgetText(#Gad_PlayWAV,"Play<"+GetFilePart(WAVFile$)+">")
EndIf
EndIf
Case #Gad_WavR
right\WaveForm = GetGadgetState(#Gad_WavR)
Case #Gad_PlayWAV ; Kludge to play a 16bit Mono 44.1K sampple rate WAV file
; No header checks, no nuffin'
If IsFile(hWAV) : CloseFile(hWAV) : hWAV = 0 : EndIf
If WAVFile$
hWAV = OpenFile(#PB_Any,WAVFile$)
FileSeek(hWAV,36)
EndIf
EndSelect
EndSelect
;}
If EventType() = #PB_EventType_Change
If EventGadget() = #Gad_LockOfs
LockOffset = Val(GetGadgetText(#Gad_LockOfs))
EndIf
EndIf
Until Finish
;}
;{- PUFO
ThreadID = 0
Delay(50)
StopSound(hSound)
;}
End
Procedure WinCallback(hwnd, uMsg, wParam, lParam) ;- Window callback to service frequqncy and volume sliders
Select uMsg
Case #WM_HSCROLL
; Two frequency and two amplitude controls
Select lParam
Case GadgetID(#Gad_FreqL) : left\Frequency = GetGadgetState(#Gad_FreqL) ; Frequency value directly from control
Case GadgetID(#Gad_FreqR) : right\Frequency = GetGadgetState(#Gad_FreqR)
Case GadgetID(#Gad_VolumeL) : left\Volume = GetGadgetState(#Gad_VolumeL) / 100 ; Scale over range 0 to 1. FLOAT
Case GadgetID(#Gad_VolumeR) : right\Volume = GetGadgetState(#Gad_VolumeR) / 100
EndSelect
; Set 'Scope Y positions
Case #WM_VSCROLL
Select lParam
Case GadgetID(#Gad_LeftY) : left\YPos = GetGadgetState(#Gad_LeftY)
Case GadgetID(#Gad_RightY) : right\YPos = GetGadgetState(#Gad_RightY) : Debug right\YPos
EndSelect
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Thread_CalcWave(Z) ;- Calculate the waveform for left / right channels
; This thread generates the left and right waveforms for the play buffer <<continually>>.
; Both channels are phase continuous.
; Left and right samples are interleaved and each sample is a WORD value. (L.w, R.w, L.w, R.w, L.w, R.w.... etc
; The thread needs to complete writing half a buffer before Windows finished playing the other half.
; The buffer contains 2048 * 2 samples that are played at 44100 samples persecond so it takes 2048/44100 seconds to
; play half the buffer, 46.4 milliseconds. This code needs to complete it's function in less than this time.
Protected Angle.f,Vl.f,Vr.f,Kl.f,Kr.f,LastVL.f,LastVR.f
Protected X,Yl,Yr,OldX,OldYL,OldYR
Protected Fill_1,fill_2,*P,*K
Protected Trig = BLKSIZE ; Half of our buffer
Protected Ptr1,Bytes1,Ptr2,Bytes2
Debug "Hello..."
; http://msdn.microsoft.com/en-gb/library/windows/desktop/microsoft.directx_sdk.idirectsoundbuffer8.idirectsoundbuffer8.lock(v=vs.85).aspx
DS.IDirectSoundBuffer = PeekL(IsSound(hSound))
; Safe GetSoundPosition() windows when we can write to the buffer.
; (Draw a circle with a circumference of BLKSIZE*2 units...)
Dim StartWin(1) : Dim EndWin(1) : Dim BasePos(1)
StartWin(0) = 768 : StartWin(1) = 2816 : BasePos(0) = BLKSIZE*4 ;(4? two channels of WORD samples)
EndWin(0) = 1280 : EndWin(1) = 3328 : BasePos(1) = 0
Flip = 0
While ThreadID
;{ Calculate the frequency scaling factors - Provisional...
Kl = left\Frequency / (44100/#PIx2)
If LockLR ; If channels are locked together, there are two lock modes...
If DoDF ; (1) With a user specified frequency offset...
right\Frequency = left\Frequency + LockOffset
Else ; (2) With a phase offest...
right\Frequency = left\Frequency
Ra = La + (LockOffset/360) * #PIx2
EndIf
EndIf
Kr = right\Frequency /(44100/#PIx2)
;}
; Find which half of the buffer are we currently playing and make write pointer to the other.
; (GetSoundPosition() takes about 4 uS and Sinewave creation takes about 120 uS on my machine
; which is more that fast enough.)
; The following simple method 'works' but is not as elegant as using the DirectX
; 'SetNotificationPositions' style of solution.
Position = GetSoundPosition(hSound) ; Current play position...
If Position > StartWin(Flip) And Position < EndWin(Flip) ;
Flip ! 1
Base = BasePos(Flip)
Flag = #True
EndIf
;{/ Write waveform data to half the buffer
If Flag ; If we are fill are to fill part of the buffer...
If DS\Lock(Base,BLKSIZE,@Ptr1,@Bytes1,@Ptr2,@Bytes2,0) = 0 ; Get address of block to be written
*P = Ptr1
*K = Ptr1
For n = 0 To BLKSIZE - 1
; Derive LEFT channel waveform points.
;(Being more rigorous by using Round() etc made no difference to the glitches)
If left\Switch ; If Left channel is switched ON...
Select left\WaveForm
Case 0 : Vl = Sin(La) * 32767 * left\Volume ; SineWave
Case 1 : Vl = 32767 * left\Volume ; Square
If La>#PI : Vl = -Vl : EndIf
Case 2 : Vl = 32767 * left\Volume * (La-#PI)/#PI ; Sawtooth
Case 3 : Vl = (Random(65535)-32768) * left\Volume ; Noise
Case 4
If hWAV And Not Eof(hWAV)
Vl = ReadWord(hWAV) * left\Volume
Else
If hWAV : CloseFile(hWAV) : hWAV = 0 : EndIf
Vl = 0
EndIf
EndSelect
La + Kl ; Calculate angle for next time
If La > #PIx2 : La - #PIx2 : EndIf ; limit to 2*PI radians
Else ; Not ON so point is zero
Vl = 0
EndIf
PokeW(*P,Vl) ; Put point in buffer
*P + BytesPerSample ; move buffer pointer to next RIGHT sample
; Derive RIGHT channel waveform point
If right\Switch
Select right\WaveForm
Case 0 : Vr = Sin(Ra) * 32767 * right\Volume
Case 1 : Vr = 32767 * right\Volume
If Ra>#PI : Vr = -Vr : EndIf
Case 2 : Vr = 32767 * right\Volume * (Ra-#PI)/#PI
Case 3 : Vr = (Random(65535)-32768) * right\Volume
EndSelect
Ra + Kr
If Ra > #PIx2 : Ra - #PIx2 : EndIf
Else
Vr = 0
EndIf
PokeW(*P,Vr)
*P + BytesPerSample
Next
T = DS\UnLock(Ptr1,Bytes1,Ptr2,Bytes2)
If T : Debug Ptr1 :EndIf
EndIf
;}
;{/ Draw the oscilloscope display
*P = *K
Copy = CopyImage(ScopeImage,#PB_Any) ; Make temporary copy of 'scope backdrop
StartDrawing(ImageOutput(Copy))
; Show the two channel frequencies
DrawText(8,8,Str(left\Frequency)+" Hz",#Red)
DrawText(450,8,Str(right\Frequency)+" Hz",#Green)
LastVL = 1000 : STrig = 0 ; Prime the trigger
X = 0
For n = 0 To BLKSIZE-1
; Get the left and right signal levels
Vl = PeekW(*P) : *P + 2
Vr = PeekW(*P) : *P + 2
; Detect positive zero-crossing on left channel to trigger the 'scope
If left\Switch
If (LastVL <= 0) And (Vl > 0) ; Rising though zero?
STrig = #True ; Set trigger flag...
EndIf
LastVL = Vl ; Keep current Left value to compare with next
Else ; If Left channel OFF then trigger from Right...
If (LastVR <= 0) And (Vr > 0) ; Rising though zero?
STrig = #True ; Set trigger flag...
EndIf
LastVR = Vr ; Keep current Left value to compare with next
EndIf
; Plot scope display of first 512 points after a Left zero crossing
; (NB: Using Round() would be better than Int()...)
If (X < 512) And STrig
Yl = left\YPos - Int(Vl)>>8 ; Scale and offset the LEFT waveform ('-' makes positive = up)
Yr = right\YPos- Int(Vr)>>8 ; Scale and offset the RIGHT waveform
If X ; After the first point...
LineXY(OldX,OldYL,X,Yl,#Red) ; join to previous point
LineXY(OldX,OldYR,X,Yr,#Green)
EndIf
OldX = X ; Keep values to become the previous, next time
OldYL = Yl
OldYR = Yr
X + 1
EndIf
Next
StopDrawing()
SetGadgetState(#Gad_Scope, ImageID(Copy)) ; Transfer the new display to the display gadget
FreeImage(Copy) ; Dispense with temporary image
;}
Flag =#False
EndIf
Delay(3)
Wend
EndProcedure
