FBSFX: a library to produce sound effects in FreeBasic

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
angros47
Posts: 2409
Joined: Jun 21, 2005 19:04

FBSFX: a library to produce sound effects in FreeBasic

Post by angros47 »

This is a set of functions to produce sound effects, simulating a PSG (programmable sound generator) chip. It features four wave generators (a sine wave, a triangle wave, a pulse wave, and a sawtooth wave), amplitude and frequency modulation, an ADSR envelope generator, and a four poles filter.

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
It can be used as a base to build a simulator of some famous sound chips (like the SID), or to create quick effects, like the sfxr program.

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
Last edited by angros47 on Jan 04, 2015 22:38, edited 2 times in total.
angros47
Posts: 2409
Joined: Jun 21, 2005 19:04

Re: FBSFX: a library to produce sound effects in FreeBasic

Post by angros47 »

Some examples:

Code: Select all

SoundSet 44100,1,16

sound pulsewave(100),3               'classic QBASIC-like sound
sleep 2000
sound ADSREnvelope(FrequencyModulate(SineWave(3000),ADSREnvelope(SineWave(10), 0.6,.2,.7,.2,2),1000), 0.5,.2,1,.1,2),3    'UFO effect
sleep 2000
sound ADSREnvelope(FrequencyModulate(SineWave(500),ADSREnvelope(SineWave(500), 0,.1,.5,.6,5),30), 0,.1,.01,.5,5),5  'Guitar effect

sleep
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Re: FBSFX: a library to produce sound effects in FreeBasic

Post by Landeel »

Wow, it's very useful. Thank you.
angros47
Posts: 2409
Joined: Jun 21, 2005 19:04

Re: FBSFX: a library to produce sound effects in FreeBasic

Post by angros47 »

Added synchronization and mixing

Ok, maybe some documentation is needed:

SOUND

Syntax: SOUND waveform, duration

"Duration" is expressed in seconds; waveform is a function (or a set of combined functions) that defines the sound, its frequency, its timbre, and its evolution over time.

The simple wave form is a pure sine wave: the syntax is

SineWave(Frequency)

