unit JanasCardModuleu;

interface

uses
  SysUtils, Classes, ExtCtrls, Math,
  UtlType, CommInt, Timer, Fifou, UlanType, ObjList, ExeLogu,
  PropUtl;

const
  jcr0 = -4000;
  jcrDeviceOpenFailed = jcr0 - 1;
const
  MaxAveragePointCount = 100;
  HzFilter = 64;

type
  TAverageBuffer = array[0..MaxAveragePointCount - 1] of TYValue;

  TAvg = class(TObject)
  private
    FAverageBuffer: TAverageBuffer;
    FPointCount: integer;
    FIndex: integer;
  public
    constructor Create;
    function Avg(AY: TYValue): TYValue;
  end;

type
  TLogProc = procedure(s: string) of object;
  TADValue = word;

  TJComm = class(TComm)
  private
    FUseCount: integer;
    FAdresa: byte; // which adresa (corresponds to channel) is beeing read
    //FTimerID: byte; // which timer is using this port right now
  public
    constructor Create(Owner: TComponent); override;
  end;

  TJanasCardModule = class(TDataModule)
    Timer: TTimer;
    procedure DataModuleCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);

    { Makes sure Stop and Close were called. }
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    Comm: TJComm;
    //FTimerID: byte; // id of Timer in this module
    order: byte;
    hodnota: byte;
    value: TADValue;
    FRunning: boolean; // was Start called?, i.e. collecting ADValues to buffer?
    FBuffer: TCircularBuffer; // Circular buffer with values from the converter.
    FInTimer: boolean;
    FOnLog: TLogProc;
    {ini}
    FBufSlotCount: integer; // initial value for FBufer constructor
    FTimerInterval: integer;
    FAdresa: byte;
    FStartTime: integer; // when Start was called
    {/ini}
    FAvg: TAvg;

    { If OnLog assigned, writes s there using the method. }
    procedure Log(s: string);
    procedure DebLog(s: string);

    { Write one (controlling) byte to AD converter and get one byte from the
      converter at the same time. }
    function janas(outdata: byte): byte;
    procedure SetChannel(Index: integer);
    function GetChannel: integer;

    { Returns string in the format COMx[.y] where x is number of serial port
      optional y (default = 0) is number of input channel in JanasCard (0..3) }
    function GetDeviceName: string;
    { Set string COMx[.y] (see above) to set new serial port and channel }
    procedure SetDeviceName(ADeviceName: string);

    function GetStr(ep: TExtDevProperty; var S: shortstring):integer;
    function DoAction(ea: TExtDevAction; AInfo: longint): integer;
    function ReadPoint(var APoint: TExpPoint): integer;
  public
    { Public declarations }
    { Open the communication port. Called from Start if necessary.}
    function Open: integer;

    { Start stuffing values from the converter to the buffer. Until Stop
      called, ValueReadStart will be called repeatedly. ValueRead must be
      called from time to time to empty the buffer. Port should be opened using
      Open procedure (but will get opened if it was not). }
    function Start: integer;

    { Start reading one value from the AD converter. Called automatically if
      Start was called (and not Stop). Port must be opened using Open procedure. }
    procedure ValueReadStart;

    { Read the received value from the buffer (returns true if some was really
      read). }
    function ValueRead(var APoint: TExpPoint{var value: TADValue}): boolean;

    { Stop collecting values from AD converter (stuffing them to the Buffer) }
    function Stop: integer;

    { Close the communication port. Stop should be called first (but will be
      here if it was not). }
    procedure Close;

  published
    property DeviceName: string read GetDeviceName write SetDeviceName;
    property Channel: integer read GetChannel write SetChannel;
    property BufSlotCount: integer read FBufSlotCount write FBufSlotCount;
    property TimerInterval: integer read FTimerInterval write FTimerInterval;
    property OnLog: TLogProc read FOnLog write FOnLog;
  end;

var
  JanasCardModule: TJanasCardModule;


