////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Sound system for CRW-DAQ. "Sound Blaster".                                 //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20011024 - Creation (uses CRW16)                                           //
// 20011025 - tests, ok                                                       //
// 20011031 - uses UnifyAlias,UnifyFileAlias, ok                              //
// 20030325 - Struggle for safety (add some try/except checks)...             //
// 20030328 - Replace TObjectList to TObjectStorage.                          //
// 20040501 - Set/GetVolume/Speed; PendingVoice, SpeedFactor                  //
// 20230530 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_snd; // Sound Blaster

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5025 off : Local variable "$1" not used}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF UNIX} process, {$ENDIF}
 {$IFDEF WINDOWS} mmsystem, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc, _crw_rtc, _crw_fio, _crw_utf8, _crw_proc, _crw_sect,
 _crw_fifo, _crw_str, _crw_polling, _crw_dynar, _crw_riff;

 {
 Overview.
 This unit contains fast and thread safety sound sybsystem for CRW-DAQ.
 Sounds plays in own sound thread. User thread only put sound commands to fifo,
 it takes no time. Sound thread read and interpret commands and execute this
 commands asynchronously. Sound thread also cache wave-files for speed and
 control memory usage.
 Example:
  program TestBlaster;
  begin
   if InitBlaster(1024*8) then begin
    AddSoundLibrary('c:\windows\media, c\mysounds');
    voice('hello');
    for i:=0 to 100 do voice(IntToStr(i));
    voice('goodby');
   end;
   DoSomethingElse; // :-)
   DoneBlaster;
  end;
 Note: Please, no space chars in file names!!!
 }

type { Callback to log Blaster opertions. }
 TBlasterLoggerCallback = procedure (const Msg:LongString);

const
 BlasterMaxFileSize               = 128*KiloByte; { Max size of *.wav files to play }
 BlasterMinFileSize               = 40;           { Min size of *.wav files for safety }
 BlasterMaxSpeed                  = 4;            { Max sound speed relative to normal }
 BlasterMinRate                   = 1000;         { Minimal rate, samples per second }
 BlasterMaxRate                   = 1000*256;     { Maximal rate, samples per second }
 BlasterDefaultFifoSize           = 4*KiloByte;   { Default fifo for sound commands }
 BlasterFifoGrowFactor            = 2;            { Blaster fifo grow factor }
 BlasterFifoGrowLimit             = 16*MegaByte;  { Blaster fifo grow limit }
 BlasterMemoPollPeriod  : LongInt = 5000;         { Period in msec to poll memory size }
 BlasterMaxDataSize     : LongInt = MegaByte;     { Limit for memory usage }
 EnablePlayBlaster      : Boolean = true;         { Enable/disable PlayBlaster }
 EnableVoice            : Boolean = true;         { Enable/disable Voice }
 EnableSystemVoice      : Boolean = true;         { Enable/disable SysVoice }
 BlasterErrorCount      : SizeInt = 0;            { Count fifo overflow, file not found & etc }
 BlasterAwakeAfterPlay  : Boolean = false;        { Awake sound thread after play item(s) }
 BlasterRunCommandSleep : Integer = 10;           { Sleep time on RunCommand }
 BlasterLoggerVerbosity : Integer = 1;            { LogPlay verbosity level }
 BlasterDefPollingDelay : Integer = 50;           { Default polling delay }
 BlasterLoggerCallback  : TBlasterLoggerCallback = nil;

 {
 Sound detection: get list of sound cards and counter.
 }
function GetListOfSoundCards(Count:PInteger=nil):LongString;
function GetNumberOfSoundCards(Update:Boolean=false):Integer;

 {
 Function creates sound fifo to put sound commands and sound thread to execute
 this commands. FifoSize specify size of fifo for sound commands, DirList specify
 list of directories to search sound files, see also AddSoundLibrary. MaxSubDirs
 uses to search files in subdirectories of given directories.
 Return false if no sound device available. Call this function before all other.
 }
function InitBlaster(FifoSize   : LongInt = 0;
               const DirList    : LongString = '';
                     MaxSubDirs : LongInt = 0 ):Boolean;

 {
 Sound blaster in use now? False if InitBlaster fails or does not called.
 }
function UsesBlaster:Boolean;

 {
 Terminate and free sound thread, free sound commands fifo and sound library.
 }
procedure DoneBlaster;

 {
 Get/set sound volume for Left/Right channel. Volume changes in [0..1] range.
 }
