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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Speaker, can speak English\Russian.                                        //
// On Windows uses Speech API 4.0.   //
// For working on Windows, it needs two COM objects to be installed:          //
// 1)Freeware Microsoft Speech API 4.0 from URL:                              //
//   http://activex.microsoft.com/activex/controls/sapi/spchapi.exe           //
// 2)Freeware speech engine Lernout&Hauspie Text-To-Speech from URL:          //
//   http://activex.microsoft.com/activex/controls/agent2/lhttseng.exe - en   //
//   http://activex.microsoft.com/activex/controls/agent2/lhttsrur.exe - ru   //
// On Unix uses speech-dispatcher (spd-say) + RHVoice + crwkit speak command. //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20060325 - Creation & test                                                 //
// 20060906 - TextData(CHARSET_TEXT, 1, ... - enable \tags\                   //
// 20230621 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_spk; // SPeaKer - Speech API client

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 {$IFDEF WINDOWS} activex, comobj, speech, {$ENDIF}
 sysutils, classes, math, process,
 _crw_alloc, _crw_str, _crw_fio, _crw_proc;

 //////////////////////////////////////////////////////////////////////////////
 // Speech API control class.
 // 1)Use Speaker.Engine property to activate speech engines.
 //   Speaker.Engine:=-1; - switch off and free speech engine.
 //   Speaker.Engine:=n;  - n>=0, initialize and select speech engine number n.
 // 2)Use Speaker.Engines to enumerate available speech engines.
 // 3)Use Speaker.Speak property to set what you need to speak.
 //   Speaker.Speak:='Hello my dear!';
 // 4)Use Speaker.Pitch\Speed\Volume to control sound tone\speed\volume.
 // 5)Use Speaker.Pause\Stop to control sound playing.
 // Example:
 //  Speaker.Engine:=0;                        // Switch on speaker, 1st engine
 //  writeln(Speaker.Engines.Count);           // Number of available engines 
 //  Speaker.Engine:=Speaker.Engines.Count-1;  // Switch on last avail engine
 //  Speaker.Speak:='Hello, world.';           // Speak something
 //  Speaker.Engine:=-1;                       // Switch off speaker
 //////////////////////////////////////////////////////////////////////////////
