unit ul_lcabs;
{ Receiving data packets over uLAN network }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

uses
  Windows, {v0.31} SysUtils,{/v0.31}
  Msgu, ListType, Listu, Timer,
  UlanType, WinUtl,
  ULDrvTyp, ULDrvUtl, ULDriver, ApexType{v0.24}, ExeLogu{/v0.24}
  {v0.53},DevMode{/v0.53};

type
  PScanInputInfo = ^TScanInputInfo;
  TScanInputInfo = record
    {uloi:Puloi_coninfo;}
    Drv: TULDriver;
      { handle to opened driver }
    fifo:TLst;
      {storage for incoming packets}
    pktinfo:TApexPacketInfo;
      { currently beeing created packet }
  end;

{ Getmem for SII, open driver, init packet fifo, accept Mark from
  address list specified in AdrList. }
function RcvInit(var SII: PScanInputInfo; AdrList:string): boolean;

{ Sets property of SII^ }
function RcvSetProp(SII:PScanInputInfo; rp:TRcvProperty; APValue:pointer):boolean;

{ Called from timer to poll for incoming packets }
function RcvRun(SII:PScanInputInfo): boolean;

{ Called to retrieve incoming packets from fifo, returns true if ai filled,
  should be called repeatedly until returns false }
function RcvGetPktInfo(SII:PScanInputInfo; var ai:TApexPacketInfo): boolean;

{ Close, free all }
function RcvDone(var SII:PScanInputInfo): boolean;

procedure RcvDisable;
procedure RcvEnable;

implementation
const
  RcvEnabled: boolean = true;

procedure RcvDisable;
begin
  RcvEnabled := false;
end;

procedure RcvEnable;
begin
  RcvEnabled := true;
end;


function RcvInit(var SII:PScanInputInfo; AdrList:string): boolean;
var
  li:TListInfo;{listtype}
  {v0.31}
  adr: integer;
  line,word:string;
  {/v0.31}
label er;
begin
  RcvInit := false;
  if not RcvEnabled then
    exit;
  New(SII);
  if SII = nil then
    exit;
  FillChar(SII^, sizeof(SII^), 0);
  with SII^ do begin
    try
      Drv := TULDriver.Create(nil, UL_DEV_NAME);
    except
      on EULOSException do begin
      end;
    else
      raise;
    end;
    if Drv = nil then begin
      {v0.24}ExeLog.LogEvent([leError], 'ULDriver.Create failed.');{/v0.24 SysLogLog(leError, 'ULDriver.Create failed.');}
      goto er;
    end;

    {v0.31}
    line := AdrList;
    while ExtractWord([' ',',',';'], word, line) do begin {winutl}
      adr := StrToInt(word);
      if adr <> 0 then begin
        Drv.FilterAdd(Adr, UL_CMD_LCDABS);
      end else
        raise Exception.Create('ul_lcabs RcvInit - Zero detector addr');
    end;
    {/v0.31
    Drv.FilterAdd(Adr, UL_CMD_LCDABS);}
    {v0.12}
    {Enable reception of start mark from any instrument}
    Drv.FilterAdd(0, UL_CMD_LCDMRK);
    {/v0.12 Drv.FilterAdd(Adr, UL_CMD_LCDMRK);}

    pktinfo.EndTime := mstime;
    pktInfo.ScanningValues := true;
    FillChar(li, sizeof(li), 0);
    li.RecordSize := sizeof(TApexPacketInfo);
    if not ListInit(ltRecords or ltAutoDestroy, @li, fifo) then
      goto er;
  end;
  RcvInit := true;
  exit;

er:
  if SII <> nil then begin
    with SII^ do begin
      if Drv <>  nil then
        ClassFree(Drv);
      if fifo <> nil then
        ListDone(fifo);
    end;
    Dispose(SII);
    SII := nil;
 end;
end;

function RcvRun(SII:PScanInputInfo):boolean;
var
  buf:single;
  bytes_ret: DWORD;
label free;
begin
  RcvRun := false;
  if SII = nil then
    exit;
  with SII^ do begin
    while Drv.MessageAvailable do begin
      Drv.MessageOpen;
      if (Drv.Message.flg and UL_BFL_FAIL) <> 0 then
        goto free;
      if (Drv.Message.cmd = UL_CMD_LCDABS) then begin
        while Drv.MessageRead(buf, 4, bytes_ret) and (bytes_ret = 4) do
        begin
          with pktinfo do begin
            {v0.31}
            Pkt.X2 := Drv.Message.sadr;
            {/v0.31}
            Pkt.EventID := eiData;
            Pkt.Values[CurValPos] := buf;
            if CurValPos = 0 then
              Time := EndTime;
            inc(CurValPos);
            if CurValPos = ApexPacketValueCount then begin
               EndTime := mstime;
              ListRecAdd(fifo, pktinfo);
              CurValPos := 0;
            end;
          end;
        end;
      end else if (Drv.Message.cmd = UL_CMD_LCDMRK) then begin
        pktinfo.Pkt.EventID := eiMark;
        {v0.51pi}
        pktinfo.Pkt.X2 := Drv.Message.sadr;
        {/v0.51pi}
        ListRecAdd(fifo, pktinfo);
      end else
        goto free;
      RcvRun := true;
    free:
      Drv.MessageClose;
    end;
  end;
end;

function RcvSetProp(SII:PScanInputInfo; rp:TRcvProperty; APValue:pointer):boolean;
begin
  RcvSetProp := false;
  if SII = nil then
    exit;
  case rp of
    rpZeroTime: SII^.pktinfo.EndTime := PLongint(APValue)^;
  else
    exit;
  end;
  RcvSetProp := true;
end;

function RcvGetPktInfo(SII:PScanInputInfo; var ai:TApexPacketInfo): boolean;
  { called to retrieve incoming packets from fifo, returns true if ai filled,
    should be called repeatedly until returns false }
begin
  RcvGetPktInfo := false;
  if SII = nil then
    exit;
  with SII^ do begin
    if ListRecGet(fifo, ai) then begin
      RcvGetPktInfo := true;
    end;
  end;
end;

function RcvDone(var SII:PScanInputInfo):boolean;
begin
  RcvDone := false;
  if SII = nil then
    exit;
  with SII^ do begin
    ClassFree(Drv);
    if fifo <> nil then
      ListDone(fifo);
  end;
  Dispose(SII);
  SII := nil;
  RcvDone := true;
end;

end.
