{ Print the dates of the given month in the given year, with a nice heading. dayFor1st is the day (SUN=0, MON=1, ...) of the first of the month. } procedure PrintMonth (month, year, dayFor1st: integer); { Print the month name, year, and the week heading. } procedure PrintHeading (month, year: integer); begin {PrintHeading} case month of JAN: write ('January '); FEB: write ('February '); MAR: write ('March '); APR: write ('April '); MAY: write ('May '); JUN: write ('June '); JUL: write ('July '); AUG: write ('August '); SEP: write ('September '); OCT: write ('October '); NOV: write ('November '); DEC: write ('December '); end; writeln (year); writeln; writeln (' S M T W T F S'); end {PrintHeading}; { Print the dates of the month week by week in nice calendar form. Do this by first computing how many weeks the month spans. Then find the "date" representing Sunday of the first week. Then call PrintWeek for each week. } procedure PrintDates (dayFor1st, numberDates: integer); var numberWeeks, startOfWeek, i: integer; { Print a week's worth of dates. The date starting the week we're working on is in startOfWeek. It may be negative for the first week of a month. } procedure PrintWeek (startOfWeek, numberDates: integer); var date: integer; begin {PrintWeek} for date := startOfWeek to startOfWeek + 6 do begin if (date > 0) and (date <= numberDates) then begin write (date: 3); end else begin write (BLANK: 3); end; end; writeln; end {PrintWeek}; begin {PrintDates} numberWeeks := (dayFor1st + numberDates + 6) div 7; startOfWeek := 1 - dayFor1st; for i := 1 to numberWeeks do begin PrintWeek (startOfWeek, numberDates); startOfWeek := startOfWeek + 7; end; writeln; writeln; end {PrintDates}; begin {PrintMonth} PrintHeading (month, year); PrintDates (dayFor1st, NumberOfDaysIn (month, year)); end {PrintMonth};