program SpeakSrv;
const
 borlndmm_dll= 'borlndmm.dll';
 SpeechApi1  = 'resource\Tools\SpeechApi\spchapi.exe';
 SpeechApi2  = 'resource\Tools\SpeechApi\lhttsrur.exe';
 SendTimeOut = 100;     { timeout on message send    }
 TimerPeriod = 1000;    { poll period of Speak.Timer }
 MaxLeng     = 16384;   { max. length of I/O string  }
var
 b           : Boolean; { Temporary variable         }
 Ok          : Boolean; { Is initialization Ok ?     }
 errors      : Integer; { Error count                }
 errorcode   : Integer; { Error code for this device }
 fixmaxavail : Integer; { String manager leak test   }
 StdIn_Line  : String;  { Temporary variable         }
 winConsole  : String;  { Console window name        }
 DebugFlags  : Integer; { 1=Trouble,2=Success,4=ViewInp,8=ViewOut }
 Speak       : record
  Server     : String;  { Speak server path          }
  Timer      : Integer; { Timer to check Speak task  }
  Buff       : String;  { Speak task input buffer    }
  Line       : String;  { Temporary variable         }
  Tid        : Integer; { Speak task identifier      }
  IPipeSize  : Integer; { StdInPipeSize              }
  OPipeSize  : Integer; { StdOutPipeSize             }
 end;
 {
 Report on trouble.
 }
 procedure Trouble(msg:String);
 var b:boolean;
 begin
  if iand(DebugFlags,1)>0 then
  if Length(msg)>0 then writeln(devname+' ! '+msg);
  if runcount=1 then errors:=errors+1 else b:=fixerror(errorcode);
 end;
 {
 Report on success.
 }
 procedure Success(msg:String);
 begin
  if iand(DebugFlags,2)>0 then
  if Length(msg)>0 then writeln(devname+' : '+msg);
 end;
 {
 Report on data input.
 }
 procedure ViewInp(msg:String);
 begin
  if iand(DebugFlags,4)>0 then
  if Length(msg)>0 then writeln(devname+' > '+msg);
 end;
 {
 Report on data output.
 }
 procedure ViewOut(msg:String);
 begin
  if iand(DebugFlags,8)>0 then
  if Length(msg)>0 then writeln(devname+' < '+msg);
 end;
 {
 Check I/O status.
 }
 function IoError:boolean;
 begin
  IoError:=false;
  if ioresult<>0 then begin
   Trouble('I/O error.');
   IoError:=true;
  end;
 end;
 {
 Clear Speak table.
 }
 procedure Speak_Clear(MakeFree:boolean);
 begin
  if MakeFree then begin
   if Speak.Timer<>0 then b:=tm_free(Speak.Timer);
  end;
  Speak.Tid:=0;
  Speak.Buff:='';
  Speak.Line:='';
  Speak.Timer:=0;
  Speak.Server:='';
 end;
 {
 Initialize Speak table.
 }
 procedure Speak_Init;
 begin
  {---Clear Speak---}
  Speak_Clear(false);
  {---Read FIFO size---}
  Speak.IPipeSize:=val(ReadIni('StdInPipe'));
  Speak.OPipeSize:=val(ReadIni('StdOutPipe'));
  if (Speak.IPipeSize<=0) or (Speak.IPipeSize>64*1024) then Speak.IPipeSize:=64;
  if (Speak.OPipeSize<=0) or (Speak.OPipeSize>64*1024) then Speak.OPipeSize:=64;
  Speak.IPipeSize:=Speak.IPipeSize*1024;
  Speak.OPipeSize:=Speak.OPipeSize*1024;
  {---Find Speak server executable---}
  Speak.Server:=DaqFileRef(ReadIni('SPEAK_SERVER'),'.EXE');
  if FileExists(Speak.Server)
  then Success('SPEAK_SERVER='+Speak.Server)
  else Trouble('Could not find SPEAK_SERVER: '+Speak.Server);
  {---Check borlndmm.dll presence---}
  if not FileExists(AddBackSlash(ExtractFilePath(Speak.Server))+borlndmm_dll)
  then b:=FileCopy(AddBackSlash(ParamStr('HomeDir'))+borlndmm_dll+' '+
                   AddBackSlash(ExtractFilePath(Speak.Server))+borlndmm_dll);
  if not FileExists(AddBackSlash(ExtractFilePath(Speak.Server))+borlndmm_dll)
  then Trouble('Could not find '+borlndmm_dll);
  {---Initialize timer---}
  Speak.Timer:=tm_new;
  if not tm_addint(Speak.Timer,TimerPeriod) then Trouble('tm_addint fails.');
  if not tm_start(Speak.Timer) then Trouble('tm_start fails.');
 end;
 {
 Send message to Speak task.
 Wait for some time if transmitter FIFO is over.
 }
 procedure Speak_Send(msg:string);
 var ms:real;
 begin
  if Speak.Tid<>0 then
  if Length(msg)>0 then begin
   if task_txspace(Speak.Tid)<Length(msg) then begin
    ms:=msecnow;
    while(msecnow-ms<SendTimeOut) and (task_txspace(Speak.Tid)<Length(msg)) do b:=Sleep(1);
   end;
   if task_send(Speak.Tid,msg+CrLf)=0
   then Trouble('Send error!')
   else ViewInp(msg);
  end;
 end;
 {
 Analyse data coming from Speak task stdout.
 }
 procedure Speak_Process(var s:string);
 begin
  if length(s)>0 then ViewOut(s);
 end;
 {
 Read line from Speak task stdout pipe with CR terminator and LF ignore.
 }
 function Speak_Readln(var s:String):boolean;
 var p,q:integer;
 begin
  s:='';
  Speak_Readln:=false;
  if task_pid(Speak.Tid)<>0 then begin
   if Length(Speak.Buff)<MaxLeng then Speak.Buff:=Speak.Buff+task_recv(Speak.Tid,MaxLeng-Length(Speak.Buff));
   p:=Pos(chr(13),Speak.Buff);
   if p>0 then begin
    Speak_Readln:=true;
    if p>1 then s:=Copy(Speak.Buff,1,p-1);
    if Length(s)>0 then begin
     q:=Pos(chr(10),s);
     if q>0 then s:=Copy(s,q+1,MaxLeng);
    end;
    Speak.Buff:=Copy(Speak.Buff,p+1,MaxLeng);
    if Length(Speak.Buff)>0 then
    if Speak.Buff[1]=chr(10) then Speak.Buff:=Copy(Speak.Buff,2,MaxLeng);
   end else begin
    if Length(Speak.Buff)=MaxLeng then begin
     Trouble('Received line is too long!');
     Speak.Buff:='';
    end;
   end;
  end;
 end;
 {
 Stop Speak server task if one started.
 }
 procedure Speak_Stop;
 var b:Boolean; i:Integer;
 begin
  if Speak.Tid>0 then begin
   if task_wait(Speak.Tid,0) then begin
    Speak_Send('@exit');
    if task_wait(Speak.Tid,1000) then b:=task_kill(Speak.Tid,0,1,1000);
    if task_rxcount(Speak.Tid)>0 then
    while Speak_Readln(Speak.Line) do Speak_Process(Speak.Line);
    Success('Speak Server exit code = '+str(task_result(Speak.Tid)));
   end;
   b:=task_free(Speak.Tid);
  end;
  Speak.Tid:=0;
  Speak.Buff:='';
  Speak.Line:='';
 end;
 {
 Finalize Speak table.
 }
 procedure Speak_Free;
 begin
  Speak_Stop;
  Speak_Clear(true);
 end;
 {
 Start Speak server if one not started.
 }
 procedure Speak_Start;
 var i,j,k:Integer; b:Boolean; s:String;
 begin
  s:='';
  if Speak.Tid=0 then begin
   {
   Initialize separate user task, run it invisible...
   }
   Speak.Tid:=task_init(Speak.Server);
   if pos('?',task_ctrl(Speak.Tid,'HomeDir='+ExtractFilePath(Speak.Server))
             +task_ctrl(Speak.Tid,'StdInPipeSize='+str(Speak.IPipeSize))
             +task_ctrl(Speak.Tid,'StdOutPipeSize='+str(Speak.OPipeSize))
             +task_ctrl(Speak.Tid,'Display=0')
          )>0
   then begin
    Trouble('User task setup error!');
    Speak_Stop;
   end;
   {
   Run task if one was created...
   }
   if Speak.Tid>0 then
   if task_run(Speak.Tid) then begin
    Success('TaskId  = '+str(Speak.Tid));
    Success('TaskPid = '+str(task_pid(Speak.Tid)));
    Success('TaskRef = '+str(task_ref(Speak.Tid)));
    Success('CmdLine = '+task_ctrl(Speak.Tid,'CmdLine'));
    Success('HomeDir = '+task_ctrl(Speak.Tid,'HomeDir'));
    Success('PipeIn  = '+task_ctrl(Speak.Tid,'StdInPipeSize'));
    Success('PipeOut = '+task_ctrl(Speak.Tid,'StdOutPipeSize'));
    Success('IPrior. = '+task_ctrl(Speak.Tid,'StdInPriority'));
    Success('OPrior. = '+task_ctrl(Speak.Tid,'StdOutPriority'));
    Success('TPrior. = '+task_ctrl(Speak.Tid,'ThreadPriority'));
    Success('PPrior. = '+task_ctrl(Speak.Tid,'ProcessPriority'));
    Success('Display = '+task_ctrl(Speak.Tid,'Display'));
   end else begin
    Trouble('Could not start Speak Server!');
    Speak_Stop;
   end;
   {
   Is it Ok with user task? Send preset parameters.
   }
   if Speak.Tid>0 then
   if task_wait(Speak.Tid,0) then begin
    s:='';
    k:=ReadIniSection(text_new,28,'','');
    for i:=0 to text_numln(k)-1 do begin
     j:=pos('=',text_getln(k,i));
     if j>0 then
     if Length(s)=0 then
     if IsSameText('Engine',Trim(Copy(text_getln(k,i),1,j-1)))
     then s:=Trim(Copy(text_getln(k,i),j+1,255));
    end;
    b:=text_free(k);
    if Length(s)=0 then s:='0';
    Speak_Send('@engine='+s);
   end else b:=fixerror(errorcode);
  end;
  s:='';
 end;
 {
 Read string line from standard input.
 }
 function StdIn_Readln(var s:string):boolean;
 begin
  StdIn_Readln:=false;
  if not IoError then 
  if not eof then begin
   readln(s);
   if not IoError then StdIn_Readln:=true;
  end;
 end;
 {
 Analyse data coming from standard input.
 }
 procedure StdIn_Process(s:string);
 begin
  s:=Trim(s);
  if Length(s)>0 then Speak_Send(s);
 end;
 {
 Clear all strings
 }
 procedure ClearStrings;
 begin
  StdIn_Line:='';
  winConsole:='';
  Speak_Clear(false);
  if runcount=1 then fixmaxavail:=maxavail;
  if isinf(runcount) then
  if maxavail<>fixmaxavail then Trouble('String Manager Leak = '+str(fixmaxavail-maxavail));
 end;
 {
 Initialize and check tag
 }      
 procedure InitTag(var tag:integer; name:string; typ:integer);
 begin
  tag:=findtag(name);
  if (typ>0) and (typetag(tag)<>typ) then errors:=errors+1;
 end;