function ExtDevInit(var AExtDevDrv: PExtDevDrv; const AName: shortstring): integer; export;
function ExtDevDoAction(AExtDevDrv: PExtDevDrv; ea: TExtDevAction; AInfo: longint): integer;export;
function ExtDevSetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; const S: shortstring):integer; export;
function ExtDevGetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; var S: shortstring):integer; export;
function ExtDevStart(AExtDevDrv: PExtDevDrv): integer; export;
function ExtDevStop(AExtDevDrv: PExtDevDrv): integer; export;
function ExtDevDoCharIn(AExtDevDrv: PExtDevDrv; ch:char): integer; export;
function ExtDevReadPoint(AExtDevDrv: PExtDevDrv; var APoint: TExpPoint): integer; export;
function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer; export;


implementation

{$R *.dfm}

//var
//  FLastTimerID: byte = 1; // assigned to every created timer, then increased


{ini.lst}
var
  LogY: boolean = false; // should the Log(MaxY/Y) value be returned instead of Y?
  MaxY: integer = 1024 * 128; // maximal possible experimental value returned by JanasCard
  AveragePointCount: integer = 8; // How many points should be averaged (smoothing the curve)
{/ini.lst}

type
  TJanasEx = class(Exception);

  TCommPorts = class(TObjList)
    { Get access to the (eventually opened) port of specified name (e.g. COM1) }
  private
    function GetPort(Index: integer): TJComm;
  public
    function Get(APortName: shortstring): TJComm;
    { Release acces to this port }
    procedure Release(AComm: TJComm);

    property Ports[Index: integer]:TJComm read GetPort;
  end;

{TAvg.}
constructor TAvg.Create;
begin
  inherited;
  //FAverageBuffer: TAverageBuffer;
  FPointCount := 0;
  FIndex := 0;
end;

function TAvg.Avg(AY: TYValue): TYValue;
var
  i: integer;
  t: TYValue;
begin
  if FPointCount < AveragePointCount then begin
    FAverageBuffer[FPointCount] := AY;
    inc(FPointCount);
  end else begin
    FAverageBuffer[FIndex] := AY;
  end;
  inc(FIndex);
  if FIndex = AveragePointCount then
    FIndex := 0;

  t := 0;
  for i := 0 to FPointCount - 1 do begin
    t := t + FAverageBuffer[i];
  end;
  Result := t / FPointCount;
end;

{TJComm.}
constructor TJComm.Create(Owner: TComponent);
begin
  inherited;
  AfterOpenState := aoSpecified;
  BaudRate := br1200;
  BreakOnOpen := esOff;
  Databits := da8;
  DeviceName := 'COM2';
  DTROnOpen := esOn;
  FlowControl := fcDefault;
  Options := [];
  Parity := paNone;
  ReadBufSize := 4096;
  ReadTimeout := 1000;
  RTSOnOpen := esOn;
  Stopbits := sb10;
  WriteBufSize := 2048;
  WriteTimeout := 1000;
  XOnOnOpen := esOn;
end;
{/TJComm}

{TCommPorts.}
var
  FCommPorts: TCommPorts = nil;

function CommPorts: TCommPorts;
begin
  if FCommPorts = nil then
    FCommPorts := TCommPorts.Create;
  Result := FCommPorts;
end;

function TCommPorts.GetPort(Index: integer): TJComm;
begin
  Result := TJComm(Items[Index]);
end;

function TCommPorts.Get(APortName: shortstring): TJComm;
var i: integer;
begin
  for i := 0 to Count - 1 do begin
    if Ports[i].DeviceName = APortName then begin
      Result := Ports[i];
      inc(Result.FUseCount);
      exit;
    end;
  end;
  Result := TJComm.Create(nil);
  Result.DeviceName := APortName;
  inc(Result.FUseCount);
  Add(Result);
end;

procedure TCommPorts.Release(AComm: TJComm);
var i: integer;
begin
  for i := 0 to Count - 1 do begin
    if AComm = Ports[i] then begin
      dec(AComm.FUseCount);
      exit;
    end;
  end;
  raise TJanasEx.Create('TCommPorts.Release - Comm not found');
end;
{/TCommPorts.}

procedure TJanasCardModule.DataModuleCreate(Sender: TObject);
begin
  FBufSlotCount := 1024;
  FTimerInterval := 40;
  //FTimerID := FLastTimerID;
  //inc(FLastTimerID);
  FAdresa := 1;
  FBuffer := TCircularBuffer.Create(sizeof(TExpPoint{value}), FBufSlotCount);
  FAvg := TAvg.Create;
