unit TimeInterval_Emulator;

interface
  USES Windows, Classes;

type
  tTime_ms=cardinal;
  tTimerError=(
    teOK,
    teWriteBeforeRead,
    teReadBeforeWrite,
    teNotReadyToStart
  );

resourcestring
  rsTeOK='OK';
  rsTeWriteBeforeRead='Запись времени в таймер, вперемешку с чтением';
  rsTeReadBeforeWrite='Чтение времени таймера, вперемешку с записью';
  rsTeNotReadyToStart='Запуск таймера невозможен, не все порты инициализированы';

const
  cTimerErrorMsg:array[tTimerError] of string=(
    rsTeOK,
    rsTeWriteBeforeRead,
    rsTeReadBeforeWrite,
    rsTeNotReadyToStart
  );

type
  tTimeIntervalX=class
    private
      StartTime:tTime_ms;
      EndTime:tTime_ms;
      Interval:tTime_ms;
      prResolution:uint;
    public
      constructor Create;
      destructor Destroy; override;

      procedure Start(TimeInterval_ms:tTime_ms);
      procedure Clear;
      function Expired:boolean;
      function Elapsed:tTime_ms;

      property Resolution:uint read prResolution;
  end;

  tByteCounter=0..1;
  tWord=record
    case byte of
    0:(w:word);
    1:(b:array[tByteCounter] of byte);
  end;

  tFlag=(fRead, fWrite);
  tFlags=set of tFlag;

  tTimerMI1201X=class(tTimeIntervalX)
    private
      prTime:tWord;
      prReadByteCounter,prWriteByteCounter:tByteCounter;
      prFlags:tFlags;
      prOnError:tNotifyEvent;
      prError:tTimerError;
      procedure SetTime(ATime:word);
      procedure DoOnError; virtual;
      procedure SetError(AError:tTimerError);  virtual;
      function GetErrorMsgs(AError:tTimerError):string;
      function GetErrorMsg:string;
    public
      procedure Init;
      procedure OutTime(b:byte);
      function  InTime:byte;
      property Time:word read prTime.W write SetTime;
      function  ReadyToStart:boolean;
      procedure Start;
      property OnError:tNotifyEvent read prOnError write prOnError;
      property Error:tTimerError read prError write SetError;
      property ErrorMsg:string read GetErrorMsg;
      property ErrorMsgs[AError:tTimerError]:string read GetErrorMsgs;
  end;

function GetTickCount:tTime_ms; register;
function TickSpend(t:tTime_ms):tTime_ms; register;

implementation
  Uses MMSystem, Emulator_MiscFuncs;

function tTimerMI1201X.GetErrorMsgs(AError:tTimerError):string;
begin
  Result:=cTimerErrorMsg[AError];
end;

function tTimerMI1201X.GetErrorMsg:string;
begin
  Result:=GetErrorMsgs(Error);
end;

procedure tTimerMI1201X.DoOnError;
  var localOnError:tNotifyEvent;
begin
  localOnError:=OnError;
  if Assigned(localOnError) then
    localOnError(Self);
end;

procedure tTimerMI1201X.SetError(AError:tTimerError);
begin
  if Error<>AError then begin
    if (Error=teOK) or (AError=teOK) then begin
      prError:=AError;
    end;
    DoOnError;
  end;
end;

function GetTickCount:tTime_ms;
begin
  Result:=timeGetTime;
end;

procedure tTimerMI1201X.SetTime(ATime:word);
begin
  Init;
  prTime.w:=ATime;
end;

procedure tTimerMI1201X.Init;
begin
  prFlags:=[];
  prReadByteCounter:=0;
  prWriteByteCounter:=0;
  prTime.w:=0;
  Clear;
end;

procedure tTimerMI1201X.OutTime(b:byte);
begin
  if (fRead in prFlags) then begin
    Error:=teWriteBeforeRead;
  end else if prWriteByteCounter=Low(prWriteByteCounter) then begin
    Include(prFlags,fWrite);
  end;
  prTime.b[prWriteByteCounter]:=b;
  if prWriteByteCounter=High(prWriteByteCounter) then begin
//    prWriteByteCounter:=Low(prWriteByteCounter);
    Exclude(prFlags,fWrite);
//  end else begin
//    Inc(prWriteByteCounter);
  end;
  CyclicInc(Byte(prWriteByteCounter),High(prWriteByteCounter));
end;

function  tTimerMI1201X.InTime:byte;
begin
  if (fWrite in prFlags) then begin
    Error:=teReadBeforeWrite;
  end else if prReadByteCounter=Low(prReadByteCounter) then begin
    Include(prFlags,fRead);
  end;
  InTime:=prTime.b[prReadByteCounter];
  if prReadByteCounter=High(prReadByteCounter) then begin
//    prReadByteCounter:=Low(prReadByteCounter);
    Exclude(prFlags,fRead);
//  end else begin
//    Inc(prReadByteCounter);
  end;
  CyclicInc(Byte(prReadByteCounter),High(prReadByteCounter));
end;

procedure tTimerMI1201X.Start;
begin
  if not ReadyToStart then begin
    Error:=teNotReadyToStart;
  end;
  Inherited Start(Time);
end;

function  tTimerMI1201X.ReadyToStart:boolean;
begin
  ReadyToStart:=prWriteByteCounter=Low(prWriteByteCounter);
end;

function TickSpend(t:tTime_ms):tTime_ms;
  var ct:tTime_ms;
begin
  ct:=timeGetTime;
  if ct>t then
    TickSpend:=ct-t
  else
    TickSpend:=0;
end;

constructor tTimeIntervalX.Create;
  var tc:tTimeCaps;
begin
  Inherited;
  if timeGetDevCaps(@tc,SizeOf(tc))=TIMERR_NOERROR then begin
    if timeBeginPeriod(tc.wPeriodMin)=TIMERR_NOERROR then
      prResolution:=tc.wPeriodMin;
  end;
  Clear;
end;

destructor tTimeIntervalX.Destroy;
begin
  Inherited;
  if Resolution<>0 then
    timeEndPeriod(1);
end;

procedure tTimeIntervalX.Start(TimeInterval_ms:tTime_ms);
begin
  StartTime:=timeGetTime;
  EndTime:=StartTime+TimeInterval_ms;
  Interval:=TimeInterval_ms;
end;

function tTimeIntervalX.Expired:boolean;
  var i:cardinal;
begin
  i:=timeGetTime;
  Expired:=(EndTime<=i) or (i<StartTime);
end;

procedure tTimeIntervalX.Clear;
begin
  Start(0);
end;

function tTimeIntervalX.Elapsed:tTime_ms;
begin
  if not Expired then
    Elapsed:=timeGetTime-StartTime
  else
    Elapsed:=Interval;
end;

end.