program Calendar;
{Reads the day of January 1 and the year and prints calendar.
  Demo for stubs, drivers, and enumerated types.}

type DayType = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
     WeekdayType = Mon..Fri;
     MonthType = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
     YearType = 1500..2500; {valid for Gregorian calendar}
     MLType = 28..31; {monthlengths}

var  Year : Yeartype; {input - the calendar year}
     StartDay : Daytype; {input - New Year's Day}
     DayCh1,DayCh2,DayCh3 : Char; {input - letters in day name}
     Month : MonthType; {the current month}
     FebFlag : Boolean; {true for leap years}

function LeapYear(YearFP : YearType) : Boolean;
{determine if leap year}
     begin
       LeapYear := YearFP mod 4 = 0;
       if (((YearFp mod 100) = 0) and ((YearFP mod 400) <> 0)) then
         LeapYear := False;
     end;

procedure Heading(YearFP : YearType);
{output nice heading}
     begin
       WriteLn;
       WriteLn('      ', YearFP);
       WriteLn; WriteLn;
     end;


procedure DayCode(Ch1,Ch2: Char; var Day : DayType);
{day conversion}
     begin
       case Ch1 of
        'S','s' : if (Ch2 = 'u') or (Ch2 = 'U') then
                    Day := Sun
                  else if (Ch2 = 'a') or (Ch2 = 'A') then
                    Day := Sat
                  else
                    WriteLn('BadDayCode');
        'M','m' : Day := Mon;
        'T','t' : if (Ch2 = 'u') or (Ch2 = 'U') then
                    Day := Tue
                  else if (Ch2 = 'h') or (Ch2 = 'H') then
                    Day := Thu
                  else
                    WriteLn('BadDayCode');
        'W','w' : Day := Wed;
        'F','f' : Day := Fri
        else WriteLn('BadDayCode')
        end{Case Ch1};
     end;{DayCode}


procedure MonthHeading(MthFP : MonthType);

begin
  WriteLn;WriteLn;
  Write('    ');
  case MthFP of
    Jan : WriteLn(' January');
    Feb : WriteLn('February');
    Mar : WriteLn('  March');
    Apr : WriteLn('  April');
    May : WriteLn('   May');
    Jun : WriteLn('  June');
    Jul : WriteLn('  July');
    Aug : WriteLn(' August');
    Sep : WriteLn('September');
    Oct : WriteLn(' October');
    Nov : WriteLn(' November');
    Dec : WriteLn(' December')
  end;{case MthFP}
  WriteLn;
  WriteLn(' Sun Mon Tue Wed Thu Fri Sat');
  WriteLn
end;{MonthHeading}

function MonLen( Mth : MonthType; Flag : Boolean) : Integer;
{returns length of month Mth; Flag is True for leap years}
begin
  case Mth of
    Apr, Jun, Sep, Nov : MonLen := 30;
    Jan, Mar, May, Jul, Aug, Oct, Dec : MonLen := 31;
    Feb : if Flag then MonLen := 29 else MonLen := 28;
  end{case Mth}
end;{MonLen}


procedure PrintWeeks(MLFP : MLType; var StDFP : DayType);

   var Day : DayType;
       DayNum : 1.. 31;

   begin
   {First Week:}
     WriteLn;
     Day := Sun; DayNum := 1;
     while Day < StDFP do
      begin
        Write('    ');
        Day := Succ(Day)
      end;
     for Day := StDFP to Sat do
       begin
         Write(DayNum :4);
         Daynum := DayNum + 1
       end;
    WriteLn; WriteLn;
    {Later Weeks:}
    while DayNum + 6 <= MLFP do
     begin
      for Day := Sun to Sat do
        begin
          Write(DayNum : 4);
          Daynum := DayNum + 1;
        end;{for}
       WriteLn;WriteLn;
     end;
    {Last Week}
    StDFP := Sun;
    while DayNum <= MLFP do
     begin
       Write(DayNum :4);
       StDFP := Succ(StDFP);
       DayNum := DayNum +1
     end
  end;{PrintWeeks}


procedure PrintMonth(Month: MonthType; FebFP : Boolean; var StDay : DayType);
{the main procedure}

  var ML : MLType;

  begin{PrintMonth}
    MonthHeading(Month);
    ML := MonLen(Month, FebFP);
    PrintWeeks(ML, StDay)
  end;{PrintMonth}



begin{main program}
     WriteLn('Type the year - after 1500, before 2500 - and New Year''s Day');
     ReadLn(Year);
     WriteLn('Use the first 2 letters to identify the day.');
     ReadLn(DayCh1, DayCh2);
     FebFlag := LeapYear(Year);
     Heading( Year );
     DayCode(DayCh1,DayCh2,StartDay);
     for Month := Jan to Dec do
       PrintMonth(Month,FebFlag,StartDay);
end.