end;

procedure TJanasCardModule.DebLog(s: string);
begin
  Log(s);
end;


function TJanasCardModule.janas(outdata: byte): byte;
var
  i: byte; // pom. promenna pro realizaci cyklu
  delitel: byte;
  ven: byte;
  BDSR: byte;
  precteno: byte;
  timeout: longint;
  zero: byte;
begin
  timeout := mstime + 2;

  ven := outdata;
  delitel := 128;
  //Comm.Output := Chr(0);   // aktivuj CS vyslanim nuloveho bitu....
  zero := 0;
  Comm.Write(zero, 1);

  //While Comm.CDHolding = False do begin //ceka, az se bude realne vysilat, tj. CS aktivni
  //end;
  while true do begin
    if Comm.RLSD then begin
      //Log('RlsHold ON');
      break;
    end;
    if (mstime >  timeout) then begin
      //Log('RlsHold timedout');
      break;
    end;
  end;

  precteno := 0;  // nuluj  snimaci hodnota
  for i := 0 to 7 do begin // celkem 8 taktu hodin
    if (ven div delitel) = 1 then begin     // data IN bit pripravit na linku... >> RTS <<
        //Comm.RTSEnable := False;
        Comm.SetRTSState(false);
    end else begin
        //Comm.RTSEnable := True;
        Comm.SetRTSState(true);
    end;
    ven := ven mod delitel;
    delitel := delitel div 2;

    //Comm.DTREnable := False      // clk = >> DTR <<  na log. 0, pocatek synchronizacniho pulsu...
    Comm.SetDTRState(false);

    //if (Comm.DSRHolding = True) then
    if Comm.DSR then // precti data OUT
    begin
      BDSR := 0;
    end else begin
      BDSR := 1;
    end;
    precteno := (precteno * 2) + BDSR;
    //Comm.DTREnable := True;   //' clk = >> DTR <<  na log.1 , konec  synchronizacniho pulsu...
    Comm.SetDTRState(true);
  end;
  Result := precteno;  // hodnota pro navrat z funkce
end;

procedure TJanasCardModule.TimerTimer(Sender: TObject);
var APoint: TExpPoint;
begin
  if FInTimer then begin
    Log('Recursing to timer, exit.');
    exit;
  end;
  if (Comm = nil) or (not Comm.Enabled) then begin
    Log('Exiting timer because of not Comm.Enabled');
    exit;
  end;

  //if (Comm.FTimerID <> 0) and (Comm.FTimerID <> FTimerID) then
  //  exit;// do not disturb reading from other address
  if (Comm.FAdresa <> 0) and (Comm.FAdresa <> FAdresa) then begin
    DebLog('Exiting timer because of Comm.FAdresa mismatch ' +
      IntToStr(Comm.FAdresa) + ' <> ' + IntToStr(FAdresa));
    exit; // do not disturb reading from other address
  end;

  FInTimer := true;
  try
    DebLog('InTimer order, FAdresa: '+ IntToStr(order) + ', ' + IntToStr(FAdresa));
    try
      case order of
        0: begin
          Comm.FAdresa := FAdresa;
          hodnota := janas(FAdresa);
          //Log('order=' + IntToStr(order) + ' hodnota(adr=' + IntToStr(FAdresa) + ')=' + IntToStr(hodnota));
        end;
        1: begin
          hodnota := janas(132 + HzFilter);
          //Log('order=' + IntToStr(order) + ' hodnota(132)=' + IntToStr(hodnota));
        end;
        2: begin
          hodnota := janas(0 + HzFilter);
          //Log('order=' + IntToStr(order) + ' hodnota(0)=' + IntToStr(hodnota));
          value := hodnota;
        end;
        3: begin
          hodnota := janas(2 + HzFilter);
          value := (value * 256) + hodnota;
          //Log('order=' + IntToStr(order) + ' hodnota(2)=' + IntToStr(order) + ' value=' + IntToStr(value));
          Log('value=' + IntToStr(value));

          APoint.X := (mstime - FStartTime) / 1000;

          if LogY then begin
            APoint.Y := log10(MaxY / value);
          end else begin
            APoint.Y := value;
          end;

          if FBuffer <> nil then FBuffer.Put(APoint);

          //if FBuffer <> nil then FBuffer.Put(value);
        end;
        4: begin
          hodnota := janas(1);
          //Log('order=' + IntToStr(order) + ' hodnota=' + IntToStr(hodnota));
          Comm.FAdresa := 0; // not reading adresa anymore
        end;
        //5: begin
          // give a chance to the other timers to catch the freed Comm (with FAdresa = 0)
        //end;
      else
        //Log('konec prevodu'); specform
        if FRunning then begin
          ValueReadStart;
          exit;
        end else begin
          Timer.Enabled := False;
        end;
      end;

      order := order + 1;
    except
      Timer.Enabled := false;
    end;
  finally
    FInTimer := false;
  end;
