 {
 This program demonstrates how to create spectrometry data acquisition system
 with separate console program (Server) uses as spectrometry hardware driver.
 Daq Pascal program (Client) starts Server console program with stdin,stdout
 redirected to anonymouse pipe. Using this pipe, Client program communicates
 with Server program. For data taking uses PKK4 CAMAC controller.
 Client configuration should contain something like:
 [DeviceList]
 &PKK4 = device software program
 [&PKK4]
 Comment = Demo program
 InquiryPeriod = 10
 DevicePolling = 10, tpNormal
 ProgramSource = .\PKK4_Client.pas
 PKK4_EXE_PATH = .\PKK4_Server.exe
 OpenConsole   = 1
 DebugFlags    = 11
 StdInPipe     = 128
 StdOutPipe    = 128
 ProcessPriority = Normal   ; Idle,Normal,High,RealTime
 ThreadPriority  = tpNormal ; tpIdle,tpLowest,tpLower,tpNormal,tpHigher,tpHighest,tpTimeCritical
 ...etc
 []
 }
program PKK4_Client;
const
 MaxLeng      = 1024;    { max. length of I/O string  }
 SendTimeOut  = 100;     { timeout on message send,ms }
 TimerPeriod  = 1000;    { poll period to restart     }
 iopm_driver  = 'giveio.sys';   { needed sys library  }
 borlndmm_dll = 'borlndmm.dll'; { needed dll library  }
 dfTrouble    = 1;       { DebugFlags - Trouble       }
 dfSuccess    = 2;       { DebugFlags - Success       }
 dfViewInp    = 4;       { DebugFlags - ViewInp       }
 dfViewOut    = 8;       { DebugFlags - ViewOut       }
