///////////////////////////////////////////////////////////////////////////////////
// remember to add -dUseCThreads to Project -> Project Options -> Custom Options //
///////////////////////////////////////////////////////////////////////////////////
//
// include this file near the top of your implementation section with:
//
// {$I beeper.inc}
//
// and in your startup code activate the threading with:
//
// TCheckThread.Create(false)
//
// you also need to add -dUseCThreads to the compiler custom options
// for the threading to work. threading is used to allow the ALSAbeep
// routine to function without blocking the rest of your application.
//
// to queue a bell sounding do the following:
//
// if BELL<16 then inc(BELL);
//
// the variable BELL contains the number of queued bell activations,
// hence the placing of an upper limit to stop the sound driving you
// mad if you inadvertentantly queue up too many! the thread decrements
// the value of BELL as each bell sounding is processed, and you can
// check if the bell is currently sounding with:
//
// if BELL<>0 then...
//
///////////////////////////////////////////////////////////////////////////////////
//
// suggested improvements:
//
// - turn into a unit
// - use a suitable sample rate that is lower than 48000
// - as a simple "bell" can used a pre-encoded sample
// - use non-blocking ALSA calls so doesn't need threading
//
//
// Robert Rozee, 30-April-2020
// rozee@mail.com
//
///////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////
// the below ALSA types, constants and functions are copied //
// from the pwm.inc file that is a part of fpAlsa //
//////////////////////////////////////////////////////////////
const
libasound = 'asound';
type
{ Signed frames quantity }
//Psnd_pcm_sframes_t = ^snd_pcm_sframes_t;
snd_pcm_sframes_t = cint;
{ PCM handle }
PPsnd_pcm_t = ^Psnd_pcm_t;
Psnd_pcm_t = Pointer;
{ PCM stream (direction) }
//Psnd_pcm_stream_t = ^snd_pcm_stream_t;
snd_pcm_stream_t = cint;
{ PCM sample format }
//Psnd_pcm_format_t = ^snd_pcm_format_t;
snd_pcm_format_t = cint;
{ PCM access type }
//Psnd_pcm_access_t = ^snd_pcm_access_t;
snd_pcm_access_t = cint;
{ Unsigned frames quantity }
//Psnd_pcm_uframes_t = ^snd_pcm_uframes_t;
snd_pcm_uframes_t = cuint;
const
{ Playback stream }
SND_PCM_STREAM_PLAYBACK: snd_pcm_stream_t = 0;
{ Unsigned 8 bit }
SND_PCM_FORMAT_U8: snd_pcm_format_t = 1;
{ snd_pcm_readi/snd_pcm_writei access }
SND_PCM_ACCESS_RW_INTERLEAVED: snd_pcm_access_t = 3;
function snd_pcm_open(pcm: PPsnd_pcm_t; name: PChar;
stream: snd_pcm_stream_t; mode: cint): cint; cdecl; external libasound;
function snd_pcm_set_params(pcm: Psnd_pcm_t; format: snd_pcm_format_t;
access: snd_pcm_access_t; channels, rate: cuint; soft_resample: cint;
latency: cuint): cint; cdecl; external libasound;
function snd_pcm_writei(pcm: Psnd_pcm_t; buffer: Pointer;
size: snd_pcm_uframes_t): snd_pcm_sframes_t; cdecl; external libasound;
function snd_pcm_recover(pcm: Psnd_pcm_t; err, silent: cint): cint; cdecl; external libasound;
function snd_pcm_drain(pcm: Psnd_pcm_t): cint; cdecl; external libasound;
function snd_pcm_close(pcm: Psnd_pcm_t): cint; cdecl; external libasound;
/////////////////////////////////////////////////////////////
function ALSAbeep(frequency, duration, volume:integer; warble:boolean):boolean;
var buffer:array[0..9600-1] of byte; // 1/5th second worth of samples @48000Hz
frames:snd_pcm_sframes_t; // number of frames written (negative if an error occurred)
pcm:PPsnd_pcm_t; // sound device handle
I,FC:integer;
SA:array[0..359] of shortint; // array of sine wave values for a single cycle
const device='default'+#0; // name of sound device
var count1,count2,N,X:integer;
begin
result:=false;
if snd_pcm_open(@pcm, @device[1], SND_PCM_STREAM_PLAYBACK, 0)=0 then
if snd_pcm_set_params(pcm, SND_PCM_FORMAT_U8,
SND_PCM_ACCESS_RW_INTERLEAVED,
1, // number of channels
48000, // sample rate (Hz)
1, // resampling on/off
500000)=0 then // latency (us)
begin
result:=true;
frequency:=abs(frequency); // -\
duration:=abs(duration); // |-- ensure no parameters are negative
volume:=abs(volume); // -/
if frequency<20 then frequency:=20; // -\
if duration<50 then duration:=50; // |-- restrict parameters to usable ranges
if volume>100 then volume:=100; // -/
for I:=0 to 359 do SA[I]:=round(sin(pi*I/180.0)*volume); // create sine wave pattern
X:=0;
N:=0; // up/down counter used by unequal interval division
count1:=0; // count1 counts up, count2 counts down
count2:=duration*48; // (at 48000Hz there are 48 samples per ms)
while count2>0 do // start making sound!
begin
FC:=0;
for I:=0 to sizeof(buffer)-1 do // fill buffer with samples
begin
if count2>0 then begin
if count1<480 then buffer[I]:=128 + ((count1*SA[X]) div 480) else // 10ms feather in
if count2<480 then buffer[I]:=128 + ((count2*SA[X]) div 480) else // 10ms feather out
buffer[I]:=128 + SA[X];
if warble and odd(count1 div 120) then buffer[I]:=128; // 200Hz warble
inc(FC)
end
else begin
buffer[I]:=128; // no signal on trailing end of buffer, just in case
if (FC mod 2400)<>0 then inc(FC) // keep increasing FC until is a multiple of 2400
end;
inc(N,frequency*360); // unequal interval division routine
while (N>0) do begin // (a variation on Bresenham's Algorithm)
dec(N,48000);
inc(X)
end;
X:=X mod 360;
inc(count1);
dec(count2)
end;
frames:=snd_pcm_writei(pcm, @buffer, max(2400, FC)); // write AT LEAST one full period
if frames<0 then frames:=snd_pcm_recover(pcm, frames, 0); // try to recover from any error
if frames<0 then break // give up if failed to recover
end;
snd_pcm_drain(pcm); // drain any remaining samples
snd_pcm_close(pcm)
end
end;
///////////////////////////////////////////////////////////////////////////////////
const BELL:byte=0; // increment to sound bell
// (use a byte to ensure is atomic)
///////////////////////////////////////////////////////////////////////////////////
type TCheckThread = class(TThread)
private
protected
procedure Execute; override;
end;
// separate thread used to check for command to activate bell
procedure TCheckThread.Execute;
begin
while true do
begin
if BELL>0 then begin
// ALSAbeep(440, 100, 100, false); // basic bell sound
ALSAbeep(420, 100, 100, true); // fancy bell sound
dec(BELL)
end
else sleep(100)
end
end;