end;

procedure TJanasCardModule.Log(s: string);
var msg: string;
begin
  msg := DeviceName + ': ' + s;
  if Assigned(FOnLog) then
    FOnLog(msg);
  ExeLog.Log(msg);
end;



procedure TJanasCardModule.ValueReadStart;
begin
  try
    DebLog('ValueReadStart');
    order := 0;
    Timer.Interval := FTimerInterval;
    Timer.Enabled := True;   // povol sber dat
  except
    Timer.Enabled := false;
  end;
end;

function TJanasCardModule.Start: integer;
begin
  Result := Open;
  if Result = 0 then begin
    FRunning := true;
    FStartTime := mstime;
    ValueReadStart;
  end;
end;

function TJanasCardModule.Stop: integer;
begin
  FRunning := false;
  if (Comm <> nil) and (Comm.FAdresa = FAdresa) then
    Comm.FAdresa := 0; // release Comm for reading other adresas
  Result := 0;
end;

function TJanasCardModule.Open: integer;
begin
  //Comm.DeviceName := ComNameEdit.Text;
  Result := 0;
  if not Comm.Enabled then begin
    try
      Comm.Open;
      Comm.Thread.DontSynchronize := true;
      Comm.SetDTRState(true);
      Comm.SetRTSState(false);
      Timer.Enabled := False;
    except
      Result := jcrDeviceOpenFailed;
    end;
  end;
end;

procedure TJanasCardModule.Close;
begin
  Stop;
  Timer.Enabled := False;
  if Comm.Enabled then
    Comm.Close;
end;

function TJanasCardModule.ValueRead(var APoint: TExpPoint{var value: TADValue}): boolean;
var t: TYValue;
begin
  //Result := FBuffer.Get(value);
  Result := FBuffer.Get(APoint);
  if Result then begin
    if AveragePointCount > 0 then begin
      t := APoint.Y;
      APoint.Y := FAvg.Avg(t);
    end;
  end;
end;


procedure TJanasCardModule.DataModuleDestroy(Sender: TObject);
var b: TCircularBuffer;
begin
  Close;
  b := FBuffer;
  FBuffer := nil;
  if Comm <> nil then begin
    CommPorts.Release(Comm);
    Comm := nil;
  end;
  b.Free;
end;

procedure TJanasCardModule.SetChannel(Index: integer);
begin
  FAdresa := (((1 shl Index) - 1) * 16) + 1;
end;

function TJanasCardModule.GetChannel: integer;
var x: integer;
begin
  x := (FAdresa - 1) div 16 + 1;
  case x of
    1: Result := 0;
    2: Result := 1;
    4: Result := 2;
    8: Result := 3;
  else
    Result := -1;
  end;
end;


{ Returns string in the format COMx[.y] where x is number of serial port
  optional y (default = 0) is number of input channel in JanasCard (0..3) }
function TJanasCardModule.GetDeviceName: string;
begin
  Result := Comm.DeviceName + '.' + IntToStr(Channel);
end;

{ Set string COMx[.y] (see above) to set new serial port and channel }
procedure TJanasCardModule.SetDeviceName(ADeviceName: string);
var
  i: integer;
  fdn: string;
  rem: string;