type
 TSpeaker = class;
 ESpeaker = class(ESoftException);
 {$IFDEF WINDOWS}
 TSpeakerTextDataDoneCallback    = function (aSpeaker:TSpeaker; qTimeStamp:QWORD; dwFlags:DWORD):HResult;
 TSpeakerTextDataStartedCallback = function (aSpeaker:TSpeaker; qTimeStamp:QWORD):HResult;
 TSpeakerBookMarkCallback        = function (aSpeaker:TSpeaker; qTimeStamp:QWORD; dwMarkNum:DWORD):HResult;
 TSpeakerWordPositionCallback    = function (aSpeaker:TSpeaker; qTimeStamp:QWORD; dwByteOffset:DWORD):HResult;
 //
 // Speaker notify sink, for internal use only.
 //
 TSpeakerNotifySink = class(TInterfacedObject, ITTSBufNotifySink)
 private
  myOwner : TSpeaker;
 public
  // Construction/destrunction
  constructor Create(aOwner:TSpeaker);
  destructor  Destroy; override;
 public
  // ITTSBufNotifySink methods
  function TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
  function TextDataStarted(qTimeStamp: QWORD): HResult; stdcall;
  function BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult; stdcall;
  function WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult; stdcall;
 end;
 {$ENDIF WINDOWS}
 //
 // General speaker class
 //
 TSpeaker = class(TLatch)
 private
  myEngines        : TText;                  // List of engines (voices)
  myEngine         : Integer;                // Selected engine (voice)
  myPause          : Boolean;                // Is device paused
  myWait           : Boolean;                // Wait while speaking.
  {$IFDEF UNIX}
  myPitch          : LongInt;                // Voice pitch
  myVolume         : LongInt;                // Voice volume
  myRate           : LongInt;                // Voice rate (speed)
  {$ENDIF UNIX}
  {$IFDEF WINDOWS}
  myIAMM           : IAudioMultimediaDevice; // To control audio device
  myTTSEnum        : ITTSEnum;               // To enumerate speech engines
  myITTSCentral    : ITTSCentral;            // Central to control speech
  myITTSAttributes : ITTSAttributes;         // Speech attributes
  {$ENDIF WINDOWS}
  {$IFDEF WINDOWS}
  myITTSBufNotifySink : ITTSBufNotifySink;   // Notification sink
  myOnTextDataDone    : TSpeakerTextDataDoneCallback;
  myOnTextDataStarted : TSpeakerTextDataStartedCallback;
  myOnBookMark        : TSpeakerBookMarkCallback;
  myOnWordPosition    : TSpeakerWordPositionCallback;
  {$ENDIF WINDOWS}
  procedure   FreeAllInterfaces;
  function    GetEngines:TText;
  function    GetEngine:Integer;
  procedure   SetEngine(aEngine:Integer);
  procedure   SetSpeak(const aPhrase:LongString);
  function    GetPause:Boolean;
  procedure   SetPause(aPause:Boolean);
  function    GetWait:Boolean;
  procedure   SetWait(aWait:Boolean);
  function    GetPitch:LongInt;
  procedure   SetPitch(aPitch:LongInt);
  function    GetSpeed:LongInt;
  procedure   SetSpeed(aSpeed:LongInt);
  function    GetVolume:LongInt;
  procedure   SetVolume(aVolume:LongInt);
  {$IFDEF WINDOWS}
  procedure   SetOnTextDataDone(aCallback:TSpeakerTextDataDoneCallback);
  procedure   SetOnTextDataStarted(aCallback:TSpeakerTextDataStartedCallback);
  procedure   SetOnBookMark(aCallBack:TSpeakerBookMarkCallback);
  procedure   SetOnWordPosition(aCallBack:TSpeakerWordPositionCallback);
  {$ENDIF WINDOWS}
 public
  constructor Create;
  destructor  Destroy; override;
  property    Engine  : Integer    read GetEngine write SetEngine;
  property    Engines : TText      read GetEngines;
  property    Speak   : LongString                write SetSpeak;
  property    Pause   : Boolean    read GetPause  write SetPause;
  property    Wait    : Boolean    read GetWait   write SetWait;
  property    Rate    : LongInt    read GetSpeed  write SetSpeed;
  property    Pitch   : LongInt    read GetPitch  write SetPitch;
  property    Speed   : LongInt    read GetSpeed  write SetSpeed;
  property    Volume  : LongInt    read GetVolume write SetVolume;
  {$IFDEF WINDOWS}
  property    OnTextDataDone    : TSpeakerTextDataDoneCallback    write SetOnTextDataDone;
  property    OnTextDataStarted : TSpeakerTextDataStartedCallback write SetOnTextDataStarted;
  property    OnBookMark        : TSpeakerBookMarkCallback        write SetOnBookMark;
  property    OnWordPosition    : TSpeakerWordPositionCallback    write SetOnWordPosition;
  {$ENDIF WINDOWS}
  procedure   Stop(Command:LongString='--cancel');
 end;

procedure Kill(var TheObject:TSpeaker); overload;

function Speaker:TSpeaker;

function SpeechApiInstalled:Boolean;

implementation

{$IFDEF WINDOWS}
function SpeechApiInstalled:Boolean;
var str,key:LongString;
begin
 Result:=False;
 try
  key:=Format('CLSID\%s\InprocServer32',[GuidToString(CLSID_MMAudioDest)]);
  str:=ReadRegistryString(HKEY_CLASSES_ROOT,key,'');
  if not FileExists(str) then Exit;
  key:=Format('CLSID\%s\InprocServer32',[GuidToString(CLSID_TTSEnumerator)]);
  str:=ReadRegistryString(HKEY_CLASSES_ROOT,key,'');
  if not FileExists(str) then Exit;
  key:=Format('Interface\%s',[GuidToString(IID_ITTSEnum)]);
  str:=ReadRegistryString(HKEY_CLASSES_ROOT,key,'');
  if IsEmptyStr(str) then Exit;
  key:=Format('Interface\%s',[GuidToString(IID_ITTSCentral)]);
  str:=ReadRegistryString(HKEY_CLASSES_ROOT,key,'');
  if IsEmptyStr(str) then Exit;
  key:=Format('Interface\%s',[GuidToString(IID_ITTSAttributes)]);
  str:=ReadRegistryString(HKEY_CLASSES_ROOT,key,'');
  if IsEmptyStr(str) then Exit;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'SpeechApiInstalled');
 end;
end;
{$ENDIF WINDOWS}