function  GetBlasterVolume(var L,R:Double):Boolean;
function  SetBlasterVolume(L,R:Double):Boolean;

 {
 Get/set sound speed. Speed changes in [1/4..4] range.
 }
function  GetBlasterSpeed(var V:Double):Boolean;
function  SetBlasterSpeed(V:Double):Boolean;

 {
 Play list of wave-files, if EnablePlayList=TRUE. Before play, sound thread
 must be initialized by InitBlaster and sound library must be initialized by
 AddSoundLibrary. The List contains a list of *.wav file names without path
 and extensions with space or comma delimiters. List of wave-files will play
 in another thread and will not takes time in user program thread. PlayBlaser
 only put list of sounds to fifo.
 }
procedure PlayBlaster(const PlayList:LongString);

 {
 Voice will play list of sounds if EnablePlayList=TRUE and EnableVoice=TRUE.
 That is general procedure to play sounds. This procedure calls CoifPlayList
 to convert all numerical values to "vocable" string and then call PlayBlaster.
 }
procedure Voice(const PlayList:LongString);
procedure SysVoice(const PlayList:LongString);

 {
 Clear sound commands fifo. After current playing sound, other sounds will pass.
 Sound library not changes.
 }
procedure StopBlaster;

 {
 Put to sound commands fifo command to add list of directories to sound library.
 All *.wav files from this directories (and subdirectories) will be available
 to play.
 }
procedure AddSoundLibrary(const Path:LongString; MaxSubDirs:LongInt=0);

 {
 Get list of all available sounds
 }
function GetSoundLibrary(FullPath:Boolean=false):LongString;

 {
 Put to sound commands fifo command to clear sound library. After sound library
 clear, no sound available until call AddSoundLibrary
 }
procedure ClearSoundLibrary;

 {
 Return, how many memory use Blaster for file caches. Sound thread periodically
 test memory usage and free some memory if Blaster use too many.
 }
function  BlasterMemoryInUse:LongInt;

 {
 Convert integer value to "vocable" string, contains sound playlist to say this
 value, using standard sound library. For example, 125 convert to "100 20 5".
 }
function SayNumber(n:LongInt):LongString;

 {
 Test all words in PlayList and convert all numbers to playlist,
 for example, "temp 125 degree" converts to "temp 100 20 5 degree".
 }
function CoifPlayList(const PlayList:LongString):LongString;

 {
 }
function BlusterPolling:TPolling;

implementation

 {
 ***************************************************
 Internal constants, variables, routines and classes
 ***************************************************
 }
const
 jobs          : TFifo          = nil;
 SoundLibrary  : TObjectStorage = nil;
 SoundPolling  : TPolling       = nil;
 MemoryInUse   : LongInt        = 0;
 PendingVoice  : LongString     = '';
 PlayingVoice  : LongString     = '';
 SpeedFactor   : Double         = 1;
 cmd_Play                       = 'PLAY';
 cmd_AddLib                     = 'ADDLIB';
 cmd_ClrLib                     = 'CLRLIB';
 waveVolume    : DWORD          = $FFFFFFFF;

type
 TWaveHeader = packed record    // Header of WAVE-files
  dwRIFF          : LongInt;    // 'RIFF' simbols signature
  dwSize          : LongInt;    // must be filesize-8
  dwWave          : LongInt;    // 'WAVE' signature
  dwfmt_          : LongInt;    // 'fmt ' signature
  dwFmtSize       : LongInt;    // sizeof format record
  wFormatTag      : word;       // format type (1=PCM,...)
  nChannels       : word;       // 1=mono,2=stereo
  nSamplesPerSec  : Longint;    // sample rate per second
  nAvgBytesPerSec : Longint;    // rate for buffer estimation
  nBlockAlign     : word;       // block size of data
  nBitsPerSample  : word;       // number of bits per sample
 end;

// Simulate volume control:
// Left/Right Volume takes Lo/Hi Word of waveVolume.
// Range [0..$FFFF] corresponds to volume level [0..1.0].
/////////////////////////////////////////////////////////
function GetWaveVolume(var W:DWORD):Boolean;
begin
 Result:=false;
 if UsesBlaster then begin
  {$IFDEF WINDOWS}
  Result:=(waveOutGetVolume(0,@w)=MMSYSERR_NOERROR);
  {$ENDIF WINDOWS}
  {$IFDEF UNIX}
  Result:=true;
  W:=WaveVolume;
  {$ENDIF UNIX}
 end;
