freepascal.compiler/packages/extra/ptc/timeri.inc

{
    Free Pascal port of the OpenPTC C++ library.
    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
    Original C++ version by Glenn Fiedler ([email protected])

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

{Function timeGetTime : DWord; StdCall; External 'WINMM' name 'timeGetTime';}

Constructor TPTCTimer.Create;

Begin
  internal_init_timer;
  m_old := 0;
  m_time := 0;
  m_start := 0;
  m_current := 0;
  m_running := False;
End;

Constructor TPTCTimer.Create(_time : Double);

Begin
  internal_init_timer;
  m_old := 0;
  m_time := 0;
  m_start := 0;
  m_current := 0;
  m_running := False;
  settime(_time);
End;

Constructor TPTCTimer.Create(Const timer : TPTCTimer);

Begin
  internal_init_timer;
  ASSign(timer);
End;

Destructor TPTCTimer.Destroy;

Begin
  stop;
  Inherited Destroy;
End;

Procedure TPTCTimer.Assign(Const timer : TPTCTimer);

Begin
  If Self = timer Then
    Raise TPTCError.Create('self assignment is not allowed');

  m_old := timer.m_old;
  m_time := timer.m_time;
  m_start := timer.m_start;
  m_current := timer.m_current;
  m_running := timer.m_running;
End;

Function TPTCTimer.Equals(Const timer : TPTCTimer) : Boolean;

Begin
  Equals := (m_old = timer.m_old) And (m_time = timer.m_time) And
	    (m_start = timer.m_start) And (m_current = timer.m_current) And
	    (m_running = timer.m_running);
End;

Procedure TPTCTimer.settime(_time : Double);

Begin
  m_current := _time;
  m_start := clock;
  m_time := m_start + _time;
  m_old := m_time - delta;
End;

Procedure TPTCTimer.start;

Begin
  If Not m_running Then
  Begin
    m_start := clock;
    m_old := clock;
    m_running := True;
  End;
End;

Procedure TPTCTimer.stop;

Begin
  m_running := False;
End;

Function TPTCTimer.time : Double;

Var
  _time : Double;

Begin
  If m_running Then
  Begin
    _time := clock;
    If _time > m_time Then
      m_time := _time;
    m_current := m_time - m_start;
  End;
  time := m_current;
End;

Function TPTCTimer.delta : Double;

Var
  _time : Double;
  _delta : Double;

Begin
  If m_running Then
  Begin
    _time := clock;
    _delta := _time - m_old;
    m_old := _time;
    If _delta < 0 Then
      _delta := 0;
    delta := _delta;
  End
  Else
    delta := 0;
End;

Function TPTCTimer.resolution : Double;

Begin
  {$IFDEF GO32V2}
  resolution := TimerResolution;
  {$ENDIF GO32V2}
  {$IFDEF WIN32}
  resolution := 1 / m_frequency;
{  resolution := 1 / 1000;}
  {$ENDIF WIN32}
  {$IFDEF UNIX}
  resolution := 1 / 1000000;
  {$ENDIF UNIX}
End;

Procedure TPTCTimer.internal_init_timer;

{$IFDEF WIN32}
Var
  _freq : QWord;
{$ENDIF WIN32}

Begin
{$IFDEF WIN32}
  QueryPerformanceFrequency(PLARGE_INTEGER(@_freq));
  m_frequency := _freq;
{$ENDIF WIN32}
End;

{$IFDEF GO32V2}
Function TPTCTimer.clock : Double;

Begin
  clock := GetClockTics() * TimerResolution;
End;
{$ENDIF GO32V2}

{$IFDEF WIN32}
Function TPTCTimer.clock : Double;

Var
  _time : QWord;

Begin
  QueryPerformanceCounter(PLARGE_INTEGER(@_time));
  clock := _time / m_frequency;
{  clock := timeGetTime / 1000;}
End;
{$ENDIF WIN32}

{$IFDEF UNIX}
Function TPTCTimer.clock : Double;

Var
  tm : TimeVal;

Begin
  fpGetTimeOfDay(@tm, Nil);
  clock := tm.tv_sec + (Double(tm.tv_usec)) / 1000000;
End;
{$ENDIF UNIX}