home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 3 / hamradioversion3.0examsandprograms1992.iso / control / caty10 / y767rtc.pas < prev    next >
Pascal/Delphi Source File  |  1989-10-26  |  4KB  |  105 lines
  1. UNIT Y767RTC (* Y767 Real Time Clock routines  D. J. Wilke N3HGQ 09/26/89 *);
  2.  
  3. INTERFACE
  4.  
  5. USES CRT, DOS, Y767GLO, Y767UTIL;
  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 for 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 orderly exit *)
  75.     SETINTVEC(TimerInt,@Clock);              (* Give vector 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 what it was *)
  84. END; (* RestoreOldTimer *)
  85. {$F-}
  86.  
  87. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  88. PROCEDURE TimerError;
  89.  
  90. BEGIN (* TimerError *)
  91.     ErrorAlarm(TimerErr,0,12);               (* Issue Timer error warning *)
  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 per second *)
  101.     InstallOurTimer;
  102. END; (* InitClock *)
  103.  
  104. END. (* of UNIT Y767RTC *)
  105.