end;
function SetWaveVolume(W:DWORD):Boolean;
begin
 Result:=false;
 if UsesBlaster then begin
  {$IFDEF WINDOWS}
  Result:=(waveOutSetVolume(0,W)=MMSYSERR_NOERROR);
  {$ENDIF WINDOWS}
  {$IFDEF UNIX}
  Result:=true;
  WaveVolume:=W;
  {$ENDIF UNIX}
 end;
end;

// Linux ALSA uses /proc/asound/ for sound devices.
// https://alsa.opensrc.org/Proc_asound_documentation
// Example of 'cat /proc/asound/cards':
//  0 [HDMI           ]: HDA-Intel - HDA Intel HDMI
//                       HDA Intel HDMI at 0xa0610000 irq 31
//  1 [PCH            ]: HDA-Intel - HDA Intel PCH
//                       HDA Intel PCH at 0xa0614000 irq 32
///////////////////////////////////////////////////////
function GetListOfSoundCards(Count:PInteger=nil):LongString;
var Cards,Line,Id:LongString; Lines:TStringList; i,p,n:Integer;
begin
 Result:='';
 try
  if IsUnix then begin
   Lines:=nil;
   if Assigned(Count) then Count^:=0;
   Cards:=Trim(StringFromFile('/proc/asound/cards',0));
   if IsNonEmptyStr(Cards) then
   try
    Lines:=TStringList.Create;
    Lines.Text:=AdjustLineBreaks(Cards);
    for i:=0 to Lines.Count-1 do begin
     Line:=Lines[i]; p:=Pos(':',Line);
     if not HasChars(Line,'[]:') then continue;
     if (p=0) or (Length(Line)-p<1) then continue;
     n:=StrToIntDef(ExtractWord(1,Line,JustSpaces),-1);
     Id:=Trim(Copy(Line,p+1,Length(Line)-p));
     if (n<0) or IsEmptyStr(Id) then continue;
     Result:=Result+Format('%d %s',[n,Id])+EOL;
     if Assigned(Count) then Inc(Count^);
    end;
   finally
    Lines.Free;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfSoundCards');
 end;
end;

// Get number of sound cards installed.
// Use caching for fast (use Update to refresh).
////////////////////////////////////////////////
function GetNumberOfSoundCards(Update:Boolean=false):Integer;
const NCards:Integer=-1;
begin
 if (NCards<0) or Update then begin
  {$IFDEF WINDOWS}
  NCards:=waveOutGetNumDevs;
  {$ENDIF WINDOWS}
  {$IFDEF UNIX}
  NCards:=0; if (GetListOfSoundCards(@NCards)='') then NCards:=0;
  {$ENDIF UNIX}
 end;
 Result:=NCards;
end;

// Specially for UTF8 strings: force to lower.
//////////////////////////////////////////////
function ValidateAlias(s:LongString):LongString;
begin
 if (s<>'') and IsSysUtf8 and utf8_valid(s)
 then Result:=utf8_lowercase(s)
 else Result:=s;
end;

// Play sound virtual logger.
/////////////////////////////
procedure LogPlay(When:Double; Msg:LongString);
begin
 if (Msg<>'') then
 if (BlasterLoggerVerbosity>0) then
 if Assigned(BlasterLoggerCallback) then
 try
  if (When>0) then Msg:=StdDateTimeStr(When,7)+' => '+Msg;
  BlasterLoggerCallback(ValidateEOL(Msg,1,EOL));
 except
  on E:Exception do BugReport(E,nil,'LogPlay');
 end;
end;

// PlayItem - class of Items to Play
////////////////////////////////////
type
 TPlayItem = class(TMasterObject)
 private
  myData    : Pointer;
  myFName   : LongString;
  myAlias   : LongString;
  myHeader  : TWaveHeader;
  function    GetFName:LongString;
  function    GetAlias:LongString;
  function    GetData:Pointer;
  function    GetDataSize:LongInt;
  procedure   SetDataSize(NewSize:LongInt);
  procedure   GetSpeed;
  procedure   SetSpeed(aSpeed:Double);
 public
  constructor Create(const aFileName:LongString);
  destructor  Destroy; override;
  property    FName:LongString read GetFName;
  property    Alias:LongString read GetAlias;
  property    DataSize: LongInt read GetDataSize write SetDataSize;
  property    Data:Pointer read GetData;
  function    LoadData:Boolean;
  function    EqualsTo(const TheAlias:LongString):Boolean;
  function    DoPlaySound:Boolean;
 end;