{$IFDEF UNIX}
function SpeechApiInstalled:Boolean;
const sd_modules='sd_rhvoice sd_espeak-ng sd_flite sd_festival';
 function CheckCommand(list:LongString):Boolean;
 const sd_lib_dir='/usr/lib/speech-dispatcher-modules';
 var cmd,exe,path:LongString; i:Integer;
 begin
  Result:=false;
  path:=GetEnv('PATH')+PathSep+sd_lib_dir;
  for i:=1 to WordCount(list,ScanSpaces) do begin
   cmd:=ExtractWord(i,list,ScanSpaces);
   if FileExists(cmd)
   then exe:=Trim(cmd)
   else exe:=Trim(FileSearch(cmd,path,false));
   if (exe<>'') and FileExists(exe) then Result:=true;
   if Result then Break;
  end;
 end;
begin
 Result:=False;
 try
  if CheckCommand(GetCrwKitExe) then
  if CheckCommand('spd-say') then
  if CheckCommand(sd_modules)
  then Result:=true;
 except
  on E:Exception do BugReport(E,nil,'SpeechApiInstalled');
 end;
end;
{$ENDIF UNIX}

constructor TSpeaker.Create;
begin
 inherited;
 myEngines:=NewText(0,8);
 myEngines.Master:=@myEngines;
 myEngine:=-1;
end;

destructor TSpeaker.Destroy;
begin
 FreeAllInterfaces;
 Kill(myEngines);
 inherited;
end;

procedure TSpeaker.FreeAllInterfaces;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   myITTSBufNotifySink:=nil;
   myITTSAttributes:=nil;
   myITTSCentral:=nil;
   myTTSEnum:=nil;
   myIAMM:=nil;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   myVolume:=0;
   myPitch:=0;
   myRate:=0;
   {$ENDIF UNIX}
   myEngines.Count:=0;
   myEngine:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'FreeAllInterfaces');
 end;
end;

function  TSpeaker.GetEngines:TText;
begin
 Result:=nil;
 if Assigned(Self) then begin
  Lock;
  Result:=myEngines;
  Unlock;
 end;
end;

function TSpeaker.GetEngine:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myEngine;
  Unlock;
 end;
end;

