{---------------------------------------------------------------------------}
{                                                                           }
{ Turbo pascal program to show how to use the RTC that is present in Bye337 }
{ by PST 7/29/85                                                            }
{                                                                           }
{---------------------------------------------------------------------------}
{ Copyright (c) 1985 by Paul Traina - all commercial rights reserved        }
{ This program may be distributed under the following circumstances:        }
{    1) This software is to be distributed with the Bye3 series of programs }
{       and no "spinoffs."
{    2) This software is not sold or marketed for commercial gain.          }
{    3) The author's copyright notice is not disturbed.                     }
{---------------------------------------------------------------------------}

program bye_time(input,output);
const
  getrtc  = 79;               { byebdos function call to return RTC buffer }
  getuser = 32;               { bye existance test/bdos set/get user area  }

type
  DateStr = String[32];
  TimeStr = String[32];
  Str10   = String[10];

{---------------------------------------------------------------------}
{                                                                     }
{   Clock read routines [extractable]                                 }
{                                                                     }
{   Get_Date & Get_Time  & Get_Tos = main                             }
{   intstr & antibcd               = support                          }
{                                                                     }
{---------------------------------------------------------------------}

{ Convert integer I to string, padded to length W with leading 0's }

function intstr(i,w:integer):Str10;
var
  st : Str10;
begin
  str(i,st);
  while length(st) < w do
    st := '0'+st;
  intstr := st;
end;

{ Convert BCD number to integer }

function antibcd(n:byte):integer;
begin
  antibcd := (n mod 16) + (10 * (n div 16));
end;

{ Get current time }

function Get_Time:TimeStr;
var
  hr, min, sec : integer;
  ptr          : integer;
begin
  ptr := BdosHL(getrtc);
  hr  := antibcd(mem[ptr+0]);
  min := antibcd(mem[ptr+1]);
  sec := antibcd(mem[ptr+2]);
  Get_Time := intstr(hr,2)+':'+intstr(min,2)+':'+intstr(sec,2);
end;

{ Get current date }

function Get_Date(fmt:integer):DateStr;
  function zeller(month,day,year: integer): integer;
  { Compute the day of the week using Zeller's Congruence }
  var
    century: integer;
  begin
    if month > 2
      then month := month - 2
      else
        begin
          month := month + 10;
          year  := year - 1
        end;
    century := year div 100;
    year    := year mod 100;
    zeller  := (day - 1 + ((13 * month - 1) div 5) + (5 * year div 4) +
               century div 4 - 2 * century + 2) mod 7;
  end;
const
  dayw: array [0..6] of string[6] =
    ('Sun','Mon','Tues','Wednes','Thurs','Fri','Satur');
  month: array [1..12] of string[12] =
    ('January','Feburary','March','April','May','June','July','August',
     'September','October','November','December');
var
  mon, day, yr, dow : integer;
  ptr               : integer;
begin
  ptr := BdosHL(getrtc);
  yr  := antibcd(mem[ptr+4]);
  mon := antibcd(mem[ptr+5]);
  day := antibcd(mem[ptr+6]);
  dow := zeller(mon,day,yr);

  case fmt of
    1: Get_Date := intstr(mon,2)+'/'+intstr(day,2)+'/'+intstr(yr,2);
    2: Get_Date := intstr(day,2)+'/'+intstr(mon,2)+'/'+intstr(yr,2);
    3: Get_Date := dayw[dow] + 'day, '+month[mon]+' '+intstr(day,2)+
                   ', '+'19'+intstr(yr,2);
  end;
end;

{  Get time on system }

function Get_TOS:integer;
begin
  Get_TOS := mem[BdosHL(getrtc)+7];
end;

var
  time : TimeStr;
  date : DateStr;
  tos  : integer;        { time on system }

begin
  if Bdos(32,241) <> 77 then
  begin
    writeln('No bye...');
    halt
  end;

  time := Get_Time;      { turbo pascal restriction under CP/M 80 }
  date := Get_Date(3);   { does not allow us to use STR under write }

  writeln('It is ',time,' on ',date);
  writeln('You''ve been online for ',Get_TOS,' minutes.');
end.