Uses CRT;
CONST
 Days_In_Month:Array[1..12] of ShortInt=(31,29,31,30,31,30,31,31,30,31,30,31);
 Days_Of_Week:Array[1..7] of String[2]=('Mo','Tu','We','Th','Fr','Sa','Su');
 Months:Array[1..4] of String=
 ('            January              February                  March',
  '             April                 May                      June',
  '             July                 August                 September',
  '            October              November                 December');
VAR
 Calend:Array[1..7,1..96] of ShortInt;
 D_new,D_old:ShortInt;
 i,j,m,k:Byte;
BEGIN
 D_new:=6;
 For m:=1 to 12 do
  begin
   D_old:=D_new;
   For j:=(m-1)*8+1 to (m-1)*8+8 do
    For i:=1 to 7 do
     begin
      If ((((j-(m-1)*8)-1)*7+i-D_old)<0) or
        ((((j-(m-1)*8)-1)*7+i-D_old)>Days_In_Month[m]) then
       Calend[i,j]:=0 else Calend[i,j]:=((j-(m-1)*8)-1)*7+i-D_old;
      If Calend[i,j]=Days_In_Month[m] then D_new:=i;
     end;
  end;

 Clrscr;
 For k:=1 to 2 do
  begin
   Writeln(Months[k]);
   For i:=1 to 7 do
    begin
     Write(Days_Of_Week[i],'  ');
     For j:=(k-1)*24+1 to (k-1)*24+24 do
      if Calend[i,j]=0 then write('   ') else write(Calend[i,j]:3);
     Writeln;
    end;
   Writeln;
   Writeln;
  end;

 Writeln('Press "Enter" to continue...');
 Readln;

 Clrscr;
 For k:=3 to 4 do
  begin
   Writeln(Months[k]);
   For i:=1 to 7 do
    begin
     Write(Days_Of_Week[i],'  ');
     For j:=(k-1)*24+1 to (k-1)*24+24 do
      if Calend[i,j]=0 then write('   ') else write(Calend[i,j]:3);
     Writeln;
    end;
   Writeln;
   Writeln;
  end;

 Readln;
END.