Zeller Pascal

It was my birthday this week so I got to thinking about one of my old Pascal Programs which was a program that used Zellers Algorithm or Congruence to calculate the day of the week from a given date. In this post all I wanted was to share my old Pascal program. In my next section I will go into more detail of how Zeller’s Algorithm works and then create a new solution in a more up-to-date language.

PROGRAM Zeller (input, output);

USES crt;

VAR
   day, month, year, 
   year1, year2, month1, year3, year4 : INTEGER;
   answer1, answer2 : INTEGER;
   rep : CHAR;

PROCEDURE input;
BEGIN
     WRITE('Enter Day   :- ');
     READLN(day);
     WRITE('Enter Month :- ');
     READLN(month);
     WRITE('Enter Year  :- ');
     READLN(year);
END;

PROCEDURE calculate;
BEGIN
     Year1   := TRUNC(year/100);
     Year2   := year-(year1*100);
     Year3   := TRUNC(year1/4);
     Year4   := TRUNC(year2/4);
     month1  := TRUNC((2.6*month)-5.39);
     answer1 := year3+year4+month1+day+year2-(2*year1);
     answer2 := answer1 mod 7;
     IF (answer2 < 6) AND (answer2 <> 0) THEN
        BEGIN
             answer2 := answer2 + 7;
        END;
     IF answer2 > 6 THEN
        BEGIN
             answer2 := answer2 - 7;
        END;
END;

PROCEDURE output;
BEGIN
     WRITE('The ',day,'/',month,'/',year,' was a ');
     CASE answer2 OF
          0: BEGIN
                  WRITELN('Sunday');
                  WRITELN('A child which is born on the Sabbath Day is');
                  WRITELN('fair and wise and good and gay');
             END;
          1: BEGIN
                  WRITELN('Monday');
                  WRITELN('Mondays Child is fair of face');
             END;
          2: BEGIN
                  WRITELN('Tuesday');
                  WRITELN('Tuesdays Child if Full of Grace');
             END;
          3: BEGIN
                  WRITELN('Wednesday');
                  WRITELN('Wednesdays Child is Full of Woe');
             END;
          4: BEGIN
                  WRITELN('Thursday');
                  WRITELN('Thursdays Child has Far to Go');
             END;
          5: BEGIN
                  WRITELN('Friday');
                  WRITELN('Fridays Child is Loving and Giving');
             END;
          6: BEGIN
                  WRITELN('Saturday');
                  WRITELN('Saturdays Child Works hard for its living');
             END;
     END;
END;

BEGIN
     REPEAT
           clrscr;
           input;
           IF (month = 1) OR (month = 2) THEN
              BEGIN
                   month := month + 12;
                   year  := year - 1;
              END;
           calculate;
           IF month > 12 THEN
              BEGIN
                   month := month - 12;
                   year  := year + 1;
              END;
           clrscr;
           output;
           WRITE('Do you wish to go again :- ');
           READLN(rep)
     UNTIL(rep = 'n');
END.