begin
 {
 Initialization actions on Start...
 }
 if runcount=1 then begin
  {
  Initialize errors...
  }
  errors:=0;
  errorcode:=registererr(devname);
  {
  Clear and initialize variables...
  }
  ClearStrings;
  Success('Initialization:');
  DebugFlags:=val(ReadIni('DebugFlags'));
  Speak_Init;
  {
  Open console window...
  }
  if val(ReadIni('OpenConsole'))>0 then begin
   winConsole:=ParamStr('Console '+devname);
   b:=winshow(winConsole);
   b:=windraw(winConsole+'|top=0|left=170|Width=600|Height=317');
   b:=winselect(winConsole);
   if val(ReadIni('OpenConsole'))>1 then b:=winhide(winConsole);
  end;
  {
  Is it Ok?
  }
  if errors=0 then Success('Start Ok.') else Trouble('Start Fails.');
  if errors<>0 then b:=fixerror(errorcode);
  Ok:=(errors=0);
 end else
 {
 Finalization actions on Stop...
 }
 if isinf(runcount) then begin
  Speak_Free;
  ClearStrings;
  Success('Stop.');
 end else
 {
 Actions on Poll
 }
 if Ok then begin
  {
  Check standard I/O errors...
  }
  if ioresult<>0 then b:=fixerror(errorcode);
  {
  Process standard input...
  }
  while StdIn_Readln(StdIn_Line) do StdIn_Process(StdIn_Line);
  {
  If Speak server is not still running,
  try to start Speak server periodically.
  }
  if Speak.Tid=0 then
  if tm_event(Speak.Timer) then Speak_Start;
  {
  Communicate with Speak server if one still running...
  }
  if Speak.Tid>0 then
  if task_wait(Speak.Tid,0) then begin
   {
   If has data coming from Task StdOut, analyse it...
   }
   if task_rxcount(Speak.Tid)>0 then
   while Speak_Readln(Speak.Line) do Speak_Process(Speak.Line);
  end else begin
   if task_result(Speak.Tid)=13 then begin
    Success('Terminated, exit code = '+str(task_result(Speak.Tid)));
    Success('It seems, Speech API and/or Speech Engines is not installed!');
    Success('Please, install Speech API first!');
    b:=Echo(devname+' : SpeakSrv terminated, exit code = '+str(task_result(Speak.Tid)));
    b:=Echo(devname+' : Maybe Speech API & Speech Engines is not installed!');
    b:=Echo(devname+' : Please, install Speech API first!');
    b:=tm_stop(Speak.Timer);
   end else begin
    Trouble('SpeakSrv terminated, exit code = '+str(task_result(Speak.Tid)));
   end;
   Speak_Stop;
  end;
 end;
end.