procedure TSpeaker.SetEngine(aEngine:Integer);
{$IFDEF WINDOWS}
var NumFound:DWord; ModeInfo:TTSModeInfo; hInput,hOutput,hError:THandle;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
var cmd,OutStr,ErrStr:LongString; i:Integer;
const KnownEngines='Elena Aleksandr Anna Mikhail Irina Pavel';
 procedure MakeFirst(aList:TText; id:LongString);
 var i:Integer;
 begin
  i:=aList.FindLine(id); if (i<0) then Exit;
  id:=aList[i]; aList.DelLn(i); aList.InsLn(0,id);
 end;
{$ENDIF UNIX}
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if (aEngine<0) then aEngine:=-1;
   if (aEngine<>myEngine) then begin
    FreeAllInterfaces;
    if (aEngine>=0) then begin
     {$IFDEF WINDOWS}
     if not SpeechApiInstalled
     then RAISE ESpeaker.Create('Speech API is not properly installed.'+EOL+
                                'Please download & install two freeware components first:'+EOL+
                                '1) http://activex.microsoft.com/activex/controls/sapi/spchapi.exe'+EOL+
                                '2) http://activex.microsoft.com/activex/controls/agent2/lhttsrur.exe');
     SafeFillChar(ModeInfo,SizeOf(ModeInfo),0);
     hInput:=GetStdHandle(STD_INPUT_HANDLE);
     hOutput:=GetStdHandle(STD_OUTPUT_HANDLE);
     hError:=GetStdHandle(STD_ERROR_HANDLE);
     try
      // Switch off standard I/O hanles to avoide
      // possible problems with anonimous pipes.
      SetStdHandle(STD_INPUT_HANDLE,0);
      SetStdHandle(STD_OUTPUT_HANDLE,0);
      SetStdHandle(STD_ERROR_HANDLE,0);
      // Initialize audio device
      if not Succeeded(CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL,
                                        IID_IAudioMultiMediaDevice, myIAMM))
      then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                       [GuidToString(CLSID_MMAudioDest)]));
      // Create speech engine enumerator
      if not Succeeded(CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL,
                                        IID_ITTSEnum, myTTSEnum))
      then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                       [GuidToString(CLSID_TTSEnumerator)]));
     finally
      SetStdHandle(STD_INPUT_HANDLE,hInput);
      SetStdHandle(STD_OUTPUT_HANDLE,hOutput);
      SetStdHandle(STD_ERROR_HANDLE,hError);
     end;
     // Check interfaces
     if not Assigned(myIAMM)
     then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                      [GuidToString(CLSID_MMAudioDest)]));
     if not Assigned(myTTSEnum)
     then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                      [GuidToString(CLSID_TTSEnumerator)]));
     // Select first engine
     if not Succeeded(myTTSEnum.Reset)
     then RAISE ESpeaker.Create('Could not TTSEnum.Reset');
     if not Succeeded(myTTSEnum.Next(1, ModeInfo, @NumFound))
     then RAISE ESpeaker.Create('Fails TTSEnum.Next');
     // Enumerate engines
     while NumFound > 0 do begin
      myEngines.Addln(StrPas(ModeInfo.szModeName));
      if not Succeeded(myTTSEnum.Next(1, ModeInfo, @NumFound))
      then RAISE ESpeaker.Create('Fails TTSEnum.Next');
     end;
     // Check if any speech engines found
     if myEngines.Count>0
     then aEngine:=Min(aEngine,myEngines.Count-1)
     else RAISE ESpeaker.Create('Speech engines is not found.');
     // Select engine aEngine
     if not Succeeded(myTTSEnum.Reset)
     then RAISE ESpeaker.Create('Could not TTSEnum.Reset');
     if not Succeeded(myTTSEnum.Skip(aEngine))
     then RAISE ESpeaker.Create('Fails TTSEnum.Skip');
     if not Succeeded(myTTSEnum.Next(1, ModeInfo, @NumFound))
     then RAISE ESpeaker.Create('Could not TTSEnum.Next');
     // Create speech engine Central interface
     if not Succeeded(myTTSEnum.Select(ModeInfo.gModeID, myITTSCentral, IUnknown(myIAMM)))
     then RAISE ESpeaker.Create('Fails TTSEnum.Select');
     if not Assigned(myITTSCentral)
     then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                      [GuidToString(IID_ITTSCentral)]));
     // Create speech engine attributes interface
     if not Succeeded(myITTSCentral.QueryInterface(IID_ITTSAttributes, myITTSAttributes))
     then RAISE ESpeaker.Create(Format('Interface %s is not available!',
                                    [GuidToString(IID_ITTSAttributes)]));
     // Create notify sink
     myITTSBufNotifySink:=TSpeakerNotifySink.Create(Self);
     // Now it's Ok.
     myEngine:=aEngine;
     {$ENDIF WINDOWS}
     {$IFDEF UNIX}
     if not SpeechApiInstalled
     then RAISE ESpeaker.Create('Speech API is not properly installed.'+EOL+
                                'Please download and install packages:'+EOL+
                                '1) sudo apt install speech-dispatcher'+EOL+
                                '2) https://github.com/RHVoice/RHVoice');
     // Get list of engines.
     cmd:=GetCrwKitExe+' speak';
     cmd:=cmd+' --list-synthesis-voices';
     if not RunCommandInDirIdle('',cmd,OutStr,ErrStr)
     then RAISE ESpeaker.Create('Fail command: '+cmd);
     myEngines.Text:=ValidateEol(OutStr);
     // Validate list of engines (voices).
     for i:=myEngines.Count-1 downto 0 do begin
      if (WordCount(myEngines[i],ScanSpaces)<>3) then begin
       myEngines.DelLn(i);
       continue;
      end;
      myEngines[i]:=ExtractWord(1,myEngines[i],ScanSpaces);
      if SameText(myEngines[i],'NAME') then begin
       myEngines.DelLn(i);
       continue;
      end;
     end;
     // Move well known engines first.
     for i:=WordCount(KnownEngines,ScanSpaces) downto 1 do begin
      MakeFirst(myEngines,ExtractWord(i,KnownEngines,ScanSpaces));
     end;
     // Check if any speech engines found
     if (myEngines.Count>0)
     then aEngine:=Min(aEngine,myEngines.Count-1)
     else RAISE ESpeaker.Create('Speech engines is not found.');
     // Now it's Ok.
     myEngine:=aEngine;
     {$ENDIF UNIX}
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do begin
   BugReport(E,Self,'SetEngine');
   FreeAllInterfaces;
  end;
 end;
end;