var
 b            : Boolean; { Temporary variable         }
 Ok           : Boolean; { Is initialization Ok ?     }
 errors       : Integer; { Error count                }
 errorcode    : Integer; { Error code for this device }
 errorterm    : Integer; { Error code for host death  }
 erroriobug   : Integer; { Error code for Pkk4 errors }
 fixmaxavail  : Integer; { String manager leak test   }
 DebugFlags   : Integer; { see dfXXX constants        }
 StdIn_Line   : String;  { Temporary variable         }
 winConsole   : String;  { Console window name        }
 PKK4         : record
  Server      : String;  { PKK4 server path           }
  Timer       : Integer; { Timer to check PKK4 task   }
  Buff        : String;  { PKK4 task input buffer     }
  Line        : String;  { Temporary variable         }
  Tid         : Integer; { PKK4 task identifier       }
  IPipeSize   : Integer; { StdInPipeSize              }
  OPipeSize   : Integer; { StdOutPipeSize             }
 end;
 tagStart     : integer; { Start button tag           }
 tagClear     : integer; { Clear button tag           }
 LastStart    : integer; { Last value of Start        }
 LastClear    : integer; { Last value of Clear        }
 {
 Report on host terminated.
 }
 procedure HostTerm(msg:String);
 var b:boolean;
 begin
  if iand(DebugFlags,dfTrouble)>0 then
  if Length(msg)>0 then writeln(devname+' ! '+msg);
  if runcount=1 then errors:=errors+1 else b:=fixerror(errorterm);
 end;
 {
 Report on trouble.
 }
 procedure Trouble(msg:String);
 var b:boolean;
 begin
  if iand(DebugFlags,dfTrouble)>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,dfSuccess)>0 then
  if Length(msg)>0 then writeln(devname+' : '+msg);
 end;
 {
 Report on data input.
 }
 procedure ViewInp(msg:String);
 begin
  if iand(DebugFlags,dfViewInp)>0 then
  if Length(msg)>0 then writeln(devname+' > '+msg);
 end;
 {
 Report on data output.
 }
 procedure ViewOut(msg:String);
 begin
  if iand(DebugFlags,dfViewOut)>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;
 {
 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;
 {
 Read line from PKK4 task stdout pipe with CR terminator and LF ignore.
 }
 function PKK4_Readln(var s:String):boolean;
 var p,q:integer;
 begin
  s:='';
  PKK4_Readln:=false;
  if task_pid(PKK4.Tid)<>0 then begin
   if Length(PKK4.Buff)<MaxLeng
   then PKK4.Buff:=PKK4.Buff+task_recv(PKK4.Tid,MaxLeng-Length(PKK4.Buff));
   p:=Pos(chr(13),PKK4.Buff);
   if p>0 then begin
    PKK4_Readln:=true;
    if p>1 then s:=Copy(PKK4.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;
    PKK4.Buff:=Copy(PKK4.Buff,p+1,MaxLeng);
    if Length(PKK4.Buff)>0 then
    if PKK4.Buff[1]=chr(10) then PKK4.Buff:=Copy(PKK4.Buff,2,MaxLeng);
   end else begin
    if Length(PKK4.Buff)=MaxLeng then begin
     Trouble('Received line is too long!');
     PKK4.Buff:='';
    end;
   end;
  end;
 end;
 {
 Clear PKK4 table.
 }
 procedure PKK4_Clear(ForceFree:boolean);
 var i,j:integer;
 begin
  if ForceFree then begin
   if PKK4.Timer<>0 then b:=tm_free(PKK4.Timer);
  end;
  PKK4.Tid:=0;
  PKK4.Buff:='';
  PKK4.Line:='';
  PKK4.Timer:=0;
  PKK4.Server:='';
 end;
 {
 Initialize PKK4 table.
 }
 procedure PKK4_Init;
 begin
  {---Clear PKK4---}
  PKK4_Clear(false);
  {---Read FIFO size---}
  PKK4.IPipeSize:=val(ReadIni('StdInPipe'));
  PKK4.OPipeSize:=val(ReadIni('StdOutPipe'));
  if (PKK4.IPipeSize<=0) or (PKK4.IPipeSize>64*1024) then PKK4.IPipeSize:=64;
  if (PKK4.OPipeSize<=0) or (PKK4.OPipeSize>64*1024) then PKK4.OPipeSize:=64;
  PKK4.IPipeSize:=PKK4.IPipeSize*1024;
  PKK4.OPipeSize:=PKK4.OPipeSize*1024;
  {---Find PKK4 server executable---}
  PKK4.Server:=DaqFileRef(ReadIni('PKK4_EXE_PATH'),'.EXE');
  if FileExists(PKK4.Server)
  then Success('PKK4_EXE_PATH='+PKK4.Server)
  else Trouble('Could not find PKK4_EXE_PATH: '+PKK4.Server);
  {---Check borlndmm.dll presence---}
  if not FileExists(AddBackSlash(ExtractFilePath(PKK4.Server))+borlndmm_dll)
  then b:=FileCopy(AddBackSlash(ParamStr('HomeDir'))+borlndmm_dll+' '+
                   AddBackSlash(ExtractFilePath(PKK4.Server))+borlndmm_dll);
  if not FileExists(AddBackSlash(ExtractFilePath(PKK4.Server))+borlndmm_dll)
  then Trouble('Could not find '+borlndmm_dll);
  {---Check giveio.sys presence---}
  if not FileExists(AddBackSlash(ExtractFilePath(PKK4.Server))+iopm_driver)
  then b:=FileCopy(AddBackSlash(ExtractFilePath(AddBackSlash(ParamStr('HomeDir'))+
                   ReadIni(ForceExtension(ParamStr('ProgName'),'.ini')+
                   ' [System] IOPM_DRIVER')))+iopm_driver+' '+
                   AddBackSlash(ExtractFilePath(PKK4.Server))+iopm_driver);
  if not FileExists(AddBackSlash(ExtractFilePath(PKK4.Server))+iopm_driver)
  then Trouble('Could not find '+iopm_driver);
  {---Initialize timer---}
  PKK4.Timer:=tm_new;
  if not tm_addint(PKK4.Timer,TimerPeriod) then Trouble('tm_addint fails.');
  if not tm_start(PKK4.Timer) then Trouble('tm_start fails.');
 end;
 {
 Send message to PKK4 task.
 Wait for some time if transmitter FIFO is over.
 }
 procedure PKK4_Send(msg:string);
 var ms:real;
 begin
  if PKK4.Tid<>0 then
  if Length(msg)>0 then begin
   if task_txspace(PKK4.Tid)<Length(msg) then begin
    ms:=msecnow;
    while(msecnow-ms<SendTimeOut) and (task_txspace(PKK4.Tid)<Length(msg)) do b:=Sleep(1);
   end;
   if task_send(PKK4.Tid,msg+CrLf)=0
   then Trouble('Send error!')
   else ViewInp(msg);
  end;
 end;
 {
 Analyse data coming from PKK4 task stdout.
 }
 procedure PKK4_Process(var s:string);
 var b:Boolean; cmnd,args,buff:String;
     i,p,wc,offs,size,chan,data:integer;
 begin
  cmnd:='';
  args:='';
  buff:='';
  if length(s)>0 then begin
   ViewOut(s);
   if s[1]='@' then begin
    p:=pos('=',s);
    if p>0 then begin
     cmnd:=Copy(s,1,p-1);
     args:=Copy(s,p+1,Length(s)-p);
    end else begin
     cmnd:=s;
     args:='';
    end;
    wc:=wordcount(args);
    {---@start=n statement---}
    if IsSameText(cmnd,'@start') then begin
     {If start fails, send exit to try restart}
     if (wc=1) and (rval(args)=0) then PKK4_Send('@exit');
    end;
    {---@exit=n statement---}
    if IsSameText(cmnd,'@exit') then begin
     Success('Exit with code '+Trim(args));
    end;
    {---@errors=n statement---}
    if IsSameText(cmnd,'@errors') then begin
     if (wc=1) and(val(args)>0) then b:=fixerror(erroriobug);
    end;
    {---@memory=n statement---}
    if IsSameText(cmnd,'@memory') then begin
     {Success('Memory='+args);}
    end;
    {---@Transfer=offs,size,mime_data---}
    if IsSameText(cmnd,'@Transfer') then begin
     offs:=val(extractword(1,args));
     size:=val(extractword(2,args));
     buff:=mime_decode(extractword(3,args));
     if(size>0) and (length(buff)=size*4) then
     for i:=0 to size-1 do begin
      chan:=offs+i;
      data:=dump2i(copy(buff,1+i*4,4));
      b:=putev(8,0,time,chan,data);
     end;
    end;
   end;
  end;
  buff:='';
  cmnd:='';
  args:='';
 end;
 {
 Stop PKK4 server task if one started.
 }
 procedure PKK4_Stop;
 var b:Boolean;
 begin
  if PKK4.Tid>0 then begin
   if task_wait(PKK4.Tid,0) then begin
    Success('PKK4.EXE termination will take some time.');
    Success('You should wait about 5 sec...');
    PKK4_Send('@stop');
    PKK4_Send('@exit');
    b:=task_wait(PKK4.tid,2500);
    if task_wait(PKK4.Tid,0) then b:=task_kill(PKK4.Tid,0,1,0);
    if task_rxcount(PKK4.Tid)>0 then
    while PKK4_Readln(PKK4.Line) do PKK4_Process(PKK4.Line);
    Success('PKK4 Server exit code = '+str(task_result(PKK4.Tid)));
   end;
   b:=task_free(PKK4.Tid);
  end;
  PKK4.Tid:=0;
  PKK4.Buff:='';
  PKK4.Line:='';
 end;
 {
 Finalize PKK4 table.
 }
 procedure PKK4_Free;
 begin
  PKK4_Stop;
  PKK4_Clear(true);
 end;
 {
 Start PKK4 server if one not started.
 }
 procedure PKK4_Start;
 var i,j:Integer; b:Boolean;
 begin
  if PKK4.Tid=0 then begin
   {
   Initialize separate user task, run it invisible...
   }
   PKK4.Tid:=task_init(PKK4.Server);
   if pos('?',task_ctrl(PKK4.Tid,'HomeDir='+ExtractFilePath(PKK4.Server))
             +task_ctrl(PKK4.Tid,'StdInPipeSize='+str(PKK4.IPipeSize))
             +task_ctrl(PKK4.Tid,'StdOutPipeSize='+str(PKK4.OPipeSize))
             +task_ctrl(PKK4.Tid,'Display=0')
          )>0
   then begin
    Trouble('User task setup error!');
    PKK4_Stop;
   end;
   {
   Run task if one was created...
   }
   if PKK4.Tid>0 then
   if task_run(PKK4.Tid) then begin
    Success('TaskId  = '+str(PKK4.Tid));
    Success('TaskPid = '+str(task_pid(PKK4.Tid)));
    Success('TaskRef = '+str(task_ref(PKK4.Tid)));
    Success('CmdLine = '+task_ctrl(PKK4.Tid,'CmdLine'));
    Success('HomeDir = '+task_ctrl(PKK4.Tid,'HomeDir'));
    Success('PipeIn  = '+task_ctrl(PKK4.Tid,'StdInPipeSize'));
    Success('PipeOut = '+task_ctrl(PKK4.Tid,'StdOutPipeSize'));
    Success('Display = '+task_ctrl(PKK4.Tid,'Display'));
   end else begin
    Trouble('Could not start PKK4 Server!');
    PKK4_Stop;
   end;
   {
   Is it Ok with user task? Send preset parameters.
   }
   if PKK4.Tid>0 then
   if task_wait(PKK4.Tid,0) then begin
    PKK4.Line:='';
    PKK4_Send('@Help'+crlf);
    PKK4_Send('@ThreadPriority='+ReadIni('ThreadPriority'));
    PKK4_Send('@ProcessPriority='+ReadIni('ProcessPriority'));
    PKK4_Send('@Crate='+readini('Crate')+crlf);
    PKK4_Send('@Station='+readini('Station')+crlf);
    PKK4_Send('@Portion='+readini('Portion')+crlf);
    PKK4_Send('@BuffSize='+str(crvlen(refao(0)))+crlf);
    PKK4_Send('@BaseAddr='+readini('BaseAddr')+crlf);
    PKK4_Send('@IrqNumber='+readini('IrqNumber')+crlf);
    PKK4.Line:='';
   end else b:=fixerror(errorcode);
  end;
 end;
 {
 PKK4 polling.
 }
 procedure PKK4_Poll;
 begin
  { PKK4 timer actions... }
  if tm_event(PKK4.Timer) then begin
   if igettag(tagStart)>0 then begin
    PKK4_Send('@Transfer'+crlf);
    PKK4_Send('@memory');
    PKK4_Send('@errors=0');
   end;
  end;
 end;
 {
 Analyse data coming from standard input.
 }
 procedure StdIn_Process(s:string);
 begin
  if Length(s)>0 then PKK4_Send(s);
 end;
 {
 Clear all strings
 }
 procedure ClearStrings;
 begin
  StdIn_Line:='';
  winConsole:='';
  PKK4_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);
  errorterm:=registererr(devname+': terminated.');
  erroriobug:=registererr(devname+': I/O error.');
  {
  Clear and initialize variables...
  }
  ClearStrings;
  DebugFlags:=val(ReadIni('DebugFlags'));
  {
  Open console window...
  }
  if val(ReadIni('OpenConsole'))>0 then begin
   winConsole:=ParamStr('Console '+devname);
   b:=winshow(winConsole);
   b:=windraw(winConsole+'|top=317|left=167|Width=600|Height=317');
   b:=winselect(winConsole);
   if val(ReadIni('OpenConsole'))>1
   then b:=winhide(winConsole);
  end;
  b:=windraw(readini('McaView'));
  b:=winselect(readini('McaView'));
  b:=winselect(readini('McaCtrl'));
  {
  Initialize tags...
  }
  InitTag(tagStart,		readini('tagStart'),	1);
  InitTag(tagClear,		readini('tagClear'),	1);
  {
  Clear spectrum and buttons.
  }
  b:=clearcurve(crvname(refao(0)));
  b:=isettag(tagStart,0);
  b:=isettag(tagClear,0);
  LastStart:=0;
  LastClear:=0;
  {
  Initialize PKK4 server...
  }
  Success('PKK4 server initialization:');
  PKK4_Init;
  {
  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
  PKK4_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 PKK4 server is not still running,
  try to start PKK4 server periodically.
  }
  if PKK4.Tid=0 then
  if tm_event(PKK4.Timer) then PKK4_Start;
  {
  Communicate with PKK4 server if one still running...
  }
  if PKK4.Tid>0 then
  if task_wait(PKK4.Tid,0) then begin
   {
   If has data coming from Task StdOut, analyse it...
   }
   if task_rxcount(PKK4.Tid)>0 then
   while PKK4_Readln(PKK4.Line) do PKK4_Process(PKK4.Line);
   {
   PKK4 polling.
   }
   PKK4_Poll;
  end else begin
   HostTerm('PKK4 terminated, exit code = '+str(task_result(PKK4.Tid)));
   PKK4_Stop;
  end;
  {
  Action on Start click...
  }
  if ord(igettag(tagStart)>0)<>LastStart then begin
   if igettag(tagStart)>0 then begin
    PKK4_Send('@Start'+crlf);
   end else begin
    PKK4_Send('@Stop'+crlf);
   end;
   LastStart:=ord(igettag(tagStart)>0);
  end;
  {
  Action on Clear click...
  }
  if ord(igettag(tagClear)>0)<>LastClear then begin
   if igettag(tagClear)>0 then begin
    b:=clearcurve(crvname(refao(0)));
    b:=windraw(readini('McaView'));
    PKK4_Send('@Clear'+crlf);
    b:=isettag(tagClear,0);
   end;
   LastClear:=ord(igettag(tagClear)>0);
  end;
  {
  Handle mouse click 1=Left 2=Right 4=Middle
  }
  if clickbutton=1 then begin
   if clicktag=tagStart then begin
    b:=isettag(clicktag,ord(igettag(clicktag)=0));
    b:=voice('Click');
   end;
   if clicktag=tagClear then begin
    b:=isettag(clicktag,ord(igettag(clicktag)=0));
    b:=voice('Click');
   end;
  end;
 end;
end.
