unit GenDevu;{ Base class for creating ExtDev DLLs - CHROMuLAN plugins,
drivers for external devices not directly supported by CHROMuLAN.
See GenDev.dpr }

interface
uses
  Classes, SysUtils, IniFiles, // standard Delphi unit
  Fifou, ExeLogu, Timer, IniClassu,// CHROMuLAN utility units (not directly related to CHROMuLAN)
  UlanType, GenDevType  // CHROMuLAN specific types definitions
  ;

{
  The following exported functions (between EXPORT and /EXPORT lines)
  will be called by Chromulan, either upon program startup or
  during acquistion (for the channel, which have assigned
  this device).

  The functions return 0 upon success, negative number upon error. See
  UlanType.pas edrXXXX section for their description.

  If the function returns 1, it means, that the driver wants to send some
  data to the device, so Chromulan will call ExtDevGetStr(epPktReqStr)
  and will send the returned data to the device.

  !!! You just have to create a TGenDev descendant class, override some methods
  (see bellow) and assign to GenDevClass variable (see below) the type
  of your descendant. !!!

  If you do not want to use for some reason TGenDev descendant and the following
  exported methods, you must implement all the following methods by yourself
  (those marked Optional do not have to be exported by the DLL).

}


{ The first method to be called - load, initialize the driver, get handle
  of the driver - AExtDevDrv. AName as a string that can be assigned
  in Chromulan in browser of devices. This device will appear in the list,
  if its DLL is found in dev subdirectory of Chromulan installation directory
  (and if the DLL has all the following methods exported). }
function ExtDevInit(var AExtDevDrv: PExtDevDrv; const AName: shortstring): integer; export;

function ExtDevDoAction(AExtDevDrv: PExtDevDrv; ea: TExtDevAction; AInfo: longint): integer;export;

{ Optional. Can be used to set some properties of the driver/device. }
function ExtDevSetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; const S: shortstring):integer; export;

{ Optional. If the device needs some kind of input from device driver, then
  this method must be implemented and should return non empty property
  epPktReqStr (see UlanType.pas epXXXX section). The function is then called
  with epPktReqStr parameter upon acquisition start, after some data received
  or every second. }
function ExtDevGetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; var S: shortstring):integer; export;

{ Called when acquisition started. }
function ExtDevStart(AExtDevDrv: PExtDevDrv): integer; export;

{ Called when acquisition stopped. }
function ExtDevStop(AExtDevDrv: PExtDevDrv): integer; export;

{ Called during acquisition when a character ch comes through the device's port
  (i.e., all characters are read by Chromulan and given (forwarded) to the
  device driver using this method.) More devices can share the same port, if they
 do not want to control the port (see ExtDevGetStr).  }
function ExtDevDoCharIn(AExtDevDrv: PExtDevDrv; ch:char): integer; export;

{ Called to retrieve data point (assembled by the driver from characters
  obtained by DoCharIn method), should return 0 if some point
  is available, assign it to APoint and remove the point from the internal buffer.
  If no point is available return -1. }
function ExtDevReadPoint(AExtDevDrv: PExtDevDrv; var APoint: TExpPoint): integer; export;

{ Deinitialize, unload the driver.}
function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer; export;


