Contributor: TIM MIDDLETON
program moondays;
uses dos;
{----------------------------------------------------------------------}
{-- Calculate Approxmiate Phase of the Moon: --}
{----------------------------------------------------------------------}
{-- Uses formula by P. Harvey in the "Journal of the British --}
{-- Astronomical Association", July 1941. Formula is accurate to --}
{-- within one day (or on some occassions two days). If anyone knows --}
{-- a better formula please let me know! Internet: as544@torfree.net --}
{----------------------------------------------------------------------}
{-- Calculates number of days since the new moon where: --}
{-- 0 = New moon 15 = Full Moon --}
{-- 7 = First Quarter 22 = Last Quarter (right half dark) --}
{----------------------------------------------------------------------}
Function Moon_age(y : word; m : word; d : word) : byte;
var i : integer;
c : word;
begin
c:=(y div 100);
if (m>2) then dec(m,2) else inc(m,10);
i:=((((((y mod 19)*11)+(c div 3)+(c div 4)+8)-c)+m+d) mod 30);
moon_age:=i;
end;
{----------------------------------------------------------------------}
{-- Enable Dos redirection: --}
{----------------------------------------------------------------------}
Procedure DosRedirect;
begin
ASSIGN(Input,'');RESET(Input);
ASSIGN(Output,'');REWRITE(Output);
end;
{**********************************************************************}
{**********************************************************************}
var
ty, tm, td, tdow : word;
BEGIN
DosRedirect;
Getdate(ty,tm,td,tdow);
tdow := Moon_age(ty,tm,td);
Write('The moon is ',tdow,' day');
if tdow1 then write('s');
write(' old.');
case tdow of
0 : Write(' New moon!');
7 : Write(' First Quater!');
15: Write(' Full moon!');
22: Write(' Last Quarter!');
end;
writeln;
END.