"Frequency" is the number of oscillations per second. It produces a diapason-like sound: there are no harmonics at all; by combining different sine waves, in theory every possible timbre could be created (it's called "additive synthesis"); a sine wave can also be used, at low frequencies, as a modulator (see below)

Another simple wave function is the triangle wave:

TriangleWave(Frequency)

It contains only odd harmonics, that decrease proportionally to the square of their number (the 3th harmonic is 1/9th of the fundamental); often, they are barely audible, and the sound is almost identical to a sine wave; triangle wave was used on some old synthesizers (because was easier to synthesize than a real sine wave), or can be useful as a modulator.

A more interesting wave is the saw tooth:

SawToothWave(Frequency)

It contains all the harmonics, that decrease proportionally to their number, so can be heard clearly; by selectively removing some harmonics, leaving the others, it's possible to recreate almost every timbre with a good approximation (this is called "subtractive synthesis")

Another harmonic-rich waveform is the pulse wave (the most used pulse wave is the square wave: it's the same wave used by the pc speaker to produce a beep)

PulseWave(Frequency [,duty cycle])

"Duty cycle" is an optional parameter: if it's not set, 0.5 will be used, resulting in a square wave (50% of the wave is above, and 50% is below); a value between 0 and 1 can be used... or you can use another function (i.e. a triangle wave) to have a duty cycle that change over time. A square wave contains only odd harmonics; other values for duty cycle will result in different combinations (i.e. a duty cycle of one third, or 0.3333333, will result in every 3th harmonics missing).

The last waveform is the white noise, that contains all harmonics and disharmonic waves:

NoiseWave()

it has no frequency parameter, since it already has all frequencies; the only wave to change its pitch is to filter it. The white noise is used to simulate percussions, or to create sound effects: by using an envelope generator (see below) explosions, shots, applauses can be achieved.


A basic wave form can be filtered: filtering means removing unwanted frequencies; a filter must have a cut-off value, and can do four things: it can remove all frequencies that are above the cut-off (it's called low-pass filter: only low frequencies can pass), or below it (high-pass filter); it can let pass only frequencies close to the cut-off (band-pass) or block them (reject band).

The syntax is:

DSPFilter(waveform, cut-off, [modulator,] behaviour [, resonance])

Of course, "waveform" is the function to be filtered (it can also be another filter-function: filters can be put in sequence); behaviour describe what kind of filter has to be used: 1-low pass, 2-high pas, 3-band pass, 4-reject band; by default, it's 1; it's also possible to put a sound function as a modulator: in the case, the cut-off frequency will vary over the time, from zero (no sound) to the cut-off value; an envelope generator can be used as a modulator, and, with a low-pass filter, will produce a classic ADSR envelope, but the sound will fade to a simpler spectrum instead of just decreasing its volume.
The last optional parameter is resonance: it can be any value from 0 to 1 (by default it's 0), and it makes sense in a low-pass filter: frequencies close to the cut-off value are improved, getting a sharper "cut".


Since a sound is usually not constant, but varies in the time, an envelope generator is provided; the sound is divided in 4 stages, called Attack (the sound, starting from zero, reach the maximum volume), Decay (the volume decreases), Sustain (the volume stop decreasing), Release (the volume goes to zero): the syntax is:

ADSREnvelope ([waveform], Attack, Decay, Sustain, Release, Duration)

"Attack", "Decay" and "Release" are values between 0 and 1, and set the length of each phase (their sum must be less than 1), as a percentage of the total "Duration" (since an ADSR envelope does not necessarily last as the complete sound wave, this parameter is needed); "Sustain" is the sustain level (0=no sound, 1=full sound); "waveform" is optional: if one waveform is given, the envelope will modulate its volume; otherwise, the envelope generator will just return an envelope function, to be used in other functions (i.e. the DSP filter, or the duty cycle of a pulse wave)

There are more advanced options: synchronization, modulation, and mixing

Synchronization means resetting a sound at interval of times: it was used to produce harmonic-rich sound from simpler functions; it could also simulate some waveforms available on the AdLib sound card; syntax is:

SyncWave (waveform, Frequency)

Given a "Frequency" of f, the waveform will be restarted f times per second; with a sawtooth, interesting results can be achieved if sync frequency is lower than sawtooth frequency; with a sine wave, a double sync frequency will produce a rectified sine wave

About modulation: a low frequency oscillator can modulate a wave frequency (vibrato effect) or amplitude (tremolo effect); if modulator frequency is higher, an entire new timbre can be achieved. The frequency can be modulated with the command:

FrequencyModulate(waveform, modulator waveform, m, [detune])

"Waveform" frequency will vary according to the "modulator waveform"; only a pure waveform can be modulated (i.e., a filter function, or an ADSR envelope, can not be used as "waveform": just put the filter/envelope outside the "FrequencyModulate" command); the modulator can be any waveform (even a filtered/enveloped one). The white noise cannot be modulated, since it has no defined frequency. The "m" parameter defines the kind of moduletion: a value of 0 will use true frequency modulation, other values will set phase modulation (with a sine wave modulator, the result is similar: in phase modulation frequency is not affected by the function, but by its derivate, and the derivate of a sine wave is also a sine wave): in phase modulation, "m" set also the modulator amplitude. The last parameter is optional, and is used to set a different phase for the two waveforms.

To modulate amplitude, the command is:
AmplitudeModulate(waveform, modulator waveform, ring, [detune])

Its syntax is similar to the previous one, but every function can be modulated (including white noise, or filtered functions); the "ring" parameters, if zero, sets pure amplitude modulation, if 1, sets ring modulation (almost the same thing, but the modulator can be negative and invert the waveform)

Last but not least: since "SOUND" accepts only one function at time, to play two waveform concurrently just use:

MixWaves (waveform 1, waveform 2 [, detune])

It build a single wave from two.
angros47
Posts: 2409
Joined: Jun 21, 2005 19:04

Re: FBSFX: a library to produce sound effects in FreeBasic

Post by angros47 »

Added HarmonicWave; syntax is

HarmonicWave (Frequency, 1st harmonic, 2nd harmonic, ..... 10th harmonic)

Given a fundamental frequency, it produces a waveform that may contain the first 10 harmonics of this frequency (including the fundamental, or first harmonic); for each harmonic the amplitude can be specified: i.e HarmonicWave(freq,1,1/2,1/3,1/5,1/6,1/7,1/8,1/9,1/10) produces a sawtooth wave; harmonics can also be negative, to invert phase.

Oh, this is a couple of subs to save a sound to a file:

Code: Select all

#define FCC(c) *(cptr(Uinteger Ptr,@##c))

Sub PrepareBuffer(Byval filenum As integer) 'based on work by d.j.peters
            
	Dim As Uinteger  h (10)
	Dim As Uinteger     BlkAlign=2

	h( 0)=FCC("RIFF")                ' RIFF chunk
	h( 1)=0                          ' size of WAVE chunk + data size
	h( 2)=FCC("WAVE")                ' WAVE chunk
	h( 3)=FCC("fmt ")                ' fmt chunk
	h( 4)=16                         ' size of fmt chunk
	h( 5)=(1 Shl 16) Or 1            ' channels + PCM_FORMAT flag
	h( 6)=SampleRate                 ' playback rate
	h( 7)=BlkAlign*SampleRate        ' bytes per sec.
	h( 8)=(16 Shl 16) Or BlkAlign    ' bits per sample + blockalign
	h( 9)=FCC("data")                ' data chunk
	h(10)=0                          ' size of data chunk

	put #filenum, 1, h()
End Sub

sub WriteSoundFile overload (Byval filenum As integer, func as SoundFunction ptr, duration as single)
	dim samples as integer=duration * SampleRate
	static size as integer

	dim SoundBuffer(samples) as short
	
	for i as integer=0 to samples
		SoundBuffer(i)= func->GetNext*32767
	next

	put #filenum, ,SoundBuffer()

	size+=samples*2
	put #1, 41, size
	size+=36
	put #1, 5, size
	size-=36

	delete func
end sub

open "soundtest.wav" for binary as 1
PrepareBuffer 1
writesoundfile 1, TriangleWave(1000) ,10    'You can use another function, of course
close 1


Post Reply