type

  TGenDev = class(TComponent)
  protected
    { Fifo of experimental points extracted from incoming packets (in DoChrIn method)
      to be returned by call to ReadPoint method. }
    FFifo: TFifo;

    {ini}
    { Defines size of FFifo }
    FFifoSlotCount: integer;
    { In what interval sends the device data. If zero, then real time is used
      for X values of data points. }
    FInterval: integer;{ in ms }
    { Maximal length of the incoming packet, used for error checking }
    FMaxPktLen: integer;
    { Multiply incoming Y value by this coef. Default = 1. }
    FMultY: single;
    { Add this value to incoming Y value (after multiplication with MultY). Default = 0. }
    FAddY: single;
    { String that must be sent to the device to get the packet }
    FPktReqStr: shortstring;
    { Interval in ms in which response from the device should be obtained since
      request pkt was sent (has meaning only if PktReqStr defined, i.e. the device
      must be questioned for the data) . }
    { If true, then FPktReqStr is not getting changed during the acquisition
      (used the default one or the one from ini file. Otherwise it FPktReqStr
      is not used or must be reset to something when complete packet received
      (in IsInputPacketFinished method) }
    FPktReqStrConstant: boolean;

    FRequestTimeout: integer;
    { If true, then the driver will open the port by itsels (in PortBeforeOpen
      method) and close it (in PortBeforeClose method). }
    FHandlingIO: boolean;
    {/ini}

    {runtime}
    { Current time in ms, used if Interval specified }
    FCurTime: single;

    { Currently beeing contructed input packet from incoming bytes (in DoCharIn method) }
    FCurPkt: shortstring;

    { Current value used in the process of extracting values from the finished
      incoming packet. }
    FCurVal: single;

    { Time in ms when acquisition from device was started, used if no Interval
      specified. }
    FZeroTime: single;

    FZeroValue: single;

    { Is the device running? (The Start method was called and Stop was not yet.) }
    FRunning: boolean;

    { Result of the last method call. }
    FLastResult: TExtDevResult;

    { last FPktReqStr retrieved by GetStr method }
    FLastPktReqStr: shortstring;

    { Time in ms when last char was received (obtained by DoCharIn) }
    FLastReceiveTime: integer;
    {/runtime}

    function GetLogActive: boolean;
    procedure SetLogActive(OnOff: boolean);

    function GetPktReqStrHex: string;
    procedure SetPktReqStrHex(AStr: string);
    procedure CheckTimeout;

  protected
    { function DoLine: integer;}
    procedure SetResult(er: TExtDevResult; const msg: string);

    { This method is called just before the serial port with name
      PShortString(AInfo)^ is opened (e.g. 'COM1', 'COM2', ...).
      Parameters of this port can be changed by writing them to
      Chromulan.ini file (see example), from where Chromulan will read
      them before actual opening of the port. }
    procedure PortBeforeOpen(AInfo: longint); virtual;
    procedure PortBeforeClose(AInfo: longint); virtual;
    procedure PortAfterClose(AInfo: longint); virtual;

    { Called as the last from Create after params loaded from .ini. }
    procedure DoAfterCreate; virtual;

    procedure DoOnStart; virtual;
    procedure DoOnStop; virtual;

    { Called after default values set, override if you want to change
      them (loading from .ini will follow)}
    procedure SetDefaults; virtual;

    { Called from DoCharIn.
      Checks if the data in FCurPkt already contain at least one completed packet.
      Always override to do something if not overriding DoCharIn.}
    function IsInputPacketFinished: boolean; virtual; abstract;

    { Called from DoCharIn.
      Extracts from completed FCurPkt next data value, assign it to FCurVal,
      return true is there was some value, otherwise false. Called repeatedly
      until returns false, i.e. if in one packet contains more values, some
      returned points counter should be set to 0 in IsInputPacketFinished method
      or the FCurPkt can be trimmed sequentially.
      Always override if not overriding DoCharIn. }
    function ExtractCurVal: boolean; virtual; abstract;

    { Return true, if something must be sent to device (request for new packet,
      repeated packet, ...). Then return this packet in the call
      GetStr(epPktReqStr). By default returns true if FPktReqStr <> ''. }
    function NeedsToSendPacket: boolean; virtual;

    { Check if the number of bytes in FCurPkt is larger than maximal allowed
      packet length. }
    function IsInputPacketTooLong: boolean; virtual;
    procedure Log(const Msg: string);
    function PktLogStr(const pkt: string): string;
  public
    constructor Create(AOwner: TComponent; const AName: string); reintroduce;
    destructor Destroy; override;

    {methods called from exported functions }
    function Start: integer; virtual;
    function Stop: integer; virtual;
    function DoAction(ea: TExtDevAction; AInfo: longint): integer; virtual;
    function DoCharIn(ch:char): integer; virtual;
    function ReadPoint(var APoint: TExpPoint): integer; virtual;
    function GetStr(ep: TExtDevProperty; var S: shortstring): integer; virtual;
    function SetStr(ep: TExtDevProperty; const S: shortstring): integer; virtual;
    {/methods..}
  published { all published properties are stored/restored to/from .ini file }
    property Interval: integer read FInterval write FInterval;
    property PktReqStrHex: string read GetPktReqStrHex write SetPktReqStrHex;
    property PktReqStrConstant: boolean read FPktReqStrConstant write FPktReqStrConstant;
    property LogActive: boolean read GetLogActive write SetLogActive;
    property MaxPktLen: integer read FMaxPktLen write FMaxPktLen;
    property MultY: single read FMultY write FMultY;
    property AddY: single read FAddY write FAddY;
    property RequestTimeout: integer read FRequestTimeout write FRequestTimeout;
    property HandlingIO: boolean read FHandlingIO write FHandlingIO;
  end;
  TGenDevClass = class of TGenDev;

  TGenDevs = class(TIniClass)
  protected
    { List of channel/device names handled by the DLL }
    FDeviceList: string;
    function GetDeviceList: string; virtual;
  public
    property DeviceList: string read GetDeviceList write FDeviceList;
  end;
  TGenDevsClass = class of TGenDevs;

var
  GenDevClass: TGenDevClass = TGenDev;
  GenDevsClass: TGenDevsClass = TGenDevs;

implementation
uses
  PropUtl, BinHex, DLLUtl;

const
  { Default number of slots for experimental points allocated in Fifo }
  DefFifoSlotCount: integer = 1024;

var
  FDevs: TGenDevs;

function Devs: TGenDevs;
begin
  if FDevs = nil then
    FDevs := GenDevsClass.Create(nil);
  Result := FDevs;
end;

{TGenDevs.}
function TGenDevs.GetDeviceList: string;
begin
  Result := FDeviceList;
end;
{/TGenDevs.}

{TGenDev.}
procedure TGenDev.SetResult(er: TExtDevResult; const msg: string);
begin
  FLastResult := er;
  if er < 0 then begin
     Log('ER: ' + inttostr(er) + ' ' + msg);
  end;
end;

constructor TGenDev.Create(AOwner: TComponent; const AName: string);
begin
  inherited Create(AOwner);
  FAddY := 0;
  FMultY := 1;
  FFifoSlotCount := DefFifoSlotCount;
  Name := AName;

  SetDefaults;
  ClassReadWriteIniFile(Self, 2, '', true);
  FFifo := TFifo.Create(sizeof(TExpPoint), FFifoSlotCount);
  DoAfterCreate;
end;

procedure TGenDev.SetDefaults;
begin
end;

procedure TGenDev.DoOnStart;
begin
end;
procedure TGenDev.DoOnStop;
begin
end;

procedure TGenDev.DoAfterCreate;
begin
end;

function TGenDev.Start: integer;
begin
  FLastResult := 0;
  FCurTime := 0;
  FCurPkt := '';
  FZeroTime := mstime;
  FFifo.Clear;
  {
  if FTermStr = '' then begin
    SetResult(edrNoTermStrPacketsNotSupported, '');
    Result := FLastResult;
  end else}
  begin
    FRunning:= true;
  end;
  DoOnStart;
  Result := FLastResult;
end;

function TGenDev.Stop: integer;
begin
  FLastResult := 0;
  FRunning := false;
  DoOnStop;
  Result := FLastResult;
end;

destructor TGenDev.Destroy;
begin
  FFifo.Free;
  ClassReadWriteIniFile(Self, 2, '', false);
  inherited Destroy;
end;

procedure TGenDev.PortBeforeClose(AInfo: longint);
begin
end;

procedure TGenDev.PortAfterClose(AInfo: longint);
begin
end;

procedure TGenDev.PortBeforeOpen(AInfo:longint);
//  COMx:1200,N,7,2,RS,CD,DS,CD
//  (flow control none,RTS On/Off,DTR On, all other off)
var
  sec: shortstring;
  f: TIniFile;
  bn, fn: string;
  cd, ed: string;
begin
  if AInfo = 0 then begin
    {setresult}
    exit;
  end;

  exit;
  // if you want to do something with ini file or to open port here,
  // remove exit and do it

  bn := 'Chromulan.ini';
  { cd is the current directory. }
  GetDir(0, cd);
  { DLL should be in div subdirectory of Chromulan exe directory, so
    Chromulan exe directory is probably ed + '\..' }

  ed := ExtractFileDir(GetModuleName(HInstance));
  { This is how ini file is searched in Chromulan (curdir, exedir): }
  fn := FileSearch(bn, cd + ';' + ed + '\..' +';' + ed );


  f := TIniFile.Create(fn);
  sec := PShortString(AInfo)^;
  try
    (* put here real default parameters for this device, eventually
       load them from device's ini file and write them to chromulan.ini

    f.WriteString(sec, 'bps','1200');
    f.WriteString(sec, 'parity','N');
    f.WriteString(sec, 'stopbits','1');
    f.WriteString(sec, 'databits','7');
    f.WriteString(sec, 'FlowControl','DTR');
    f.WriteString(sec, 'ParityCheck', '0');
    f.WriteString(sec, 'DsrSensitivity', '0');
    f.WriteString(sec, 'IgnoreXOff','0');
    f.WriteString(sec, 'UseErrorChar','0');
    f.WriteString(sec, 'NullStrip','0');
    f.WriteString(sec, 'AbortOnError','0');
    f.WriteString(sec, 'UseIniPars','1');
    f.WriteString(sec, 'DTROnOpen','1');
    f.WriteString(sec, 'RTSOnOpen','1');
    f.WriteString(sec, 'XOnOnOpen','0');
    f.WriteString(sec, 'BreakOnOpen','0');
    *)
  finally
    f.Free;
  end;
end;

function TGenDev.DoAction(ea: TExtDevAction; AInfo: longint): integer;
begin
  FLastResult := 0;
  case ea of
    eaPortBeforeOpen: PortBeforeOpen(AInfo);
    eaPortBeforeClose: PortBeforeClose(AInfo);
    eaPortAfterClose: PortAfterClose(AInfo);
  else
    SetResult(edrInvalidExtDevAction, IntToStr(ea));
  end;
  Result := FLastResult;
end;

{
function TGenDev.DoLine: integer;
var
  ep: TExpPoint;
  code: integer;
  pkt: Tpkt;
begin
  Result := 0;
  if PktFind(copy(FCurPkt, 1, length(FCurPkt) - length(FTermStr)), pkt) then begin

    val(copy(FCurPkt, length(pkt.Prefix) + 1, length(pkt.Mask)), FCurVal, code);


  end else begin
    if length(FCurPkt) > maxpktlen then begin
      SetResult(edrPktDefNotFound, FCurPkt);
      Result := FLastResult;
    end;
  end;
end;
}

{ Check if the number of bytes in FCurPkt is larger than maximal allowed
  count. }
function TGenDev.IsInputPacketTooLong: boolean;
begin
  if FMaxPktLen > 0 then begin
    Result := length(FCurPkt) > FMaxPktLen;
  end else begin
    Result := false;
  end;
end;

function TGenDev.NeedsToSendPacket: boolean;
begin
  Result := FRunning and (FPktReqStr <> '');
end;


function TGenDev.DoCharIn(ch:char): integer;
var
  b: byte absolute ch;
  ep: TExpPoint;
begin
  FLastReceiveTime := mstime;
  if FRunning then begin
    FLastResult := 0;
    FCurPkt := FCurPkt + ch;

    { Do whatever here to decode data points from incoming chars. If
      packet should be sent out as a result of the data decoding (e.g.
      transmision error detected - requesting packet to be sent again,
      or if every packet from the device must be explicitely requested from
      driver) then DoChrIn Result should be set to 1. }
    if LogActive then
      Log('Char In: ' + ch + ' ' + ByteToHex(ord(ch)));{binhex}

    if IsInputPacketFinished then begin
       while ExtractCurVal do begin
          FCurVal := FCurVal * FMultY + FAddY;
          ep.Y := FCurVal;
          if FInterval <> 0 then begin
            ep.X := FCurTime / 1000;
            FCurTime := FCurTime + FInterval;
          end else begin
            ep.X := (mstime - FZeroTime) / 1000
          end;
          if not FFifo.Put(ep) then begin
            SetResult(edrBufferFull, FCurPkt);
          end;
       end;
       FCurPkt := '';
       if NeedsToSendPacket then
         SetResult(edrNeedsToSendPacket, '');
    end else if IsInputPacketTooLong then begin
       SetResult(edrInvalidInput, FCurPkt);
       FCurPkt := '';
    end;


    { E.g.:
    if FTermStr <> '' then begin
      if copy(FCurPkt, length(FCurPkt) - length(FTermStr) + 1,
        length(FTermStr)) = FTermStr then
      begin
        DoLine;
      end else begin
        if length(FCurPkt) > MaxPktLen then begin
          SetResult(edrInvalidInput, FCurPkt);
          FCurPkt := '';
        end;
      end;
    end;}

  end else begin
    SetResult(edrNotRunning, '');
  end;
  Result := FLastResult;
end;

function TGenDev.ReadPoint(var APoint: TExpPoint): integer;
begin
  if FFifo.Get(APoint) then begin
    FLastResult := 0
  end else begin
    FLastResult := -1;
    CheckTimeout;
  end;
  Result := FLastResult;
end;

procedure TGenDev.CheckTimeout;
begin
  if NeedsToSendPacket then begin
    if (mstime - FLastReceiveTime) > FRequestTimeout then begin
      SetResult(edrNeedsToSendPacket,'');//ulantype
    end;
  end;
end;


function TGenDev.GetStr(ep: TExtDevProperty; var S: shortstring): integer;
begin
  FLastResult := 0;
  S := '';
  case ep of
    epPktReqStr: begin
      S := FPktReqStr;
      if (S <> '') then begin
        FLastPktReqStr := S;
        if LogActive then
          Log('PktReqStr: ' + S + ' Hex:' + StringToHex(S) + ':');{binhex}
        if not FPktReqStrConstant then
          FPktReqStr := '';
      end;
    end;
    epHandlingIO: begin
      if FHandlingIO then begin
        S := 'true';
      end else begin
        S := 'false';
      end;
    end;
    epDeviceList: begin
      S := Devs.DeviceList;
    end;
   {  epQuantityName: S := FQuantityName;
    epUnitName: S := FUnitName;
    epComMode: S := ComMode;}
  else
    SetResult(edrInvalidGetStrProp, IntToStr(ep));
  end;
  Result := FLastResult;
end;

function TGenDev.SetStr(ep: TExtDevProperty; const S: shortstring): integer;
begin
  FLastResult := 0;
  {case ep of
    epID: ID := s;
  else
  }
  SetResult(edrInvalidSetStrProp, IntToStr(ep));
  {end;}
  Result := FLastResult;
end;

function TGenDev.GetLogActive: boolean;
begin
  Result := ExeLog.Active;
end;

procedure TGenDev.SetLogActive(OnOff: boolean);
begin
  ExeLog.Active := OnOff;
end;

procedure TGenDev.Log(const Msg: string);
begin
  ExeLog.Log(Msg);
end;

function TGenDev.PktLogStr(const pkt: string): string;
begin
  Result := pkt + ' Hex:' + StringToHex(pkt) + ':';
end;

function TGenDev.GetPktReqStrHex: string;
begin
  Result := StringToHex(FPktReqStr);
end;

procedure TGenDev.SetPktReqStrHex(AStr: string);
begin
  FPktReqStr := HexToString(AStr);
end;
{/TGenDev.}

{ExtDevXXXX}
function ExtDevInit(var AExtDevDrv: PExtDevDrv; const AName: shortstring): integer;export;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  try
    adrv := GenDevClass.Create(Devs, AName);
    Result := edrOK;
  except
    adrv := nil;
    Result := edrDevicesInitFailed;
  end;
end;

function ExtDevSetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; const S: shortstring):integer; export;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then
    Result := adrv.SetStr(ep, s);
