 {
 Terminal for named pipe I/O
 }
program Pipe;
var
 b              : Boolean;
 Ok             : Boolean;
 errors         : Integer;
 errorcode      : Integer;
 s              : string;
 {
 All tags there...
 }
 tagPipeName    : Integer;
 tagBtnConnect  : Integer;
 tagBtnConsole  : Integer;
 tagBtnPipeTalk : Integer;
 tagMainWindow  : Integer;
 {
 Communication port settings...
 }
 Com_Buff       : String;
 Com_Name       : String;
 Com_Connected  : Boolean;
 {
 First time Com initialization
 }
 procedure Com_Init;
 begin
  Com_Buff:='';
  Com_Name:='';
  Com_Connected:=false;
 end;
 {
 Try to establish connection, if one not connected
 }
 procedure Com_Connect(PipeName:string);
 var ini:string;
 begin
  ini:='';
  if Com_Connected then writeln(devname,': already connected!') else begin
   PipeName:=LoCaseStr(PipeName);
   ini:=paramstr('DaqConfigPath')+'\'+readini('PortFile');
   writeln(devname,': Update '+ini);
   if (rewrite(ini)=0) then begin
    writeln(readini('PortSection'));
    writeln('PipeName = ',PipeName);
   end;
   if (rewrite('')<>0) or (ioresult<>0) or not fileexists(ini)
   then b:=fixerror(errorcode) and echo(devname+': Error writing '+ini);
   if comopen(readini('PortSection')) then begin
    Com_Buff:='';
    Com_Name:=PipeName;
    Com_Connected:=true;
    writeln(devname,': Connection to "',PipeName,'" established!');
   end else begin
    writeln(devname,': Could not open connection "',PipeName,'"');
    b:=fixerror(errorcode);
   end;
  end;
  ini:='';
 end;
 {
 Disconnect, if one connected
 }
 procedure Com_Disconnect;
 begin
  if Com_Connected then begin
   write(devname,': Disconnected "',Com_Name,'" ');
   if ComClose then writeln('Ok') else writeln('Fails');
   Com_Connected:=false;
  end;
  Com_Buff:='';
  Com_Name:='';
 end; 
 {
 Read line with CR terminator and LF ignore
 }
 function Com_Readln(var s:String):boolean;
 var p,q:integer;
 begin
  s:='';
  Com_Readln:=false;
  if Com_Connected then begin
   if length(Com_Buff)<250 then Com_Buff:=Com_Buff+comread(250-length(Com_Buff));
   p:=pos(chr(13),Com_Buff);
   if p>0 then begin
    Com_Readln:=true;
    if p>1 then s:=copy(Com_Buff,1,p-1);
    if length(s)>0 then begin
     q:=pos(chr(10),s);
     if q>0 then s:=copy(s,q+1,255);
    end;
    Com_Buff:=Copy(Com_Buff,p+1,255);
    if length(Com_Buff)>0 then
    if Com_Buff[1]=chr(10) then Com_Buff:=copy(Com_Buff,2,255);
   end else begin
    if length(Com_Buff)=250 then begin
     writeln(devname,': received line too long!');
     b:=fixerror(errorcode);
     Com_Buff:='';
    end;
   end;
  end;
 end;
 {
 }
 procedure ClearStrings;
 begin
  s:='';
 end;
 {
 }
 procedure OpenConsole;
 begin
  b:=winshow('Консоль '+devname);
  b:=windraw('Консоль '+devname+'|top=150|left=170|width=600|height=480');
 end;
 {
 }
 procedure OpenPipeControl;
 begin
  b:=winshow(sgettag(tagMainWindow));
  b:=windraw(sgettag(tagMainWindow)+'|top=0|left=170|width=300|height=150');
 end;
 {
 }
 procedure CallPipeTalk(PipeName:string);
 var exe,srv,pip:string; p:integer;
 begin
  exe:='';
  srv:='';
  pip:='';
  exe:=paramstr('DaqConfigPath')+'\'+readini('PipeTalk');
  srv:=copy(PipeName,1,pos('\',PipeName)-1);
  if extractword(1,srv)='' then srv:='?';
  pip:=copy(PipeName,pos('\',PipeName)+1,255);
  if fileexists(exe) then begin
   if ShellExecute('open|'+exe+'|'+srv+' '+pip)<32
   then writeln(devname,': coud not execute-> ',exe,' ',srv,' ',pip);
  end else begin
   writeln(devname,': file not found-> ',exe);
  end;
  exe:='';  
  srv:='';
  pip:='';
 end;
 {
 Dialog with warning message
 }
 procedure Warning(msg:string);
 var b:boolean;
 begin
  if editstate=0 
  then msg:=edit('('+msg)+edit(')Warning')
  else b:=Echo(msg);
 end;
 {
 Initialize dialog to edit tag
 }
 procedure StartEditTag(tag:integer; Caption:string);
 var s:string;
 begin
  s:='';
  if typetag(tag)>0 then begin
   if editstate=0 then begin
    if typetag(tag)=1 then s:=str(igettag(tag)) else
    if typetag(tag)=2 then s:=str(rgettag(tag)) else
    if typetag(tag)=3 then s:=sgettag(tag) else s:='';
    if pos('?',edit('(Редактировать тег '+nametag(tag))
              +edit(' '+Caption+'|'+s)
              +edit(')StringGridEdit EDIT_TAG_'+nametag(tag)))>0
    then Warning('Error starting edit tag "'+nametag(tag)+'"!');
   end else Warning('Could not edit tag "'+nametag(tag)+'" right now!');
  end;
  s:='';
 end;
 {
 Check if tag editing done.
 }
 procedure CheckEditTag(tag:integer; minval,maxval:real);
 var s,d:string; r:real; b:boolean;
 begin
  s:='';
  d:='';
  r:=0;
  if editstate=1 then
  if typetag(tag)>0 then begin
   s:=edit('?ans 0');
   if extractword(1,s)='EDIT_TAG_'+nametag(tag) then begin
    if extractword(2,s)='1' then begin
     s:=edit('?ans 1');
     d:=worddelims('|');
     s:=extractword(2,s);
     d:=worddelims(d);
     if typetag(tag)=1 then begin
      r:=eval(s);
      if (r<minval) or (r>maxval) then r:=_nan;
      if not isnan(r) then b:=isettag(tag,round(r));
     end;
     if typetag(tag)=2 then begin
      r:=eval(s);
      if (r<minval) or (r>maxval) then r:=_nan;
      if not isnan(r) then b:=rsettag(tag,r);
     end;
     if typetag(tag)=3 then b:=ssettag(tag,s);
    end;
    s:=edit('');
   end;
   if isnan(r) then Warning('Invalid input!')
  end;
  s:='';
  d:='';
 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
  errors:=0;
  errorcode:=registererr(devname+'-'+progname);
  writeln(devname,': Starting ...');
  writeln(devname,': Hello, user ',paramstr('UserName'));
  writeln(devname,': Your host is ',paramstr('ComputerName'));
  InitTag(tagPipeName,		readini('tagPipeName'),		3);
  InitTag(tagBtnConnect,	readini('tagBtnConnect'),	1);
  InitTag(tagBtnConsole,	readini('tagBtnConsole'),	1);
  InitTag(tagBtnPipeTalk,	readini('tagBtnPipeTalk'),	1);
  InitTag(tagMainWindow,	readini('tagMainWindow'),	3);
  Com_Init;
  OpenConsole;
  ClearStrings;
  OpenPipeControl;
  b:=isettag(tagBtnConnect,0);
  if errors=0 then writeln(devname,': Ok.');
  if errors<>0 then b:=fixerror(errorcode);
  Ok:=(errors=0);
 end else
 {
 Finalization actions on Stop
 }
 if isinf(runcount) then begin
  writeln(devname+': Stoping ...');
  b:=isettag(tagBtnConnect,0);
  Com_Disconnect;
  ClearStrings;
  writeln(devname,': Ok.');
 end else
 {
 Actions on Poll
 }
 if Ok then begin
  {
  If connected, make I/O
  }
  if Com_Connected then begin
   if not eof then begin
    readln(s);
    if comspace>length(s)+2 then begin
     if comwrite(s+crlf)
     then writeln(devname,': TRANSMIT ',s)
     else writeln(devname,': TRANSMIT ERROR');
    end else begin
     writeln(devname,'Tx overflow.');
     b:=comclear;
    end;
   end;
   {}
   while Com_Readln(s) do writeln(devname,': RECEIVED ',s);
  end;
  {
  Check I/O status
  }
  if ioresult<>0 then b:=fixerror(errorcode) and Echo(devname+': I/O errors found');
  {
  Show connection state ...
  }
  b:=isettag(tagBtnConnect,ord(Com_Connected));
  {
  Edit tags ...
  }
  if clickbutton=1 then begin
   if clicktag=tagPipeName then StartEditTag(tagPipeName,'Имя канала связи');
  end;
  if editstate=1 then begin
   CheckEditTag(tagPipeName,0,1);
  end;
  if editstate=1 then s:=edit('');
  if iand(editstate,9)<>0 then b:=echo(devname+': Editing error '+str(editstate)+edit(''));
  {
  Handle sensor click
  }
  if clickbutton=1 then begin
   if clicktag=tagBtnConnect then begin
    if Com_Connected then Com_Disconnect else Com_Connect(sgettag(tagPipeName));
    b:=voice('click');
   end;
   if clicktag=tagBtnConsole then begin
    b:=voice('click');
    OpenConsole;
   end;
   if clicktag=tagBtnPipeTalk then begin
    CallPipeTalk(sgettag(tagPipeName));
    b:=voice('click');
   end;
  end;
 end;
end.
