{********************************************************************}
{* TIMER:                                                           *}
{* Unit for timing with Turbo Pascal 4.0                            *}
{*                                                                  *}
{* Tapani Tarvainen 20 April 1988                                   *}
{********************************************************************}

Unit Timer;

{********************************************************************}

INTERFACE


Uses Dos;  { GetTime & GetDate }


Const MaxTimer = 20;  { number of timers available }

Type  Time = LongInt; { hundreths of a second }


{ In all of the following, TimerNo specifies which timer to use;     }
{ legal values are 1..MaxTimer.                                      }
{ These should work for times of up to 6 days.                       }
{ Results are reliable only to about 0.05 s (due to the DOS system   }
{ functions used).                                                   }

Procedure ResetTimer( TimerNo: Integer);
{ Stop timer and set it to zero }
{ (All timers are reset initially) }

Procedure StartTimer( TimerNo: Integer);
{ Start timer running }

Procedure StopTimer( TimerNo: Integer;
                 Var Value: Time);
{ Stop timer and get its current value }

Procedure SetTimer( TimerNo:  Integer;
                    NewValue: Time);
{ Set timer to given value }

Function ReadTimer( TimerNo: Integer):  Time;
{ Get timer's current value }

{********************************************************************}
{********************************************************************}

IMPLEMENTATION


Type
      TimerType = Record
                    Running:   Boolean;
                    Started,            { time of last update }
                    LastValue: Time;    { and value then }
                  End;


Var
    Timers:  Array [1..MaxTimer] Of TimerType;
    TimerNo: Integer;  { used for resetting timers initially }

    Year, Month, Day,  { dummies needed for GetDate call }
    BaseDoW: Word;     { weekday the program started }

{********************************************************************}
{ REALTIME: Get current clock reading.                               }
{ Times are expressed as hundreths of a second since last midnight   }
{ (00:00) before the program was started (unit initialized).         }
{ Day count is based on day of the week only, timers wrap around in  }
{ a week - in the first case (started just before midnight) timings  }
{ fail (wrap around to zero) after six days.                         }

Function RealTime: Time;

Var Year, Month, Day, DoW, DoW2,
    Hour, Minute, Second, Hundreth: Word;

Begin { RealTime }
  { The loop below is in case day changes between GetDate and        }
  { GetTime calls - that would cause an error of 24 hours.           }
  { It is  almost always repeated just once, never more than twice.  }
  Repeat { read system clock }
    GetDate( Year, Month, Day, DoW);
    GetTime( Hour, Minute, Second, Hundreth);
    GetDate( Year, Month, Day, DoW2);
  Until DoW=DoW2;

  { Then convert into 100th's of a second. }
  { Note the explicit typecast to avoid intermediate overflow. }
  RealTime:=(( ((7+DoW-BaseDoW) Mod 7)*24+
            LongInt(Hour)*60+Minute)*60+Second)*100+Hundreth;
End; { RealTime }

{********************************************************************}
{ RESETTIMER: Stop timer and set it to zero.                         }

Procedure ResetTimer( TimerNo: Integer);

Begin { ResetTimer }
  With Timers[TimerNo] Do
    Begin
      Running:=False;
      LastValue:=0;
      Started:=RealTime;
    End;
End; { ResetTimer }

{********************************************************************}
{ STARTTIMER: Start timer running.                                   }

Procedure StartTimer( TimerNo: Integer);

Begin { StartTimer }
  With Timers[TimerNo] Do
    If Not Running Then
      Begin
        Started:=RealTime;
        Running:=True;
      End;
End; { StartTimer }

{********************************************************************}
{ STOPTIMER: Stop timer and get its current value.                   }

Procedure StopTimer( TimerNo: Integer;
                 Var Value: Time);

Begin { StopTimer }
  With Timers[TimerNo] Do
    Begin
      If Running Then LastValue:=LastValue+RealTime-Started;
      Running:=False;
      Value:=LastValue;
    End;
End; { StopTimer }

{********************************************************************}
{ SETTIMER: Set timer to given value.                                }

Procedure SetTimer( TimerNo:  Integer;
                    NewValue: Time);

Begin { SetTimer }
  With Timers[TimerNo] Do
    Begin
      LastValue:=NewValue;
      Started:=RealTime;
    End;
End; { SetTimer }

{********************************************************************}
{ READTIMER: Get timer's current value.                              }

Function ReadTimer( TimerNo: Integer):  Time;

Begin { ReadTimer }
  With Timers[TimerNo] Do
    Begin
      If Running Then
        Begin
          LastValue:=LastValue+RealTime-Started;
          Started:=RealTime;
        End;
      ReadTimer:=LastValue;
    End;
End; { ReadTimer }

{********************************************************************}

Begin { Timer: Unit initialization }
  { Get day of the week - needed in case a timing spans midnight(s)  }
  GetDate( Year, Month, Day, BaseDoW);
  { Then reset all timers }
  For TimerNo:=1 To MaxTimer Do ResetTimer(TimerNo);
End. { Timer }

{********************************************************************}
{********************************************************************}