end;

function ExtDevGetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; var S: shortstring):integer; export;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then begin
    Result := adrv.GetStr(ep, s);
  end else begin
    case ep of
      epDeviceList: begin
        s := Devs.DeviceList;
      end;
    else
      Result := edrInvalidGetStrProp;
    end;
  end;
end;

function ExtDevDoAction(AExtDevDrv: PExtDevDrv; ea: TExtDevAction;
  AInfo: longint): integer;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then
    Result := adrv.DoAction(ea, AInfo);
end;


function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer;export;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then begin
    adrv.Free;
    AExtDevDrv := nil;
    Result := 0;
  end;
end;

function ExtDevStart(AExtDevDrv: PExtDevDrv): integer;
var
  adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then
    Result := adrv.Start;
end;

function ExtDevStop(AExtDevDrv: PExtDevDrv): integer;
var adrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then
    Result := adrv.Stop;
end;

function ExtDevDoCharIn(AExtDevDrv: PExtDevDrv; ch:char): integer;
var
  ADrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if ADrv <> nil then
    Result := ADrv.DoCharIn(ch);
end;

function ExtDevReadPoint(AExtDevDrv: PExtDevDrv; var APoint: TExpPoint): integer;
var
  ADrv: TGenDev absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if ADrv <> nil then
    Result := ADrv.ReadPoint(APoint);
end;
{/ExtDevXXXX}


initialization

finalization
  FreeAndNil(FDevs);
end.