constructor TPlayItem.Create(const aFileName:LongString);
begin
 inherited Create;
 myData:=nil;
 myFName:=UnifyFileAlias(aFileName);
 myAlias:=ValidateAlias(UnifyAlias(ExtractBaseName(myFName)));
 SafeFillChar(myHeader,SizeOf(myHeader),0);
end;

destructor TPlayItem.Destroy;
begin
 DataSize:=0;
 myFName:='';
 myAlias:='';
 inherited Destroy;
end;

function TPlayItem.GetFName:LongString;
begin
 if Assigned(Self) then Result:=myFName else Result:='';
end;

function TPlayItem.GetAlias:LongString;
begin
 if Assigned(Self) then Result:=myAlias else Result:='';
end;

function TPlayItem.GetData:Pointer;
begin
 if Assigned(Self) then Result:=myData else Result:=nil;
end;

function TPlayItem.GetDataSize:LongInt;
begin
 if Assigned(Self) then Result:=AllocSize(myData) else Result:=0;
end;

procedure TPlayItem.SetDataSize(NewSize:LongInt);
begin
 if Assigned(Self) then
 try
  SafeFillChar(myHeader,SizeOf(myHeader),0);
  dec(MemoryInUse,AllocSize(myData));
  Deallocate(myData);
  if InRange(NewSize,BlasterMinFileSize,BlasterMaxFileSize)
  then myData:=Allocate(NewSize);
  inc(MemoryInUse,AllocSize(myData));
 except
  on E:Exception do BugReport(E,Self,'SetDataSize');
 end;
end;

function TPlayItem.LoadData:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  if (DataSize=0) then begin
   if FileExists(FName) then DataSize:=GetFileSize(FName);
   if (DataSize>0) then
   if (ReadFileToBuffer(FName,Data,DataSize)<>DataSize) then DataSize:=0;
   GetSpeed;
  end;
  Result:=(DataSize>0);
 except
  on E:Exception do BugReport(E,Self,'LoadData');
 end;
end;

function TPlayItem.EqualsTo(const TheAlias:LongString):Boolean;
begin
 if Assigned(Self) then Result:=IsSameText(Alias,TheAlias) else Result:=false;
end;

procedure TPlayItem.GetSpeed;
begin
 if Assigned(Self) then
 try
  SafeFillChar(myHeader,SizeOf(myHeader),0);
  if (DataSize>=SizeOf(TWaveHeader)) then
  with TWaveHeader(Data^) do
  if (dwRIFF=sig_RIFF) then
  if (dwSize=DataSize-8) then
  if (dwWave=sig_WAVE) then
  if (dwfmt_=sig_fmt_) then
  if (dwFmtSize>=16) then
  if (wFormatTag=1) then myHeader:=TWaveHeader(Data^);
 except
  on E:Exception do BugReport(E,Self,'GetSpeed');
 end;
end;

procedure TPlayItem.SetSpeed(aSpeed:Double);
const SpeedThreshold=0.01;
begin
 if Assigned(Self) then
 try
  if (DataSize>=SizeOf(TWaveHeader)) then with TWaveHeader(Data^) do begin
   if (abs(aSpeed-1)<SpeedThreshold) then aSpeed:=1;
   aSpeed:=EnsureRange(aSpeed,1/BlasterMaxSpeed,BlasterMaxSpeed);
   if (myHeader.nSamplesPerSec<>0) then begin
    if aSpeed=1
    then nSamplesPerSec:=myHeader.nSamplesPerSec
    else nSamplesPerSec:=round(myHeader.nSamplesPerSec*aSpeed);
   end;
   if (myHeader.nAvgBytesPerSec<>0) then begin
    if aSpeed=1
    then nAvgBytesPerSec:=myHeader.nAvgBytesPerSec
    else nAvgBytesPerSec:=round(myHeader.nAvgBytesPerSec*aSpeed);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetSpeed');
 end;
end;

