home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / tpdoskermit / timers.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2020-01-01  |  2.0 KB  |  110 lines
  1. $R-,S-,F+}                                  {No local proc's!
  2. Unit Timers;
  3.  
  4. Interface
  5.  
  6. TYPE
  7.   TimerTablePtr = ^TimerTableRec;
  8.   TimerTableRec = RECORD
  9.     next : TimerTablePtr;
  10.     count : LongInt;
  11.     UserInt, active : BOOLEAN;
  12.   END;
  13.  
  14. CONST
  15.   TimerPtr : TimerTablePtr = NIL;
  16.  
  17. VAR SaveExit, OldTimer : Pointer;
  18.  
  19. PROCEDURE StartTimer(VAR t : TimerTableRec);
  20.  
  21. PROCEDURE StopTimer(VAR t : TimerTableRec);
  22.  
  23. FUNCTION  GetTimer(VAR t : TimerTableRec): LongInt;
  24.  
  25. FUNCTION  RunningTimer(VAR t : TimerTableRec): BOOLEAN;
  26.  
  27. PROCEDURE GetVector(IntNr : WORD; VAR vector: Pointer);
  28.  
  29. PROCEDURE SetVector(IntNr : WORD; vector: Pointer);
  30.  
  31. Implementation
  32.  
  33. VAR IntVectorTable : ARRAY [0..255] OF Pointer ABSOLUTE 0:0;
  34.  
  35. PROCEDURE GetVector(IntNr : WORD; VAR vector: Pointer);
  36. BEGIN
  37.   vector := IntVectorTable[IntNr];
  38. END;
  39.  
  40. PROCEDURE SetVector(IntNr : WORD; vector: Pointer);
  41. BEGIN
  42.   Inline($FA);
  43.   IntVectorTable[IntNr] := vector;
  44.   InLine($FB);
  45. END;
  46.  
  47. PROCEDURE StopTimer(VAR t : TimerTableRec);
  48. VAR tp, ne : TimerTablePtr;
  49. BEGIN
  50.   t.active := FALSE;
  51. {
  52.   IF TimerPtr = NIL THEN Exit;
  53.   IF TimerPtr = @t THEN BEGIN
  54.     Inline($FA);
  55.     TimerPtr := t.next;
  56.     Inline($FB);
  57.     Exit;
  58.   END;
  59. }
  60.   tp := @TimerPtr;
  61.   ne := TimerPtr;
  62.   WHILE ne <> NIL DO BEGIN
  63.     IF ne = @t THEN BEGIN
  64.       Inline($FA);
  65.       tp^.next := t.next;
  66.       Inline($FB);
  67.       Exit;
  68.     END;
  69.     tp := ne;
  70.     ne := ne^.next;
  71.   END;
  72. END;
  73.  
  74. PROCEDURE StartTimer(VAR t : TimerTableRec);
  75. BEGIN
  76.   StopTimer(t);
  77.   t.next := TimerPtr;
  78.   t.active := TRUE;
  79.   Inline($FA);
  80.   TimerPtr := @t;
  81.   Inline($FB);
  82. END;
  83.  
  84. FUNCTION GetTimer(VAR t : TimerTableRec): LongInt;
  85. BEGIN
  86.   Inline($FA);
  87.   GetTimer := t.count;
  88.   Inline($FB);
  89. END;
  90.  
  91. FUNCTION RunningTimer(VAR t : TimerTableRec): BOOLEAN;
  92. BEGIN
  93.   RunningTimer := t.active;
  94. END;
  95.  
  96. PROCEDURE Timer_Int; EXTERNAL; {$L timers.obj}
  97.  
  98. PROCEDURE Exit_Timers;
  99. BEGIN
  100.   SetVector(8,OldTimer);
  101.   ExitProc := SaveExit;
  102. END;
  103.  
  104. BEGIN
  105.   GetVector(8,OldTimer);
  106.   SetVector(8,@Timer_Int);
  107.   SaveExit := ExitProc;
  108.   ExitProc := @Exit_Timers;
  109. END.
  110.