Sfx has it. Please see wave.bas and wave.bi. Now the files are played in the right pitch.
ADSR with exponential release. Silence adjusting can be constructed with ADSREnvelope, if necessary:
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 ExpADSREnvelopeFunction 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
timeconstant as single
declare function GetNext() as single
end type
function ExpADSREnvelopeFunction.GetNext() as single
IF t <= A THEN
Amplitude+=Incr ' Amplitude+=(1-Amplitude)*Incr/timeconstant
if Amplitude > 1 then Amplitude = 1
ELSEIF t < D THEN
Amplitude-=DecD ' Amplitude-=Amplitude*DecD/timeconstant
if Amplitude < 0 then Amplitude = 0
ELSEIF t < S THEN
ELSEIF t < R THEN
Amplitude-=Amplitude*DecR/timeconstant ' Difference equation for exponential function: Amplitude=Amplitude*(1-DecR/timeconstant)
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 ExpADSREnvelope Overload(Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, timeconstant as single) as ExpADSREnvelopeFunction ptr
dim w as ExpADSREnvelopeFunction ptr=new ExpADSREnvelopeFunction
w->timeconstant=timeconstant
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 ExpADSREnvelope Overload(func as any ptr, Attack as single, Decay as single, Sustain as single, Release as Single, Dur as single, timeconstant as single) as ExpADSREnvelopeFunction ptr
dim w as ExpADSREnvelopeFunction ptr=new ExpADSREnvelopeFunction
w->child=func
w->timeconstant=timeconstant
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 ShowWave(buffer as WaveHeaderType ptr)
open cons for output as #1
print #1, mkl(buffer->RiffID),"RIFF"
print #1, buffer->RiffLength,"Riff Length = File Length - 8"
print #1, mkl(buffer->WavID),"WAVE"
print #1, mkl(buffer->FmtID),"fmt "
print #1, buffer->FmtLength,"Fmt Length (16)"
print #1, buffer->wavformattag,"Format Tag (1: PCM)"
print #1, buffer->Channels,"Channels"
print #1, buffer->SamplesPerSec,"Sample Rate"
print #1, buffer->avgBytesPerSec,"Bytes/Second"
print #1, buffer->blockalign,"Block Align"
print #1, buffer->FmtSpecific,"Bits/Sample"
print #1, mkl(buffer->DataID),"data"
print #1, buffer->DataLength,"Data Length = File Length - 44"
print #1, string (44,"=")
close #1
'------------------------------------------------
dim as ulong i
dim as long x,y
x=400 : y=300
screenres (x,y)
cls
if (buffer->Channels) = 2 then line (0,y\2-1)-(x,y\2-1),10
if (buffer->Channels) = 1 then
if (buffer->FmtSpecific) = 16 then
'Print "1,16"
window (0,-32768)-((buffer->DataLength)\2,32767)
dim as short ptr SourcePtr=cast(short ptr,(cast(byte ptr,buffer)+44))
for i=1 to (buffer->DataLength)\2
pset (i-1,SourcePtr[i-1])
next i
else
'print "1,8"
window (0,0)-((buffer->DataLength),255)
dim as ubyte ptr SourcePtr=cast(ubyte ptr,(cast(byte ptr,buffer)+44))
for i=1 to (buffer->DataLength)
pset (i-1,SourcePtr[i-1])
next i
end if
else
if (buffer->FmtSpecific) = 16 then
'print "2,16"
window (0,-32768)-((buffer->DataLength)\2,32767)
dim as short ptr SourcePtr=cast(short ptr,(cast(byte ptr,buffer)+44))
for i=1 to (buffer->DataLength)\2 step 2
pset (i-1,SourcePtr[i-1]\2+16384)
pset (i-1,SourcePtr[i]\2-16384)
next i
else
'print "2,8"
window (0,0)-((buffer->DataLength),255)
dim as ubyte ptr SourcePtr=cast(ubyte ptr,(cast(byte ptr,buffer)+44))
for i=1 to (buffer->DataLength) step 2
pset (i-1,SourcePtr[i-1]\2+128)
pset (i-1,SourcePtr[i]\2)
next i
end if
end if
end sub
''===================================================
dim as long buffersize,i
dim as single d,n ' d: duration, n: Midi note number
n=48
d=5
function MidiNoteToFrequency(n as single) as single
return (2^((n-69)/12))*440
end function
dim as integer samplerate,channels,bits
samplerate=44100
channels=2
bits=16
SoundSet(samplerate,channels,bits)
''------------------------------------------
dim shared as WaveHeaderType ptr pWave(1 to 10)
buffersize=samplerate*d + 1
for i=lbound(pWave) to ubound(pWave)
pWave(i)=CreateWave(buffersize,samplerate,channels,bits)
next i
sub tone(n as single,d as single)
Sound pWave(1),0,ADSREnvelope(0.1,0.1,0.7,0.5,d),d
Sound pWave(2),0,ExpADSREnvelope(0.1,0.1,0.7,0.5,d,0.1),d
if (pWave(3)->channels) = 2 then
Sound pWave(3),0,Stereo(DSPWave(pWave(1)),DSPWave(pWave(2))),d
else
Sound pWave(3),0,DSPWave(pWave(2)),d
end if
''------------------------------------------
Sound pWave(4),0,FrequencyModulate(HarmonicWave(MidiNoteToFrequency(n),1,1,0,0.5,0,0.5),HarmonicWave(MidiNoteToFrequency(n+6.99),1,1,0,0.5,0,0.5),2),d
Sound pWave(5),0,FrequencyModulate(HarmonicWave(MidiNoteToFrequency(n+12),1,1,0,0.5,0,0.5),HarmonicWave(MidiNoteToFrequency(n+12+7.01),1,1,0,0.5,0,0.5),2),d
Sound pWave(6),0,Mixwaves(DSPWave(pWave(4)),DSPWave(pWave(5))),d
Sound pWave(7),0,DspFilter(DSPWave(pWave(6)),3000,1 ,0),d
Sound pWave(8),0,ADSREnvelope(DSPWave(pWave(7)),0.1,0.1,0.7,0.5,d),d
Sound pWave(9),0,ExpADSREnvelope(DSPWave(pWave(7)),0.1,0.1,0.7,0.5,d,0.1),d
' Sound pWave(9),0,ADSREnvelope(ExpADSREnvelope(DSPWave(pWave(7)),0.1,0.1,0.7,0.5,d,0.1),0.01,0,1,0.2,d-0.11),d ' ExpADSREnvelope with silence adjust
if (pWave(10)->channels) = 2 then
Sound pWave(10),0,Stereo(DSPWave(pWave(8)),DSPWave(pWave(9))),d
else
Sound pWave(10),0,DSPWave(pWave(9)),d
end if
end sub
tone(n,d) ' fill buffers
''------------------------------------------
ShowWave(pWave(3))
sleep
ShowWave(pWave(10))
'SaveWave("test.wav",pWave(10))
PlayWave(pWave(10))
' Show ADSREnvelope for silence adjusting ExpADSREnvelope:
sleep
Sound pWave(1),0,ADSREnvelope(0.01,0,1,0.2,d-0.11),d ' overwrites pWave(1), which is no longer needed.
ShowWave(pWave(1))
open cons for output as #1
print #1,"ADSREnvelope for silence adjusting ExpADSREnvelope"
close #1
sleep