function TPlayItem.DoPlaySound:Boolean;
var PlayCmd,OutStr,ErrStr:LongString; L,R,Vol:Double; Rate:LongInt;
begin
 Result:=false;
 if Assigned(Self) then
 try
  PlayCmd:='play'; L:=1; R:=1; Vol:=1; OutStr:=''; ErrStr:='';
  if GetBlasterVolume(L,R) then Vol:=EnsureRange(0.5*(L+R),0,1);
  if (Vol<>1) then PlayCmd:=PlayCmd+Format(' --volume %.4g',[Vol]);
  if (SpeedFactor<>1) then begin
   Rate:=0;
   if (DataSize>=SizeOf(TWaveHeader))
   then Rate:=TWaveHeader(Data^).nSamplesPerSec;
   if InRange(Rate,BlasterMinRate,BlasterMaxRate)
   then PlayCmd:=PlayCmd+Format(' --rate %d',[Rate]);
  end;
  PlayCmd:=PlayCmd+' -q';
  PlayCmd:=PlayCmd+' '+FName;
  {$IFDEF UNIX}
  Result:=RunCommandInDirIdle(TempDir,PlayCmd,OutStr,ErrStr,BlasterRunCommandSleep);
  {$ENDIF UNIX}
  {$IFDEF WINDOWS}
  Result:=PlaySound(Self.Data,0,SND_MEMORY+SND_ASYNC+SND_NODEFAULT+SND_NOSTOP+SND_NOWAIT);
  {$ENDIF WINDOWS}
  if (BlasterLoggerVerbosity>0) then begin
   if (BlasterLoggerVerbosity<2) then OutStr:='';
   if (BlasterLoggerVerbosity<3) then ErrStr:='';
   if Result
   then LogPlay(mSecNow,'PlayWave: '+ValidateEOL(PlayCmd+EOL+Trim(OutStr+EOL+ErrStr),1))
   else LogPlay(mSecNow,'FailWave: '+ValidateEOL(PlayCmd+EOL+Trim(OutStr+EOL+ErrStr),1));
  end;
  // Awake sound thread to decrease delay
  if IsUnix and BlasterAwakeAfterPlay and Result then
  if (jobs.Count>0) or (PendingVoice<>'') then SoundPolling.Awake;
 except
  on E:Exception do BugReport(E,Self,'DoPlaySound');
 end;
end;

type
 TCheckRec = packed record
  Alias : LongString;
  Found : TPlayItem;
 end;

procedure do_CheckPlayItem(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if aObject is TPlayItem then
 if (aObject as TPlayItem).EqualsTo(TCheckRec(CustomData^).Alias) then begin
  TCheckRec(CustomData^).Found:=(aObject as TPlayItem);
  Terminate:=true;
 end;
end;

function FindPlayItem(const Alias:LongString):TPlayItem;
var CheckRec:TCheckRec;
begin
 Result:=nil;
 if Assigned(SoundLibrary) and IsNonEmptyStr(Alias) then
 try
  CheckRec:=Default(TCheckRec);
  try
   CheckRec.Found:=nil;
   CheckRec.Alias:=StringBuffer(ValidateAlias(UnifyAlias(Alias)));
   SoundLibrary.ForEach(do_CheckPlayItem,@CheckRec);
   Result:=CheckRec.Found;
  finally
   CheckRec.Alias:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'FindPlayItem');
 end;
end;

procedure do_AddPlayItem(const FileName    : LongString;
                         const FileDetails : TSearchRec;
                               SubDirLevel : LongInt;
                           var Terminate   : Boolean;
                               CustomData  : Pointer);
var PlayItem:TPlayItem;
begin
 if ((FileDetails.Attr and faDirectory)=0) and
    IsSameText(ExtractFileExt(FileName),'.wav')
 then
 if (FindPlayItem(ExtractFileName(FileName))=nil) then begin
  PlayItem:=TPlayItem.Create(FileName);
  try
   if Assigned(PlayItem) then begin
    SoundLibrary.Add(PlayItem);
    if (BlasterLoggerVerbosity>0) then
    LogPlay(mSecNow,'AddSound: '+PlayItem.Alias+' = '+PlayItem.FName);
   end;
  except
   on E:Exception do begin
    BugReport(E,nil,'do_AddPlayItem');
    Kill(TObject(PlayItem));
   end;
  end;
 end;
end;

procedure AddPathToSoundLibrary(const Path:LongString; MaxSubDirs:LongInt=0);
begin
 if not Assigned(SoundLibrary) then begin
  SoundLibrary:=NewObjectStorage;
  SoundLibrary.Master:=@SoundLibrary;
 end;
 if Assigned(SoundLibrary)
 then ForEachFile(UnifyFileAlias(Path),'*.wav',do_AddPlayItem,MaxSubDirs);
end;