begin
  i := pos('.', ADeviceName); {COM1.JanasCard.0 or COM1.JanasCard.1 ... }
  if i > 0 then begin
    fdn :=  copy(ADeviceName, 1, i - 1);
    rem :=  copy(ADeviceName, i + 1, length(ADeviceName));
    i := pos('.', rem);
    if i > 0 then begin
      Channel := StrToInt(copy(rem, i + 1, 1));
    end else begin
      Channel := StrToInt(rem);
    end;
  end else begin
    fdn := ADeviceName;
    Channel := 0;
  end;
  if (Comm = nil) then begin
    Comm := CommPorts.Get(fdn)
  end else begin
    if Comm.DeviceName <> fdn then begin
       CommPorts.Release(Comm);
       Comm := CommPorts.Get(fdn);
    end;
  end;
end;

function TJanasCardModule.GetStr(ep: TExtDevProperty; var S: shortstring):integer;
begin
  Result := 0;
  case ep of
    epHandlingIO: S := 'true';
    epDeviceList: S := '0 1 2 3';{ list of channels }
  else
    Result := edrInvalidGetStrProp;
  end;
end;

function TJanasCardModule.DoAction(ea: TExtDevAction; AInfo: longint): integer;
begin
  Result := 0;
  case ea of
    eaPortBeforeOpen: begin
      DeviceName := PShortString(AInfo)^;
      Result := Open;
    end;
    eaPortBeforeClose: begin
      Close;
    end;
  else
    Result := edrInvalidExtDevAction
  end;
end;

function TJanasCardModule.ReadPoint(var APoint: TExpPoint): integer;
//var value: TADValue;
begin
  Result := -1;
  if ValueRead(APoint{value}) then begin
    Result := 0;
    //APoint.X := (mstime - FStartTime) / 1000;
    //APoint.Y := value;
  end;
end;



var Cards: TObjList;

function ExtDevInit(var AExtDevDrv: PExtDevDrv; const AName: shortstring): integer;export;
var
  adrv: TJanasCardModule absolute AExtDevDrv;
begin
  if Cards = nil then begin
    try
      Cards := TObjList.Create;
    except
      Result := -1;
      exit;
    end;
  end;
  try
    adrv := TJanasCardModule.Create(nil);
    Cards.Add(adrv);
    Result := 0;
  except
    //Result := edrUnsupportedDeviceType;
    adrv := nil;
    Result := edrDevicesInitFailed;
  end;
end;

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

function ExtDevGetStr(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty; var S: shortstring):integer; export;
var
  adrv: TJanasCardModule absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then begin
    Result := adrv.GetStr(ep, s)
  end else begin
    case ep of
      epDeviceList: begin
        S := '0 1 2 3';{ list of channels }
        Result := 0;
      end;
    end;
  end;
end;

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

function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer;export;
var
  adrv: TJanasCardModule absolute AExtDevDrv;
begin
  Result := edrDeviceNotInitialized;
  if adrv <> nil then begin
    if Cards <> nil then begin
      Cards.Remove(ADrv);
    end;
    FreeAndNil(AExtDevDrv);
    Result := 0;
  end;
end;

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

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

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

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

procedure ConfigReadWrite(what: TReadWrite);
var s: string;
begin
  if what = rwRead then begin
    s := UpperCase(ChangeFileExt(ExtractFileName(GetModuleName(HInstance)), ''));
    if pos('LOG', s) > 0 then
      LogY := true;
  end;
  ConfigReadWriteValue(nil, what, 'JanasCard', 'LogY', @LogY, ptByte);
  ConfigReadWriteValue(nil, what, 'JanasCard', 'MaxY', @MaxY, ptLongint);
  ConfigReadWriteValue(nil, what, 'JanasCard', 'AveragePointCount', @AveragePointCount, ptLongint);
  if what = rwRead then begin
    if AveragePointCount > MaxAveragePointCount then
      AveragePointCount := MaxAveragePointCount;
  end;
end;

initialization
  Cards := nil;
  ConfigReadWrite(rwRead);
finalization
  ConfigReadWrite(rwWrite);
  FreeAndNil(Cards);
  FreeAndNil(FCommPorts);
end.
