SoundFunction.bas contains the function ADSREnvelope. For test purposes I copied it as ADSREnvelope2 into my program.
In function EnvelopeFunction.GetNext Amplitude is incremented or decremented very often and Amplitude can get greater than 1 or lesser than 0.
That is a problem of adding rounded floating-point numbers.
With this program I tried to avoid this problem.
There are three additional lines in EnvelopeFunction2.GetNext and a variable SilenceAdjust, which can be useful in the case sustain=0.
Code: Select all
#cmdline "-mt -exx"
#include "sfx.bi"
#inclib "fbsfx"
common shared __Samplerate as integer
''===================================================
type EnvelopeFunction2 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 EnvelopeFunction2.GetNext() as single
IF t <= A THEN
Amplitude+=Incr
if Amplitude > 1 then Amplitude = 1
ELSEIF t < D THEN
Amplitude-=DecD
if Amplitude < 0 then Amplitude = 0
ELSEIF t < S THEN
ELSEIF t < R THEN
Amplitude-=DecR
if Amplitude < 0 then Amplitude = 0
END IF
t+=1
if child=0 then
return Amplitude*2-1
else
return Amplitude*child->getnext
end if
end function
function ADSREnvelope2 Overload(Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, SilenceAdjust as integer=0) as EnvelopeFunction2 ptr
dim w as EnvelopeFunction2 ptr=new EnvelopeFunction2
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 - SilenceAdjust
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 ADSREnvelope2 Overload(func as any ptr, Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, SilenceAdjust as integer=0) as EnvelopeFunction2 ptr
dim w as EnvelopeFunction2 ptr=new EnvelopeFunction2
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 - SilenceAdjust
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
''===================================================
dim as integer samplerate,channels,bits
samplerate=44100
channels=1
bits=16
SoundSet(samplerate,channels,bits)
''===================================================
dim as single f,duration
f=440
duration=1
dim shared as WaveHeaderType ptr wave(1 to 6),tempwave
dim as long buffersize,i
buffersize=samplerate*duration
for i=lbound(wave) to ubound(wave)
wave(i)=CreateWave(buffersize,samplerate,channels,bits)
next i
tempwave=CreateWave(buffersize,samplerate,channels,bits)
dim as single a,d,s,r
dim as integer j
a=0.04 : d= 0.49 : s=0 : r=0.22 : j=1
Sound tempwave,0,SineWave(f),duration
Sound wave(1),0,ADSREnvelope(DSPWave(tempwave),a,d,s,r,duration),duration
Sound wave(2),0,AmplitudeModulate(DSPWave(tempwave),ADSREnvelope(a,d,s,r,duration)),duration
Sound wave(3),0,ADSREnvelope(a,d,s,r,duration),duration
Sound wave(4),0,ADSREnvelope2(DSPWave(tempwave),a,d,s,r,duration,j),duration
Sound wave(5),0,AmplitudeModulate(DSPWave(tempwave),ADSREnvelope2(a,d,s,r,duration,j)),duration
Sound wave(6),0,ADSREnvelope2(a,d,s,r,duration,j),duration
for i=lbound(wave) to ubound(wave)
SaveWave("test" & str(i) & ".wav",wave(i))
next i
PlayWave(wave(1))
PlayWave(wave(2))
PlayWave(wave(4))
PlayWave(wave(5))
sleep
Code: Select all
'' https://www.freebasic.net/wiki/ExtLibsfx
'' https://en.wikipedia.org/wiki/Piano_key_frequencies
#cmdline "-mt -exx"
#include "sfx.bi"
#inclib "fbsfx"
common shared __Samplerate as integer
''===================================================
type EnvelopeFunction2 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 EnvelopeFunction2.GetNext() as single
IF t <= A THEN
Amplitude+=Incr
if Amplitude > 1 then Amplitude = 1
ELSEIF t < D THEN
Amplitude-=DecD
if Amplitude < 0 then Amplitude = 0
ELSEIF t < S THEN
ELSEIF t < R THEN
Amplitude-=DecR
if Amplitude < 0 then Amplitude = 0
END IF
t+=1
if child=0 then
return Amplitude*2-1
else
return Amplitude*child->getnext
end if
end function
function ADSREnvelope2 Overload(Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, SilenceAdjust as integer=0) as EnvelopeFunction2 ptr
dim w as EnvelopeFunction2 ptr=new EnvelopeFunction2
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 - SilenceAdjust
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 ADSREnvelope2 Overload(func as any ptr, Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, SilenceAdjust as integer=0) as EnvelopeFunction2 ptr
dim w as EnvelopeFunction2 ptr=new EnvelopeFunction2
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 - SilenceAdjust
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
''===================================================
type TriangleSweepFunction extends SoundFunction
Freq as single
DutyCycle as single
declare function GetNext() as single
end type
function TriangleSweepFunction.GetNext() as single
t+=1
if child<>0 then DutyCycle=child->GetNext/2+.5
dim as single r,dc
r=1.0/__Samplerate*Freq*t+fm
dc=((4*DutyCycle-1)*8*DutyCycle+1)/5
return (abs(((r-int(r))^(dc))*4-2)-1)
end function
function TriangleSweep overload(Freq as single, DutyCycle as single=.5) as TriangleSweepFunction ptr
dim w as TriangleSweepFunction ptr=new TriangleSweepFunction
w->Freq=Freq
w->DutyCycle=DutyCycle
return w
end function
function TriangleSweep overload(Freq as single, DutyCycle as any ptr) as TriangleSweepFunction ptr
dim w as TriangleSweepFunction ptr=new TriangleSweepFunction
w->Freq=Freq
w->child=DutyCycle
return w
end function
''===================================================
dim as long numberoftones=20 ' number is chosen freely
dim as long buffersize,i,n(1 to numberoftones) ' n: MIDI note number
dim as single start,duration,d(1 to numberoftones) ' d: duration
n(1)=64 : d(1)=5
n(2)=n(1)-2 : d(2)=3
n(3)=n(1) : d(3)=3
n(4)=n(1)+5 : d(4)=6
function MidiNoteToFrequency(n as long) as single
return (2^((n-69)/12))*440
end function
'change duration of tones
for i=lbound(n) to ubound(n)
d(i)/=6
next i
dim as integer samplerate,channels,bits
samplerate=44100
channels=1
bits=16
SoundSet(samplerate,channels,bits)
''---------------------------------------------------
'calculate duration of full sound
duration=0
for i=lbound(d) to ubound(d)
duration+=d(i)
next i
dim shared as WaveHeaderType ptr wave(1 to 2),tempwave
buffersize=samplerate*duration
for i=lbound(wave) to ubound(wave)
wave(i)=CreateWave(buffersize,samplerate,channels,bits)
next i
tempwave=CreateWave(buffersize,samplerate,channels,bits)
sub tone(start as single,n as long,d as single)
Sound tempwave,0,TriangleSweep(MidiNoteToFrequency(n),SineWave(1/d)),d
Sound wave(1),start,ADSREnvelope2(DSPWave(tempwave),0.15,0.25,0.9,0.1,d),d
Sound tempwave,0,TriangleSweep(MidiNoteToFrequency(n+5),SineWave(1/d)),d
Sound wave(2),start,ADSREnvelope2(DSPWave(tempwave),0.1,0.2,0.8,0.1,d),d
end sub
'fill buffers
start=0
for i=lbound(n) to ubound(n)
tone(start,n(i),d(i))
start+=d(i)
next i
''---------------------------------------------------
dim as WaveHeaderType ptr mixwave
mixwave=CreateWave(samplerate*(duration+0.1),samplerate,channels,bits)
Sound mixwave,0.03,MixWaves(DSPWave(wave(1)),DSPWave(wave(2))),duration
''SaveWave("test.wav",mixwave)
PlayWave(mixwave)
sleep