procedure TSpeaker.SetSpeak(const aPhrase:LongString);
{$IFDEF WINDOWS}
var SData:TSData; Buffer:LongString;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
var exe,arg,OutStr,ErrStr:LongString;
{$ENDIF UNIX}
begin
 if Assigned(Self) then
 if not IsEmptyStr(aPhrase) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSCentral) then begin
    Buffer:=Trim(aPhrase);
    SData.dwSize := Length(Buffer) + 1;
    SData.pData  := pChar(Buffer);
    if myPause then begin
     if not Succeeded(myITTSCentral.AudioResume)
     then RAISE ESpeaker.Create('Fails ITTSCentral.AudioResume');
     myPause:=False;
    end;
    if not Succeeded(myITTSCentral.TextData(CHARSET_TEXT, 1, SData, Pointer(myITTSBufNotifySink), IID_ITTSBufNotifySink))
    then RAISE ESpeaker.Create('Fails ITTSCentral.TextData');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   if (myEngine>=0) then begin
    exe:=GetCrwKitExe; OutStr:=''; ErrStr:='';
    if IsEmptyStr(exe) then RAISE ESpeaker.Create('Package not found: crwkit.');
    arg:='speak';
    if myWait then arg:=arg+' --wait';
    arg:=arg+' --rate '+IntToStr(myRate);
    arg:=arg+' --pitch '+IntToStr(myPitch);
    arg:=arg+' --volume '+IntToStr(myVolume);
    arg:=arg+' --synthesis-voice '+Engines[Engine];
    arg:=arg+' '+AnsiQuotedStr(aPhrase,QuoteMark);
    if not RunCommandInDirIdle('',exe+' '+arg,OutStr,ErrStr)
    then RAISE ESpeaker.Create('Failed run: '+exe+' '+arg);
   end;
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetSpeak');
 end;
end;

function TSpeaker.GetPause:Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  Lock;
  Result:=myPause;
  Unlock;
 end; 
end;

procedure TSpeaker.SetPause(aPause:Boolean);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSCentral) then begin
    if myPause <> aPause then begin
     if aPause then begin
      if not Succeeded(myITTSCentral.AudioPause)
      then RAISE ESpeaker.Create('Fails ITTSCentral.AudioPause');
     end else begin
      if not Succeeded(myITTSCentral.AudioResume)
      then RAISE ESpeaker.Create('Fails ITTSCentral.AudioResume');
     end;
     myPause:=aPause;
    end;
   end;
   {$ENDIF WINDOWS}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetPause');
 end;
end;

function TSpeaker.GetWait:Boolean;
begin
 if Assigned(Self)
 then Result:=myWait
 else Result:=false;
end;

procedure TSpeaker.SetWait(aWait:Boolean);
begin
 if Assigned(Self) then myWait:=aWait;
end;

procedure TSpeaker.Stop(Command:LongString='--cancel');
{$IFDEF UNIX}
const ValidCommands='-C -cancel --cancel -S -stop --stop';
var cmd,OutStr,ErrStr:LongString;
{$ENDIF UNIX}
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSCentral) then begin
    if not Succeeded(myITTSCentral.AudioReset)
    then RAISE ESpeaker.Create('Fails ITTSCentral.AudioReset');
    myPause:=False;
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   if (WordIndex(Command,ValidCommands,ScanSpaces)>0) then
   if (myEngine>=0) then begin
    cmd:=GetCrwKitExe+' speak '+Command;
    if not RunCommandInDirIdle('',cmd,OutStr,ErrStr)
    then RAISE ESpeaker.Create('Fails '+cmd);
   end;
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Stop');
 end;
end;

function  TSpeaker.GetPitch:LongInt;
{$IFDEF WINDOWS}var wd:Word;{$ENDIF}
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   wd:=0;
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.PitchGet(wd))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.PitchGet.');
    Result:=wd;
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   Result:=myPitch;
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetPitch');
 end;
end;

procedure TSpeaker.SetPitch(aPitch:LongInt);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.PitchSet(aPitch))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.PitchSet.');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   myPitch:=EnsureRange(aPitch,-100,+100);
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetPitch');
 end;
end;

function  TSpeaker.GetSpeed:LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.SpeedGet(DWord(Result)))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.SpeedGet.');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   Result:=myRate;
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSpeed');
 end;
end;

procedure TSpeaker.SetSpeed(aSpeed:LongInt);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.SpeedSet(aSpeed))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.SpeedGet.');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   myRate:=EnsureRange(aSpeed,-100,+100);
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetSpeed');
 end;
end;

