Output of file : CALENDAR.PAS contained in archive : PCTJ1285.ZIP

{ Long-range calendrical package in standard Pascal }
{ Copyright 1985 Michael A. Covington }

function frac(x:real):real;
{ Fractional part of a real number. }
{ Turbo Pascal provides this as a built-in function. }
begin
while x < -maxint do x:=x+maxint;
while x > maxint do x:=x-maxint;
frac := x - trunc(x)
end;

function int(x:real):real;
{ Integer part of a real number. }
{ Uses real data type to accommodate large numbers. }
{ Turbo Pascal provides this as a built-in function. }
begin
int := x - frac(x)
end;

function floor(x:real):real;
{ Largest whole number not greater than x. }
{ Uses real data type to accommodate large numbers. }
begin
if (x < 0) and (frac(x) <> 0) then
floor := int(x) - 1.0
else
floor := int(x)
end;

function daynumber(year,month,day:integer):real;
{ Number of days elapsed since 1980 January 0 (1979 December 31). }
{ Note that the year should be given as (e.g.) 1985, not just 85. }
{ Switches from Julian to Gregorian calendar on Oct. 15, 1582. }
var
y,m: integer;
a,b,d: real;
begin
if year < 0 then y := year + 1
else y := year;
m := month;
if month < 3 then
begin
m := m + 12;
y := y - 1
end;
d := floor(365.25*y) + int(30.6001*(m+1)) + day - 723244.0;
if d < -145068.0 then
{ Julian calendar }
daynumber := d
else
{ convert to Gregorian calendar }
begin
a := floor(y/100.0);
b := 2 - a + floor(a/4.0);
daynumber := d + b
end
end;

procedure caldate(date:real; var year,month,day:integer);
{ Inverse of DAYNUMBER; given date, finds year, month, and day. }
{ Uses real arithmetic because numbers are too big for integers. }
var
a,aa,b,c,d,e,z: real;
y: integer;
begin
z := int(date + 2444239.0);
if date < -145078.0 then
{ Julian calendar }
a := z
else
{ Gregorian calendar }
begin
aa := floor((z-1867216.25)/36524.25);
a := z + 1 + aa - floor(aa/4.0)
end;
b := a + 1524.0;
c := int((b-122.1)/365.25);
d := int(365.25*c);
e := int((b-d)/30.6001);
day := trunc(b - d - int(30.6001*e));
if e > 13.5 then month := trunc(e - 13.0)
else month := trunc(e - 1.0);
if month > 2 then y := trunc(c - 4716.0)
else y := trunc(c - 4715.0);
if y < 1 then year := y - 1
else year := y
end;

function weekday(date:real):integer;
{ Given day number as used in the above routines, }
{ finds day of week (1 = Sunday, 2 = Monday, etc.). }
var
dd: real;
begin
dd := date;
while dd > 28000.0 do dd:=dd-28000.0;
while dd < 0 do dd:=dd+28000.0;
weekday := ((trunc(dd) + 1) mod 7) + 1
end;

### 3 Responses to “Category : Files from MagazinesArchive   : PCTJ1285.ZIPFilename : CALENDAR.PAS”

1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/