Code: Select all
declare sub SoundSet(frequency as integer, channels as integer, bits as integer)
declare sub playbuffer (soundBuffer as any ptr, buffersize as integer)
Const SampleRate=44100
type SoundFunction extends object
t as single
fm as single
Duration as integer
child as SoundFunction ptr
child2 as SoundFunction ptr
declare abstract function GetNext() as single
Declare Destructor()
end type
Destructor SoundFunction
if child then delete child
if child2 then delete child2
end Destructor
type SineWaveFunction extends SoundFunction
Freq as single
declare function GetNext() as single
end type
function SineWaveFunction.GetNext() as single
t+=1
return sin(6.28/SampleRate*Freq*t+fm)
end function
Function SineWave (Freq as single) as SineWaveFunction ptr
dim w as SineWaveFunction ptr=new SineWaveFunction
w->Freq=Freq
return w
end function
type TriangleWaveFunction extends SoundFunction
Freq as single
declare function GetNext() as single
end type
function TriangleWaveFunction.GetNext() as single
t+=1
return (abs(frac(1.0/SampleRate*Freq*t+fm)*4-2)-1)
end function
Function TriangleWave (Freq as single) as TriangleWaveFunction ptr
dim w as TriangleWaveFunction ptr=new TriangleWaveFunction
w->Freq=Freq
return w
end function
type PulseWaveFunction extends SoundFunction
Freq as single
DutyCycle as single
declare function GetNext() as single
end type
function PulseWaveFunction.GetNext() as single
t+=1
if child<>0 then DutyCycle=child->GetNext/2+.5
return ((frac(1.0/SampleRate*Freq*t+fm)>DutyCycle)*2+1)
end function
Function PulseWave Overload(Freq as single, DutyCycle as single=.5) as PulseWaveFunction ptr
dim w as PulseWaveFunction ptr=new PulseWaveFunction
w->Freq=Freq
w->DutyCycle=DutyCycle
return w
end function
Function PulseWave Overload(Freq as single, DutyCycle as any ptr) as PulseWaveFunction ptr
dim w as PulseWaveFunction ptr=new PulseWaveFunction
w->Freq=Freq
w->child=DutyCycle
return w
end function
type SawtoothWaveFunction extends SoundFunction
Freq as single
declare function GetNext() as single
end type
function SawtoothWaveFunction.GetNext() as single
t+=1
return (frac(1.0/SampleRate*Freq*t+fm)*2-1)
end function
Function SawtoothWave (Freq as single) as SawtoothWaveFunction ptr
dim w as SawtoothWaveFunction ptr=new SawtoothWaveFunction
w->Freq=Freq
return w
end function
type NoiseWaveFunction extends SoundFunction
declare function GetNext() as single
end type
function NoiseWaveFunction.GetNext() as single
return rnd*2-1
end function
Function NoiseWave () as NoiseWaveFunction ptr
dim w as NoiseWaveFunction ptr=new NoiseWaveFunction
return w
end function
type HarmonicWaveFunction extends SoundFunction
Freq as single
harmonic(1 to 10) as single
declare function GetNext() as single
end type
function HarmonicWaveFunction.GetNext() as single
t+=1
dim r as single, w as single
w=6.28/SampleRate*Freq*t+fm
r+=sin(w)*harmonic(1)
r+=sin(2*w)*harmonic(2)
r+=sin(3*w)*harmonic(3)
r+=sin(4*w)*harmonic(4)
r+=sin(5*w)*harmonic(5)
r+=sin(6*w)*harmonic(6)
r+=sin(7*w)*harmonic(7)
r+=sin(8*w)*harmonic(8)
r+=sin(9*w)*harmonic(9)
r+=sin(10*w)*harmonic(10)
return r
end function
Function HarmonicWave (Freq as single, _
h1 as single=1, h2 as single=0, h3 as single=0, h4 as single=0, h5 as single=0,_
h6 as single=0, h7 as single=0, h8 as single=0, h9 as single=0, h10 as single=0)_
as HarmonicWaveFunction ptr
dim w as HarmonicWaveFunction ptr=new HarmonicWaveFunction
w->Freq=Freq
dim as single divisor
divisor=abs(h1)+abs(h2)+abs(h3)+abs(h4)+abs(h5)+abs(h6)+abs(h7)+abs(h8)+abs(h9)+abs(h10)
w->Harmonic(1)=h1/divisor
w->Harmonic(2)=h2/divisor
w->Harmonic(3)=h3/divisor
w->Harmonic(4)=h4/divisor
w->Harmonic(5)=h5/divisor
w->Harmonic(6)=h6/divisor
w->Harmonic(7)=h7/divisor
w->Harmonic(8)=h8/divisor
w->Harmonic(9)=h9/divisor
w->Harmonic(10)=h10/divisor
return w
end function
type FilterFunction extends SoundFunction
cutoffFreq as single
pass as integer
resonance as single
as single pole0, pole1, pole2, pole3, pole4
as single oldpole0,oldpole1,oldpole2,oldpole3,oldpole4
declare function GetNext() as single
end type
function FilterFunction.GetNext() as single
dim as single f,q, p
if child2=0 then
f=sin(3.1415926*cutoffFreq/SampleRate) 'frequency
else
f=sin(3.1415926*cutoffFreq*(child2->GetNext/2+.5)/SampleRate) 'frequency
end if
'the following two lines are a quick approx of q=r*e^(1-f)*loge(4)
q=1-f
q=resonance*(1+q+q*q*0.5+q*q*q*0.167)*1.386294
pole0=1e-20 + child->GetNext -pole4*q
p=f+f-1
pole1=(pole0+oldpole0)*f-p*pole1
pole2=(pole1+oldpole1)*f-p*pole2
pole3=(pole2+oldpole2)*f-p*pole3
pole4=(pole3+oldpole3)*f-p*pole4
oldpole0=pole0
oldpole1=pole1
oldpole2=pole2
oldpole3=pole3
if pass=1 then
return pole4
elseif pass=2 then
return pole0-pole4
elseif pass=3 then
return pole1-pole4
elseif pass=4 then
return pole0+pole4-pole1
end if
end function
Function DSPFilter Overload(func as any ptr, cutoff as single, p as integer=1, res as single=0) as FilterFunction ptr
dim w as FilterFunction ptr=new FilterFunction
w->cutoffFreq=cutoff
w->pass=p
w->resonance=res
w->child=func
return w
end function
Function DSPFilter Overload(func as any ptr, cutoff as single, func2 as any ptr, p as integer=1, res as single=0) as FilterFunction ptr
dim w as FilterFunction ptr=new FilterFunction
w->cutoffFreq=cutoff
w->pass=p
w->resonance=res
w->child=func
w->child2=func2
return w
end function
type SyncWaveFunction extends SoundFunction
Freq as single
declare function GetNext() as single
end type
function SyncWaveFunction.GetNext() as single
t+=1
if (1.0/SampleRate*Freq*t+fm)>1 then child->t=0:t=0
return child->getnext
end function
Function SyncWave (func as any ptr, Freq as single) as SyncWaveFunction ptr
dim w as SyncWaveFunction ptr=new SyncWaveFunction
w->child=func
w->Freq=Freq
return w
end function
type FrequencyModulateFunction extends SoundFunction
modulator as single
declare function GetNext() as single
end type
function FrequencyModulateFunction.GetNext() as single
if Modulator then
child->fm=child2->GetNext()*modulator
return child->getnext
else
child->t+=child2->GetNext()
return child->getnext
end if
end function
function FrequencyModulate(func1 as any ptr, func2 as any ptr, modul as single, detune as integer=0) as FrequencyModulateFunction ptr
dim w as FrequencyModulateFunction ptr=new FrequencyModulateFunction
w->child=func1
w->child2=func2
w->modulator=modul
w->child2->t+=detune
return w
end function
type AmplitudeModulateFunction extends SoundFunction
ringmodulator as integer
declare function GetNext() as single
end type
function AmplitudeModulateFunction.GetNext() as single
if ringmodulator then
return child->getnext*child2->GetNext()
else
return child->getnext*(child2->GetNext()+1)/2
end if
end function
function AmplitudeModulate(func1 as any ptr, func2 as any ptr, ring as integer=0, detune as integer=0) as AmplitudeModulateFunction ptr
dim w as AmplitudeModulateFunction ptr=new AmplitudeModulateFunction
w->child=func1
w->child2=func2
w->ringmodulator=ring
w->child2->t+=detune
return w
end function
type MixWavesFunction extends SoundFunction
declare function GetNext() as single
end type
function MixWavesFunction.GetNext() as single
return (child->getnext+child2->GetNext())/2
end function
function MixWaves(func1 as any ptr, func2 as any ptr, detune as integer=0) as MixWavesFunction ptr
dim w as MixWavesFunction ptr=new MixWavesFunction
w->child=func1
w->child2=func2
w->child2->t+=detune
return w
end function
type EnvelopeFunction extends SoundFunction
A as integer
D as integer
S as integer
R as integer
Incr as single
DecD as single
DecR as single
Amplitude as single
declare function GetNext() as single
end type
function EnvelopeFunction.GetNext() as single
IF t <= A THEN
Amplitude+=Incr
ELSEIF t < D THEN
Amplitude-=DecD
ELSEIF t < S THEN
ELSEIF t < R THEN
Amplitude-=DecR
END IF
t+=1
if child=0 then
return Amplitude*2-1
else
return Amplitude*child->getnext
end if
end function
function ADSREnvelope Overload(Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single) as EnvelopeFunction ptr
dim w as EnvelopeFunction ptr=new EnvelopeFunction
w->Duration=dur
dim as single S = 1 - Attack - Decay - Release
w->Incr = 1 / (Dur*SampleRate * Attack + 1)
w->DecD = (1 - Sustain) / (Dur*SampleRate * Decay + 1)
w->DecR = Sustain / (Dur*SampleRate * Release + 1)
w->A = Attack*Dur*SampleRate
w->D = Decay*Dur*SampleRate + w->A
w->S = S*Dur*SampleRate + w->D
w->R = Release*Dur*SampleRate + w->S
return w
end function
function ADSREnvelope Overload(func as any ptr, Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single) as EnvelopeFunction ptr
dim w as EnvelopeFunction ptr=new EnvelopeFunction
w->child=func
w->Duration=dur
dim as single S = 1 - Attack - Decay - Release
w->Incr = 1 / (Dur*SampleRate * Attack + 1)
w->DecD = (1 - Sustain) / (Dur*SampleRate * Decay + 1)
w->DecR = Sustain / (Dur*SampleRate * Release + 1)
w->A = Attack*Dur*SampleRate
w->D = Decay*Dur*SampleRate + w->A
w->S = S*Dur*SampleRate + w->D
w->R = Release*Dur*SampleRate + w->S
return w
end function
sub sound overload (func as SoundFunction ptr, duration as single)
dim samples as integer=duration * SampleRate
dim SoundBuffer(samples) as short
for i as integer=0 to samples
SoundBuffer(i)= func->GetNext*32767
next
PlayBuffer @SoundBuffer(0), samples
delete func
end sub
To compile it, you need a streaming module; if you use windows, use this one:
http://freebasic.net/forum/viewtopic.php?f=6&t=23099
If you use Linux, use this other:
http://freebasic.net/forum/viewtopic.php?f=5&t=23122
And if you use DOS (yes, DOS is supported, too):
http://freebasic.net/forum/viewtopic.php?f=4&t=23123