function  TSpeaker.GetVolume:LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.VolumeGet(DWord(Result)))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.VolumeGet.');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   Result:=myVolume;
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetVolume');
 end;
end;

procedure TSpeaker.SetVolume(aVolume:LongInt);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   {$IFDEF WINDOWS}
   if Assigned(myITTSAttributes) then begin
    if not Succeeded(myITTSAttributes.VolumeSet(aVolume))
    then RAISE ESpeaker.Create('Fails ITTSAttributes.VolumeSet.');
   end;
   {$ENDIF WINDOWS}
   {$IFDEF UNIX}
   myVolume:=EnsureRange(aVolume,-100,+100);
   {$ENDIF UNIX}
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetVolume');
 end;
end;

{$IFDEF WINDOWS}
procedure TSpeaker.SetOnTextDataDone(aCallback:TSpeakerTextDataDoneCallback);
begin
 if Assigned(Self) then begin
  Lock;
  myOnTextDataDone:=aCallBack;
  Unlock;
 end;
end;

procedure TSpeaker.SetOnTextDataStarted(aCallback:TSpeakerTextDataStartedCallback);
begin
 if Assigned(Self) then begin
  Lock;
  myOnTextDataStarted:=aCallBack;
  Unlock;
 end;
end;

procedure TSpeaker.SetOnBookMark(aCallBack:TSpeakerBookMarkCallback);
begin
 if Assigned(Self) then begin
  Lock;
  myOnBookMark:=aCallBack;
  Unlock;
 end;
end;

procedure TSpeaker.SetOnWordPosition(aCallBack:TSpeakerWordPositionCallback);
begin
 if Assigned(Self) then begin
  Lock;
  myOnWordPosition:=aCallBack;
  Unlock;
 end;
end;
{$ENDIF WINDOWS}

procedure Kill(var TheObject:TSpeaker); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

{$IFDEF WINDOWS}
constructor TSpeakerNotifySink.Create(aOwner:TSpeaker);
begin
 inherited Create;
 myOwner:=aOwner;
end;

destructor TSpeakerNotifySink.Destroy;
begin
 inherited;
end;

function TSpeakerNotifySink.TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
begin
 Result:=E_FAIL;
 try
  if Assigned(myOwner) then
  if Assigned(myOwner.myOnTextDataDone) then
  Result:=myOwner.myOnTextDataDone(myOwner,qTimeStamp, dwFlags);
 except
  on E:Exception do BugReport(E,Self,'TextDataDone');
 end;
end;

function TSpeakerNotifySink.TextDataStarted(qTimeStamp: QWORD): HResult; stdcall;
begin
 Result:=E_FAIL;
 try
  if Assigned(myOwner) then
  if Assigned(myOwner.myOnTextDataStarted) then
  Result:=myOwner.myOnTextDataStarted(myOwner,qTimeStamp);
 except
  on E:Exception do BugReport(E,Self,'TextDataStarted');
 end;
end;

function TSpeakerNotifySink.BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult; stdcall;
begin
 Result:=E_FAIL;
 try
  if Assigned(myOwner) then
  if Assigned(myOwner.myOnBookMark) then
  Result:=myOwner.myOnBookMark(myOwner, qTimeStamp,dwMarkNum);
 except
  on E:Exception do BugReport(E,Self,'BookMark');
 end;
end;

function TSpeakerNotifySink.WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult; stdcall;
begin
 Result:=E_FAIL;
 try
  if Assigned(myOwner) then
  if Assigned(myOwner.myOnWordPosition) then
  Result:=myOwner.myOnWordPosition(myOwner, qTimeStamp, dwByteOffset);
 except
  on E:Exception do BugReport(E,Self,'WordPosition');
 end;
end;
{$ENDIF WINDOWS}

 ///////////////////////////////////////////////////////////////////////////////
 // Speaker implementation
 ///////////////////////////////////////////////////////////////////////////////
const
 TheSpeaker : TSpeaker = nil;

function Speaker:TSpeaker;
begin
 if not Assigned(TheSpeaker) then begin
  TheSpeaker:=TSpeaker.Create;
  TheSpeaker.Master:=@TheSpeaker;
 end;
 Result:=TheSpeaker;
end;

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

procedure Init_crw_spk;
begin
 Speaker.Ok;
end;

procedure Free_crw_spk;
begin
 Kill(TheSpeaker);
end;

initialization

 Init_crw_spk;

finalization

 Free_crw_spk;

end.

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

