{ ROSCLK.INC - Remote Operating System Clock Routines }

{ Author: Werner Cirsovius - January 1988 }
{ System: CP/M PLUS built in clock        }

const
  ref_year     =  78;
  mona         :  array [1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31);

function leap(y: integer):boolean;
begin
  leap := ((y mod 4) = 0)
end;

function february(y: integer):integer;
begin
  if leap(y) then february := 29
             else february := 28
end;

function year_get(y: integer):integer;
begin
  if leap(y) then year_get := 366
             else year_get := 365
end;

procedure GetTAD(var t: tad_array);
{ Return a 6 element byte array of the current system time in
    seconds, minutes, hours, day, month, and year. }
var
  year,days,mon: integer;
  comp         : boolean;
  ticks        : byte;
  drtime       : integer;
  block        : array[0..3] of byte;
begin
  ticks := BDOS(getclock, addr(block));
  t[0] := 10*(ticks div 16) + ticks mod 16;
  drtime := block[0] + 256*block[1];
  for ticks:= 1 to 2 do t[ticks] := 10*(block[4-ticks] div 16) + block[4-ticks] mod 16;
  year := ref_year;
  comp := true;
  while comp do
  begin
    days := year_get(year);
    year := succ(year);
    if drtime > days then drtime := drtime - days
                     else comp := false;
  end;
  t[5] := pred(year);
  mona[2] := february(pred(year));
  comp := true;
  mon := 0;
  while comp do
  begin
    mon := succ(mon);
    if drtime >= mona[mon] then drtime := drtime - mona[mon]
                           else comp := false
  end;
  t[4] := mon;
  if drtime = 0 then
  begin
    t[4] := pred(mon);
    drtime := mona[pred(mon)]
  end;
  t[3] := drtime
end;

procedure SetTAD(var t: tad_array);
{ Set the system time using a 6 element byte array which contains
    seconds, minutes, hours, day, month, and year. }
const
  days         = 365;
var
  ticks        : byte;
  year,drtime  : integer;
  diff,mon     : integer;
  block        : array[0..3] of byte;
begin
  year := t[5];
  mona[2] := february(year);
  diff := year - ref_year;
  drtime := diff*days;
  if diff > 0 then drtime := drtime + (diff div 4);
  mon := pred(t[4]);
  if mon <> 0 then for mon := mon downto 1 do drtime := drtime + mona[mon];
  drtime := drtime + t[3];
  block[0] := lo(drtime);
  block[1] := hi(drtime);
  for ticks:= 1 to 2 do block[4-ticks] := 16*(t[ticks] div 10) + t[ticks] mod 10;
  BDOS(setclock, addr(block))
end;

{ Dummy routines for PICS }

procedure tick_a_sec;
begin
end;

procedure tick_a_min;
begin
end;