(*=======================================================================*)
(*    GET_TIME holt unter CP/M 3 die Uhrzeit und das Datum               *)
(*    von der Hardware Uhr                                               *)
(*=======================================================================*)
program display_time;

var sec,               (* Sekunden der Uhrzeit : 0..59 *)
    min,               (* Minuten der Uhrzeit  : 0..59 *)
    hour,              (* Stunden der Uhrzeit  : 0..23 *)
    tag,               (* Tag des Datums       : 1..31 *)
    monat,             (* Monat des Datums     : 1..12 *)
    jahr,              (* Jahr                 : 78... *)
    wtag,              (* Wochentag: 0 = So ... 6 = Sa *)
    oldsec : byte;

(*--- Beginn des Programms Get_Time -----------------------------*)
(*--- Funktion Binaer wandelt BCD-Groesse in binaeren Wert um ---*)

function binaer ( wert : byte ) : byte;
begin
  binaer := 10 * ( wert div 16 ) + ( wert and 15 );
end;

(*--- Prozedur Gettime liest Uhr und rechnet Datum um ---*)

procedure get_time ( var s, m, h, t, mo, j, wt : byte );
const mon_anf  : array[1..12] of integer
               = (0,31,59,90,120,151,181,212,243,273,304,334);
var dat        : array[0..3] of byte;
    datum,days : integer;
begin
  s := BDOS ( 105, addr ( dat[0] ));
  m := dat[3];
  h := dat[2];
  s := binaer(s);
  m := binaer(m);
  h := binaer(h);
  datum := dat[0] + 256 * dat[1];
  wt := datum mod 7;
  days := 365;
  j := 78;
  while datum > days do
    begin
      datum := datum - days;
      j := j + 1;
      if j mod 4 = 0
        then
          days := 366
        else
          days := 365;
    end;
  if (j mod  4 =  0) and (datum > 59)
    then
      datum := datum - 1;
  mo := 12;
  while datum < mon_anf[mo] do
    mo := mo - 1;
  t := datum - mon_anf[mo];
end;
(*--- Ende des Programms Get_Time --------------------------*)

(*--- Beginn des Hauptprogramms. Hier nur Beispielaufruf ---*)
begin { displax_time }
  oldsec := 100;
  repeat
    get_time (sec,min,hour,tag,monat,jahr,wtag);

(* --- Korrektur ab 2000 --- *)
    if jahr>100 then jahr:=jahr-100;
(* ------------------------- *)

    if sec <> oldsec
      then
        begin
          write(#13,tag,'.',monat,'.',jahr,hour:4,':',min:2,':',sec:2);
          oldsec := sec;
        end;
  until keypressed;
end.