unit ul_lcabs;

interface

uses
  Windows,
  Msgu, LogType, Logu, ListType, Listu, Timer,
  UlanType, WinUtl,
  ULDrvTyp, ULDrvUtl, ULDriver, ApexType;

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;

function RcvInit(var SII:PScanInputInfo; adr:longint): boolean;
  { getmem for SII, open driver, init packet fifo }

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

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

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 }

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

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; adr:longint): boolean;
var
  li:TListInfo;{listtype}
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
      SysLogLog(leError, 'ULDriver.Create failed.');
      goto er;
    end;

    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
            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;
        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.