function PlaySoundItem(const Alias:LongString):Boolean;
var PlayItem:TPlayItem;
begin
 Result:=false;
 try
  PlayItem:=FindPlayItem(Alias);
  if PlayItem.LoadData then begin
   PlayItem.SetSpeed(SpeedFactor);
   Result:=PlayItem.DoPlaySound;
   if Result
   then PlayingVoice:=PlayItem.Alias
   else PendingVoice:=PlayItem.Alias;
  end else inc(BlasterErrorCount);
 except
  on E:Exception do BugReport(E,nil,'PlaySoundItem');
 end;
end;

procedure do_ReleasePlayItem(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if (MemoryInUse<=PointerToPtrInt(CustomData)) then Terminate:=true else
 if (aObject is TPlayItem) then
 with (aObject as TPlayItem) do
 if not EqualsTo(PlayingVoice) then // Do not release current playing voice to avoid problems
 if not EqualsTo(PendingVoice) then // Do not release pending voice to play next time
 if (DataSize>0) then DataSize:=0;
end;

function GetSoundDeviceCount:Integer;
begin
 Result:=GetNumberOfSoundCards;
end;

procedure BlasterCheckMemory(Limit:LongInt);
begin
 if Assigned(SoundLibrary) then
 try
  if (GetSoundDeviceCount=0) then StopBlaster;
  SoundLibrary.ForEach(do_ReleasePlayItem,PtrIntToPointer(Limit));
 except
  on E:Exception do BugReport(E,nil,'BlasterCheckMemory');
 end;
end;

procedure SoundPollingAction(aPolling:TPolling; var Terminate:Boolean);
var i:LongInt; s,cmd:LongString;
const t:Double=0;
begin
 s:=''; i:=0;
 if (Length(PendingVoice)>0) then begin
  if PlaySoundItem(PendingVoice) or (FindPlayItem(PendingVoice).DataSize=0) then PendingVoice:='';
  if (Length(PendingVoice)=0) then t:=msecnow;
 end else
 if jobs.gets(s) then begin
  s:=ValidateAlias(UnifyAlias(s));
  cmd:=ExtractWord(1,s,ScanSpaces);
  if IsSameText(cmd,cmd_Play)   then if PlaySoundItem(ExtractWord(2,s,ScanSpaces)) then t:=msecnow;
  if IsSameText(cmd,cmd_ClrLib) then begin StopBlaster; Kill(SoundLibrary); end;
  if IsSameText(cmd,cmd_AddLib) then if Str2Long(ExtractWord(2,s,ScanSpaces),i)
                      then AddPathToSoundLibrary(ExtractWord(3,s,ScanSpaces),i);
 end;
 if (t=0) then t:=msecnow;
 if (msecnow-t>BlasterMemoPollPeriod) then begin
  BlasterCheckMemory(BlasterMaxDataSize);
  t:=msecnow;
 end;
end;

 {
 ***************************
 User Sound Blaster routines
 ***************************
 }
function InitBlaster(FifoSize   : LongInt = 0;
               const DirList    : LongString = '';
                     MaxSubDirs : LongInt = 0 ):Boolean;
var aDelay:Integer; aPriority:TThreadPriority;
begin
 DoneBlaster;
 if (GetSoundDeviceCount>0) then
 try
  if (FifoSize<=0) then FifoSize:=BlasterDefaultFifoSize;
  if (BlasterLoggerVerbosity>0) then LogPlay(mSecNow,'InitBlaster'+EOL);
  PlayingVoice:='';
  PendingVoice:='';
  BlasterErrorCount:=0;
  jobs:=NewFifo(FifoSize,'SoundBlasterCommandsFifo');
  jobs.Master:=@jobs;
  jobs.GrowLimit:=BlasterFifoGrowLimit;
  jobs.GrowFactor:=BlasterFifoGrowFactor;
  aDelay:=EnsureRange(BlasterDefPollingDelay,1,1000); aPriority:=tpNormal;
  if not ReadIniFilePolling(SysIniFile,SectSystem,'SoundPolling',aDelay,aPriority) then begin
   aDelay:=EnsureRange(BlasterDefPollingDelay,1,1000);;
   aPriority:=tpNormal;
  end;
  SoundPolling:=NewPolling(SoundPollingAction,aDelay,aPriority,false,'System.Sound');
  SoundPolling.Master:=@SoundPolling;
  SoundPolling.Enabled:=true;
  if IsNonEmptyStr(DirList) then AddSoundLibrary(DirList,MaxSubDirs);
 except
  on E:Exception do begin
   BugReport(E,nil,'InitBlaster');
   DoneBlaster;
  end;
 end;
 Result:=UsesBlaster;
end;

procedure DoneBlaster;
begin
 StopBlaster;
 Kill(SoundPolling);
 Kill(SoundLibrary);
 Kill(jobs);
end;

function GetBlasterVolume(var L,R:Double):Boolean;
var w:DWORD;
begin
 w:=0;
 if UsesBlaster and GetWaveVolume(w) then begin
  L:=(w and $0000FFFF)/$0000FFFF;
  R:=(w shr 16)/$0000FFFF;
  Result:=true;
 end else begin
  Result:=false;
  L:=0;
  R:=0;
 end;
end;

function SetBlasterVolume(L,R:Double):Boolean;
var wL,wR:DWORD;
begin
 Result:=false;
 if UsesBlaster then begin
  wL:=round(max(0,min(L,1))*$0000FFFF);
  wR:=round(max(0,min(R,1))*$0000FFFF);
  Result:=SetWaveVolume((wL and $0000FFFF)+(wR shl 16));
 end;
end;

function GetBlasterSpeed(var V:Double):Boolean;
begin
 if UsesBlaster then begin
  V:=SpeedFactor;
  Result:=true;
 end else begin
  Result:=false;
  V:=0;
 end;
end;

function SetBlasterSpeed(V:Double):Boolean;
begin
 Result:=false;
 if UsesBlaster then begin
  SpeedFactor:=EnsureRange(V,1/BlasterMaxSpeed,BlasterMaxSpeed);
  Result:=true;
 end;
end;

procedure do_AddSoundItemAlias(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if aObject is TPlayItem then TText(CustomData).Addln((aObject as TPlayItem).Alias);
end;

procedure do_AddSoundItemFName(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if aObject is TPlayItem then TText(CustomData).Addln((aObject as TPlayItem).FName);
end;

function GetSoundLibrary(FullPath:Boolean):LongString;
var P:TText;
begin
 Result:='';
 if UsesBlaster then
 try
  P:=NewText;
  try
   if FullPath
   then SoundLibrary.ForEach(do_AddSoundItemFName,P)
   else SoundLibrary.ForEach(do_AddSoundItemAlias,P);
   Result:=P.Text;
  finally
   Kill(P);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetSoundLibrary');
 end;
end;

function UsesBlaster:Boolean;
begin
 Result:=Assigned(jobs);
end;

procedure PlayBlaster(const PlayList:LongString);
var i:LongInt;
begin
 if EnablePlayBlaster and UsesBlaster then
 for i:=1 to WordCount(PlayList,ScanSpaces) do
 if not jobs.puts(cmd_Play+' '+ExtractWord(i,PlayList,ScanSpaces))
 then inc(BlasterErrorCount) else SoundPolling.Awake;
end;

procedure Voice(const PlayList:LongString);
begin
 if EnableVoice then PlayBlaster(CoifPlayList(PlayList));
end;

procedure SysVoice(const PlayList:LongString);
begin
 if EnableSystemVoice then Voice(PlayList);
end;

{$IFDEF UNIX}
function KillChildPlayItems:Boolean;
var Lines:TStringList; i:Integer; cmd,pids,OutStr,ErrStr:LongString;
begin
 Result:=false; pids:=''; OutStr:=''; ErrStr:='';
 Lines:=TStringList.Create;
 try
  Lines.Text:=GetListOfProcesses(0,GetProcessId,'play');
  for i:=0 to Lines.Count-1 do pids:=pids+' '+ExtractWord(1,Lines[i],ScanSpaces);
  if (pids<>'') then begin
   cmd:='kill '+Trim(pids);
   Result:=RunCommandInDirIdle(TempDir,cmd,OutStr,ErrStr,BlasterRunCommandSleep);
   if (BlasterLoggerVerbosity>0) then begin
    if (BlasterLoggerVerbosity<2) then OutStr:='';
    if (BlasterLoggerVerbosity<3) then ErrStr:='';
    if Result
    then LogPlay(mSecNow,'KillWave: '+ValidateEOL(cmd+EOL+Trim(OutStr+EOL+ErrStr),1))
    else LogPlay(mSecNow,'FailWave: '+ValidateEOL(cmd+EOL+Trim(OutStr+EOL+ErrStr),1));
   end;
  end;
 finally
  Lines.Free;
 end;
end;
{$ENDIF UNIX}

procedure StopToPlayAllSounds;
begin
 {$IFDEF WINDOWS}
 PlaySound(nil,0,SND_PURGE+SND_NOWAIT);
 {$ENDIF WINDOWS}
 {$IFDEF UNIX}
 KillChildPlayItems;
 {$ENDIF UNIX}
end;

procedure StopBlaster;
begin
 if UsesBlaster then
 try
  if (BlasterLoggerVerbosity>0) then LogPlay(mSecNow,'StopBlaster'+EOL);
  StopToPlayAllSounds;
  PendingVoice:='';
  PlayingVoice:='';
  jobs.Clear;
 except
  on E:Exception do BugReport(E,nil,'StopBlaster');
 end;
end;

procedure AddSoundLibrary(const Path:LongString; MaxSubDirs:LongInt=0);
var i:LongInt;
begin
 for i:=1 to WordCount(Path,ScanSpaces) do
 if not jobs.puts(cmd_AddLib+' '+d2s(MaxSubDirs)+' '+ExtractWord(i,Path,ScanSpaces))
 then inc(BlasterErrorCount);
end;

procedure ClearSoundLibrary;
begin
 if not jobs.puts(cmd_ClrLib) then inc(BlasterErrorCount);
end;

function  BlasterMemoryInUse:LongInt;
begin
 Result:=MemoryInUse;
end;

 {
 Сформировать речевую строку для числа.
 Это набор простых чисел как мы их произносим.
 В текущем варианте - диапазон +/- 999999
 Например:
  431   -> 400 30 1
  512   -> 500 12
  -33   -> минус 30 3
  41235 -> 40 1а 1000а 235
 !!! Используется рекурсия !!!
 Доработано до 999999 Юрьевым Димой
 }
function SayNumber(n:LongInt):LongString;
var s:LongString;
 s1,s2:LongInt;
 function Trim0(const s:LongString):LongString;
 begin
  Result:=TrimLeadChars(s,['0']);
 end;
begin
 Result:='';
 {
 Если отрицательное число, то меняем знак и вызываем рекурсивно
 }
 if (n<0) then begin
  s:=SayNumber(abs(n));
  if (s<>'') then s:='минус '+s;
  Result:=s;
  Exit;
 end;
 {
 Положительные числа до тысячи
 }
 if (n<1000) then begin
  case n of
   0..20    : Result:=d2s(n);
   21..99   : Result:=d2s((n div 10)*10)+' '+Trim0(d2s(n mod 10));
   100..999 : Result:=d2s((n div 100)*100)+' '+Trim0(SayNumber(n mod 100));
  end;
  Exit;
 end;
 {
 Числа от тысячи до миллиона
 }
 if (n<1000000) then begin
  s1:=((n mod 10000) div 1000)*1000;
  s2:=((n mod 100000) div 1000)*1000;
  case (n div 1000) of
   1        : Result:='1а 1000а '+Trim0(SayNumber(n mod 1000));
   2        : Result:='2е 1000и '+Trim0(SayNumber(n mod 1000));
   3,4      : Result:=d2s(n div 1000)+' 1000и '+Trim0(SayNumber(n mod 1000));
   5..20    : Result:=d2s(n div 1000)+' 1000 '+Trim0(SayNumber(n mod 1000));
   21..99   : if (s1=0)
              then Result:=d2s((n div 10000)*10)+' 1000 '+
                              Trim0(SayNumber(n mod 1000))
              else Result:=d2s((n div 10000)*10)+' '+
                              SayNumber(s1)+' '+
                              Trim0(SayNumber(n mod 1000));
   100..999 : if (s2=0)
              then Result:=d2s((n div 100000)*100)+' 1000 '+
                           Trim0(SayNumber(n mod 1000))
              else Result:=d2s((n div 100000)*100)+' '+
                           SayNumber(s2)+' '+
                           Trim0(SayNumber(n mod 1000));
  end;
  Exit;
 end;
end;

function CoifPlayList(const PlayList:LongString):LongString;
var i,n:LongInt; PlayItem:LongString;
begin
 Result:=''; n:=0;
 for i:=1 to WordCount(PlayList,ScanSpaces) do begin
  PlayItem:=ExtractWord(i,PlayList,ScanSpaces);
  if Str2Long(PlayItem,n) then PlayItem:=SayNumber(n);
  Result:=Result+' '+PlayItem;
 end;
 Result:=Trim(Result);
end;

function BlusterPolling:TPolling;
begin
 Result:=SoundPolling;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_snd;
begin
end;

procedure Free_crw_snd;
begin
 DoneBlaster;
end;

initialization

 Init_crw_snd;

finalization

 Free_crw_snd;

end.

//////////////
// END OF FILE
//////////////

