A kind of writing of perpetual calendar

Program www;
var Year:integer;
Function MonthDay (year,month:integer): integer; {Days of month month of year}
Begin
Case month of
0:monthday:=0;
4,6,9,11:monthday:=30;
1,3,5,7,8,10,12:monthday:=31;
2:if (Year mod 4 =0) and (year mod 100$#@60;>0) or (year mod 400=0)
Then MonthDay: =29
else MonthDay: =28
End End
Function FirstDay (year,month:integer): integer; {First year of month month
var M,n,i:integer;
Totaldays:integer;
Function Monthto (year,month:integer): integer; {The year from January (month-1) month?
var Y,z:integer;
Begin
y:=0;
For Z:=1 to (month-1) do
Y:=y+monthday (YEAR,Z);
Monthto:=y;
End
BEGIN
If year>=2000 {with 2000 years as the standard year of discussion}
Then
Begin
i:=0;
For n:=1999 to (year-1) do
If MonthDay (n,2) =29 then i:=i+1;
Totaldays:=year-2000+i;
m:= (totaldays+6) mod 7;
M:= (M+monthto (year,month)) MoD 7;
Firstday:=m;
End
else {An algorithm with a year number less than 2000}
Begin
i:=0;
For n:=1999 Downto (year-1) do
If MonthDay (n,2) =29 then i:=i+1;
totaldays:=-(1999-year+i+1);
m:= (totaldays+6) mod 7;
M:= (M+monthto (year,month)) MoD 7;
Firstday:=m;
End
End;
Procedure weekout; {Output three week header}
var A:integer;
Begin
For A:=1 to 3 do
Write (SU MO TU WE TH FR SA); Writeln;
End
PROCEDURE Day (X:integer); {Three months of output process}
var Month1,month2,month3:integer;
Dayone,daytwo,daythree:integer;
T, P:integer;
BEGIN
Month1:=1; Month2:=1; Month3:=1;
Dayone:=firstday (YEAR,X);
Daytwo:=firstday (year, (x+1));
Daythree:=firstday (year, (x+2));
Write (month1:3* (dayone+1)); {Output The first line of three-month days}
Repeat if Dayone$#@60;6 then be month1:=month1+1;
Write (Month1:3); End
dayone:=dayone+1;
Until dayone=7;
Write (month2:3* (daytwo+1));
Repeat if Daytwo$#@60;6 then begin month2:=month2+1;
Write (month2:3) end;
daytwo:=daytwo+1;
Until daytwo=7;
Write (month3:3* (daythree+1));
Repeat if Daythree$#@60;6 then begin month3:=month3+1;
Write (Month3:3); End
daythree:=daythree+1;
Until daythree=7;
Writeln; p:=0;
Repeat p:=p+1; {Output 2,3,4 line of three month days}
t:=0;
Repeat
Month1:=month1+1;write (Month1:3);
t:=t+1;
Until t=7;
t:=0;
Repeat
Month2:=month2+1;write (Month2:3);
t:=t+1;
Until t=7;
t:=0;
Repeat
Month3:=month3+1;write (Month3:3);
t:=t+1;
Until t=7; Writeln;
Until p=3; p:=0;
Repeat p:=p+1; {Output three months 5,6}
Begin t:=0;
Repeat if Month1=monthday (year,x) then write (: 3)
else begin month1:=month1+1; Write (Month1:3); End
t:=t+1;
Until (t=7) end;
Begin t:=0;
Repeat if Month2=monthday (year,x+1) then write (: 3)
Else begin Month2:=month2+1;write (MONTH2:3); End
t:=t+1;
Until (t=7)
End
Begin t:=0;
Repeat if Month3=monthday (year,x+2) then write (: 3)
else begin month3:=month3+1; Write (Month3:3); End
t:=t+1;
Until (t=7)
End Writeln;
Until p=2;
End;
BEGIN {Main program}
READLN (year);
Writeln (January February March);
Weekout; Day (1);
Writeln (April May June);
Weekout; Day (4);
Writeln (Tue prefer September);
Weekout; Day (7);
Writeln (October November December);
Weekout; Day (10);
End.
{This is sent by my friend for me! Lionman}