home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TBTREE.ZIP / TIME.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-25  |  4.0 KB  |  146 lines
  1. (* TBTree13             Copyright (c)  1988            Dean H. Farwell II    *)
  2.  
  3. unit Time;
  4.  
  5. (*****************************************************************************)
  6. (*                                                                           *)
  7. (*                       T I M E    R O U T I N E S                          *)
  8. (*                                                                           *)
  9. (*****************************************************************************)
  10.  
  11.  
  12. (* Procedures to support time in Turbo Pascal.  These procedures do not use
  13.    BIOS or DOS calls, but access RAM directly to get time information.       *)
  14.  
  15. (* Version Information
  16.  
  17.    Version 1.1 - No Changes
  18.  
  19.    Version 1.2 - No Changes
  20.  
  21.    Version 1.3 - No Changes                                                  *)
  22.  
  23. (*\*)
  24. (*////////////////////////// I N T E R F A C E //////////////////////////////*)
  25.  
  26. interface
  27.  
  28. uses
  29.     Compare,
  30.     Numbers;
  31.  
  32. type
  33.     TimeArr = Array[1 .. 4] of Byte;  (* store the 4 bytes from RAM which
  34.                                          holds the present time *)
  35.  
  36.  
  37. (* Get the 4 byte time from RAM and place it into the 4 byte array x         *)
  38.  
  39. procedure GetTime(var x : TimeArr);
  40.  
  41.  
  42. (* This function compares two time arrays.  LESSTHAN is returned if X is less
  43.    than Y (earlier).  GREATERTHAN is returned if X is greater than Y (later).
  44.    If they are equal then EQUALTO is returned                                *)
  45.  
  46. function CompareTime(x : TimeArr;
  47.                      y : TimeArr) : Comparison;
  48.  
  49.  
  50. (* This routine prints out the 4 byte time array                             *)
  51.  
  52. procedure PrintTime(x : TimeArr);
  53.  
  54.  
  55. (* This routine sets each byte of the time array to 255 (all bits = 1)       *)
  56.  
  57. procedure SetMaxTime(var x : TimeArr);
  58.  
  59. (*\*)
  60. (*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
  61.  
  62. implementation
  63.  
  64.  
  65. (* Get the 4 byte time from RAM and place it into the 4 byte array x         *)
  66.  
  67. procedure GetTime(var x : TimeArr);
  68.  
  69. var
  70.     time : TimeArr absolute $0000 : $046C;
  71.     cnt : 1 .. 4;
  72.  
  73.     begin
  74.     for cnt := 1 to 4 do
  75.         begin
  76.         x[cnt] := time[cnt];
  77.         end;
  78.     end;                       (* End of GetTime Procedure *)
  79.  
  80. (*\*)
  81. (* This function compares two time arrays.  LESSTHAN is returned if X is less
  82.    than Y (earlier).  GREATERTHAN is returned if X is greater than Y (later).
  83.    If they are equal then EQUALTO is returned                               *)
  84.  
  85. function CompareTime(x : TimeArr;
  86.                      y : TimeArr) : Comparison;
  87.  
  88. var
  89.     cnt : 0 .. 4;
  90.     done : boolean;
  91.  
  92.     begin
  93.     cnt := 4;
  94.     done := false;
  95.     while not done do
  96.         begin
  97.         if x[cnt] < y[cnt] then
  98.             begin
  99.             done := true;
  100.             CompareTime := LESSTHAN;
  101.             end
  102.         else
  103.             begin
  104.             if x[cnt] > y[cnt] then
  105.                 begin
  106.                 done := true;
  107.                 CompareTime := GREATERTHAN;
  108.                 end
  109.             else
  110.                 begin
  111.                 cnt := cnt - 1;
  112.                 if cnt = 0 then
  113.                     begin
  114.                     done := true;
  115.                     CompareTime := EQUALTO;
  116.                     end;
  117.                 end;
  118.             end;
  119.         end;
  120.     end;                                       (* end of CompareTime routine *)
  121.  
  122.  
  123. (* This routine prints out the 4 byte time array                            *)
  124.  
  125. procedure PrintTime(x : TimeArr);
  126.  
  127.     begin
  128.     Writeln(x[1]:4,x[2]:4,x[3]:4,x[4]:4);
  129.     end;                                         (* end of PrintTime routine *)
  130.  
  131.  
  132. (* This routine sets each byte of the time array to 255 (all bits = 1)       *)
  133.  
  134. procedure SetMaxTime(var x : TimeArr);
  135.  
  136. var
  137.     cnt : 1 .. 4;
  138.  
  139.     begin
  140.     for cnt := 1 to 4 do
  141.         begin
  142.         x[cnt] := MAXBYTE;
  143.         end;
  144.     end;                                        (* end of SetMaxTime routine *)
  145.  
  146. end.                                                     (* end of Time unit *)