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 La0.f, La1.f, La2.f, La3.f
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
#Gad_ChanSelectorL
#Gad_ChanSelectorR
EndEnumeration
Structure Waves
WaveForm.i
Frequency.i
Volume.f
Switch.i
YPos.i
EndStructure
Global left.Waves
Global right.Waves
Global latchedChan
Global lnote, rnote
Global leftch = 0
Global rghtch = 2
Structure SN
fr.i
vl.f
EndStructure
Global Dim SndCPU.SN(3)
Macro SetBit(Var, Bit)
Var | (Bit)
EndMacro
Macro ClearBit(Var, Bit)
Var & (~(Bit))
EndMacro
Macro TestBit(Var, Bit)
Bool(Var & (Bit))
EndMacro
Macro NumToBit(Num)
(1<<(Num))
EndMacro
Macro GetBits(Var, StartPos, EndPos)
((Var>>(StartPos))&(NumToBit((EndPos)-(StartPos)+1)-1))
EndMacro
Procedure.f RetVolVal(inp.i)
vol.f
Select inp
Case 15
vol = 0.0
Case 14
vol = 0.06
Case 13
vol = 0.13
Case 12
vol = 0.19
Case 11
vol = 0.26
Case 10
vol = 0.33
Case 9
vol = 0.39
Case 8
vol = 0.46
Case 7
vol = 0.53
Case 6
vol = 0.59
Case 5
vol = 0.66
Case 4
vol = 0.73
Case 3
vol = 0.79
Case 2
vol = 0.86
Case 1
vol = 0.93
Case 0
vol = 1
EndSelect
vol / 4 ; for future ch0 + ch1 + ch2 + ch3 for avoid clips
ProcedureReturn vol
EndProcedure
Procedure write(val.i)
If TestBit(val, NumToBit(7))
chan = GetBits(val, 5, 6)
latchedChan = chan
low = GetBits(val, 0, 3)
latchedVolume = TestBit(val, NumToBit(4))
If latchedVolume
SndCPU(latchedChan)\vl = RetVolVal(low)
Else
SndCPU(latchedChan)\fr = GetBits(SndCPU(latchedChan)\fr, 0, 5) << 4 + low
EndIf
Else
SndCPU(latchedChan)\fr = GetBits(val, 0, 5) << 4 + GetBits(SndCPU(latchedChan)\fr, 0, 3)
EndIf
EndProcedure
Procedure Spam(*Value)
Repeat
XIncludeFile "spam.pb"
ForEver
EndProcedure
;{- 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, 130,276,80, 20,"Left On/Off")
ComboBoxGadget(#Gad_ChanSelectorL, 210, 276, 60, 20)
AddGadgetItem(#Gad_ChanSelectorL, -1, "chan 0")
AddGadgetItem(#Gad_ChanSelectorL, -1, "chan 1")
AddGadgetItem(#Gad_ChanSelectorL, -1, "chan 2")
AddGadgetItem(#Gad_ChanSelectorL, -1, "chan 3")
SetGadgetState(#Gad_ChanSelectorL, leftch)
CheckBoxGadget(#Gad_SwitchR, 444, 276,80,20,"Right On/Off",#PB_CheckBox_Right)
ComboBoxGadget(#Gad_ChanSelectorR, 530, 276, 60, 20)
AddGadgetItem(#Gad_ChanSelectorR, -1, "chan 0")
AddGadgetItem(#Gad_ChanSelectorR, -1, "chan 1")
AddGadgetItem(#Gad_ChanSelectorR, -1, "chan 2")
AddGadgetItem(#Gad_ChanSelectorR, -1, "chan 3")
SetGadgetState(#Gad_ChanSelectorR, rghtch)
TextGadget(#PB_Any,244,306,110,20,"Frequency",#PB_Text_Center)
ScrollBarGadget(#Gad_FreqL,44, 306,200,20,35,8000,1)
ScrollBarGadget(#Gad_FreqR,356,306,200,20,35,8000,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 = #True
\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/2) : SetGadgetState(#Gad_VolumeL,100*left\Volume) : SetGadgetState(#Gad_SwitchL,left\Switch)
SetGadgetState(#Gad_FreqR,right\Frequency/2) : 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, #PB_Ascii) : *P + 4 ; 00-03 Chunk ID 4
PokeL(*P,0) : *P + 4 ; 04-07 Chunk data size (Place holder) 4
PokeS(*P,"WAVE",4, #PB_Ascii) : *P + 4 ; 08-11 'RIFF type' 4
; 'fmt' Subchunk - 16 bytes
PokeS(*P,"fmt ",4, #PB_Ascii) : *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, #PB_Ascii) : *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
;запуск спама
CreateThread(@Spam(), 154)
;}
;{- 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
Case #Gad_ChanSelectorL
leftch = GetGadgetState(#Gad_ChanSelectorL)
If leftch = 3
SetGadgetState(#Gad_WavL, 3)
left\WaveForm = 3
Else
SetGadgetState(#Gad_WavL, 0)
left\WaveForm = 0
EndIf
Case #Gad_ChanSelectorR
rghtch = GetGadgetState(#Gad_ChanSelectorR)
If rghtch = 3
SetGadgetState(#Gad_WavR, 3)
right\WaveForm = 3
Else
SetGadgetState(#Gad_WavR, 0)
right\WaveForm = 0
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)*2 ; Frequency value directly from control
Case GadgetID(#Gad_FreqR) : right\Frequency = GetGadgetState(#Gad_FreqR)*2
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)
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
Protected Kl0.f, Kl1.f, Kl2.f, Kl3.f
Protected Vl0.f, Vl1.f, Vl2.f, Vl3.f
; 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
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
;{ Calculate the frequency scaling factors - Provisional...
frq = 2 * SndCPU(0)\fr * 16
If frq > 0
Kl0 = 3579545 / frq
Kl0 = Kl0 / (44100/#PIx2)
Else
Kl0 = 0
EndIf
frq = 2 * SndCPU(1)\fr * 16
If frq > 0
Kl1 = 3579545 / frq
Kl1 = Kl1 / (44100/#PIx2)
Else
Kl1 = 0
EndIf
frq = 2 * SndCPU(2)\fr * 16
If frq > 0
Kl2 = 3579545 / frq
Kl2 = Kl2 / (44100/#PIx2)
Else
Kl2 = 0
EndIf
;}
For n = 0 To BLKSIZE - 1
Vl0 = 32767 * SndCPU(0)\vl ; Square
If La0 > #PI : Vl0 = -Vl0 : EndIf
La0 + Kl0 ; Calculate angle for next time
If La0 > #PIx2 : La0 - #PIx2 : EndIf ; limit to 2*PI radians
Vl1 = 32767 * SndCPU(1)\vl ; Square
If La1 > #PI : Vl1 = -Vl1 : EndIf
La1 + Kl1 ; Calculate angle for next time
If La1 > #PIx2 : La1 - #PIx2 : EndIf
Vl2 = 32767 * SndCPU(2)\vl ; Square
If La2 > #PI : Vl2 = -Vl2 : EndIf
La2 + Kl2 ; Calculate angle for next time
If La2 > #PIx2 : La2 - #PIx2 : EndIf
Vl = Vl0 + Vl1 + Vl2
;stereo
PokeW(*P, Vl) ; Put point in buffer
*P + BytesPerSample ; move buffer pointer to next RIGHT sample
PokeW(*P, Vl) ; Put point in buffer
*P + BytesPerSample
Next
T = DS\UnLock(Ptr1,Bytes1,Ptr2,Bytes2)
EndIf
;}
Flag =#False
EndIf
Delay(3)
Wend
EndProcedure
how to apply this code from my trying (if it is correct. i am not sure. becouse it is i am done and i am always done wrong):