home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / caty16.zip / CATYRTC.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-26  |  4KB  |  105 lines
  1. UNIT CATYRTC (* CATY Real Time Clock routines  D. J. Wilke N3HGQ 06/26/90 *);
  2.  
  3. INTERFACE
  4.  
  5. USES CRT, DOS, CATYGLO, CATYUTIL;
  6.  
  7. PROCEDURE SaveOldTimer;
  8. PROCEDURE InstallOurTimer;
  9. PROCEDURE RestoreOldTimer;
  10. PROCEDURE TimerError;
  11. PROCEDURE InitClock;
  12.  
  13. IMPLEMENTATION
  14.  
  15. (*═══════════════════════════════════════════════════════════════════════*)
  16. PROCEDURE Clock(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : WORD);
  17. INTERRUPT;
  18.  
  19. VAR
  20.    HiClock           : INTEGER ABSOLUTE $0040:$006E;
  21.    LoClock           : INTEGER ABSOLUTE $0040:$006C;
  22.    TimerTics         : REAL;
  23.    HiWord, LoWord    : REAL;
  24.    HrTemp, HrTempL   : INTEGER;
  25.    Mins, Secs, AmPm  : STRING[2];
  26.    HoursUTC,HoursLoc : STRING[2];
  27.    TimeUTC,TimeLoc   : STRING[20];
  28.  
  29. BEGIN (* Clock *)
  30.    IF ClockFlag THEN BEGIN                   (* Clock runs only if TRUE *)
  31.       INLINE($FB);                           (* Enable interrupts *)
  32.       TicCount := SUCC(TicCount);
  33.       IF TicCount >17 THEN BEGIN             (* Rollover value 1 sec *)
  34.       HiWord := HiClock;
  35.       LoWord := LoClock;
  36.       IF HiWord < 0.0 THEN HiWord := 65536.0 + HiWord;
  37.       IF LoWord < 0.0 THEN LoWord := 65536.0 + LoWord;
  38.       TimerTics := HiWord * 65536.0 + LoWord;
  39.       TimerTics := TimerTics / 18.206481934;
  40.       STR((TRUNC(TimerTics / 3600.0) + TimeZone) MOD 24, HoursUTC);
  41.       HrTemp       := TRUNC(TimerTics / 3600.0) MOD 24;
  42.       IF HrTemp     = 0  THEN HrTempL := 12;
  43.       IF HrTemp     > 12 THEN HrTempL := HrTemp - 12
  44.       ELSE HrTempL := HrTemp;
  45.       IF HrTemp     > 11 THEN AmPm    := 'PM'
  46.       ELSE AmPm    := 'AM';
  47.       STR(HrTempL,HoursLoc);
  48.       IF HoursUTC[0] = #1 THEN HoursUTC := '0' + HoursUTC;
  49.       IF HoursLoc[0] = #1 THEN HoursLoc := ' ' + HoursLoc;
  50.       STR(TRUNC(TimerTics / 60.0) MOD 60, Mins);
  51.       IF Mins[0]     = #1 THEN Mins  := '0' + Mins;
  52.       STR(TRUNC(TimerTics - INT(TimerTics / 60) * 60),Secs);
  53.       IF Secs[0]     = #1 THEN Secs         := '0' + Secs;
  54.       TimeUTC       := '  ' + HoursUTC + Mins + ':' + Secs + ' UTC ';
  55.       TimeLoc       := ' ' + HoursLoc + ':' + Mins + ' ' + AmPm + TZ;
  56.       ScreenWrite(TimeLoc,65,2,CLA);
  57.       ScreenWrite(TimeUTC,65,3,CLA);
  58.       TicCount      := 0;
  59.      END; (* IF TicCount *)
  60.    END; (* IF ClockFlag *)
  61. END; (* Clock *)
  62.  
  63. (*═══════════════════════════════════════════════════════════════════════*)
  64. PROCEDURE SaveOldTimer;
  65.  
  66. BEGIN (* SaveOldTimer *)
  67.    GETINTVEC(TimerInt,OldVector);            (* Get copy of orig to save *)
  68. END; (* SaveOldTimer *)
  69.  
  70. (*═══════════════════════════════════════════════════════════════════════*)
  71. PROCEDURE InstallOurTimer;
  72.  
  73. BEGIN (* InstallOurTimer *)
  74.    SaveOldTimer;                             (* Save orig for exit *)
  75.    SETINTVEC(TimerInt,@Clock);               (* Set vect ISR(Clock) addr *)
  76. END; (* InstallOurTimer *)
  77.  
  78. (*═══════════════════════════════════════════════════════════════════════*)
  79. {$F+}
  80. PROCEDURE RestoreOldTimer;
  81.  
  82. BEGIN (* RestoreOldTimer *)
  83.    SETINTVEC(TimerInt,OldVector);            (* Put Int 1C back to...*)
  84. END; (* RestoreOldTimer *)                   (* ...what it orig was *)
  85. {$F-}
  86.  
  87. (*═══════════════════════════════════════════════════════════════════════*)
  88. PROCEDURE TimerError;
  89.  
  90. BEGIN (* TimerError *)
  91.    ErrorAlarm(TimerErr,0,12);                (* Issue Timer error *)
  92.    RestoreOldTimer;
  93. END; (* TimerError *)
  94.  
  95. (*═══════════════════════════════════════════════════════════════════════*)
  96. PROCEDURE InitClock; (* Set up for on-screen clock *)
  97.  
  98. BEGIN (* InitClock *)
  99.    SaveCseg       := Cseg;
  100.    TicCount       := 18;                     (* Number of tics/second *)
  101.    InstallOurTimer;
  102. END; (* InitClock *)
  103.  
  104. END. (* of UNIT CATYRTC *)
  105.