unit JanasCardModuleu;
{ Dead unit. The updated one is now in subdir ExtDev. }

interface

uses
  SysUtils, Classes, ExtCtrls, CommInt, Timer, Fifou;

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

  TJanasCardModule = class(TDataModule)
    Comm: TComm;
    Timer: TTimer;
    procedure DataModuleCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    { Makes sure Stop and Close were called. }
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    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;

    {/ini}

    { If OnLog assigned, writes s there using the method. }
    procedure Log(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);

  public
    { Public declarations }
    { Open the communication port. Called from Start if necessary.}
    procedure Open;

    { 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). }
    procedure Start;

    { 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 value: TADValue): boolean;

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

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

implementation

{$R *.dfm}

procedure TJanasCardModule.DataModuleCreate(Sender: TObject);
begin
  FBufSlotCount := 1024;
  FTimerInterval := 40;
  FAdresa := 1;
  FBuffer := TCircularBuffer.Create(sizeof(value), FBufSlotCount);
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);
begin
  if FInTimer then begin
    Log('Recursing to timer, exit.');
    exit;
  end;
  FInTimer := true;
  try
    try
      case order of
        0: begin
          hodnota := janas(FAdresa);
          //Log('order=' + IntToStr(order) + ' hodnota(adr=' + IntToStr(FAdresa) + ')=' + IntToStr(hodnota));
        end;
        1: begin
          hodnota := janas(132);
          //Log('order=' + IntToStr(order) + ' hodnota(132)=' + IntToStr(hodnota));
        end;
        2: begin
          hodnota := janas(0);
          //Log('order=' + IntToStr(order) + ' hodnota(0)=' + IntToStr(hodnota));
          value := hodnota;
        end;
        3: begin
          hodnota := janas(2);
          value := (value * 256) + hodnota;
          //Log('order=' + IntToStr(order) + ' hodnota(2)=' + IntToStr(order) + ' value=' + IntToStr(value));
          Log('value=' + IntToStr(value));
          if FBuffer <> nil then FBuffer.Put(value);
        end;
        4: begin
          hodnota := janas(1);
          //Log('order=' + IntToStr(order) + ' hodnota=' + IntToStr(hodnota));
        end;
      else
        //Log('konec prevodu');
        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);
begin
  if Assigned(FOnLog) then
    FOnLog(s);
end;

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

procedure TJanasCardModule.Start;
begin
  if not Comm.Enabled then
    Comm.Open;
  FRunning := true;
  ValueReadStart;
end;

procedure TJanasCardModule.Stop;
begin
  FRunning := false;
end;

procedure TJanasCardModule.Open;
begin
  //Comm.DeviceName := ComNameEdit.Text;
  Comm.Open;
  Comm.Thread.DontSynchronize := true;
  Comm.SetDTRState(true);
  Comm.SetRTSState(false);
  Timer.Enabled := False;
end;

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

function TJanasCardModule.ValueRead(var value: TADValue): boolean;
begin
  Result := FBuffer.Get(value);
end;


procedure TJanasCardModule.DataModuleDestroy(Sender: TObject);
var b: TCircularBuffer;
begin
  Close;
  b := FBuffer;
  FBuffer := nil;
  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;
begin
  i := pos('.', ADeviceName);
  if i > 0 then begin
    Comm.DeviceName := copy(ADeviceName, 1, i - 1);
    Channel := StrToInt(copy(ADeviceName, i + 1, 1));
  end else begin
    Comm.DeviceName := ADeviceName;
    Channel := 0;
  end;
end;


end.
