program DayOfTheWeek;

{ This program takes any input date from any year AD, and returns
  the day of the week of that date.

  Program written June 26, 2001 by David Trimboli
  Stardate 1486  }

   const DateLength = 12;  {Length of correctly-formatted Date input}

   type  DateType = string[DateLength];

   var   Date: DateType;
	 Gregorian, Quit: boolean;
	 TheAnswer: integer;

	 FormatCorrect: boolean;  { Remove this declaration when the
				    FormatCorrect function is created. }

   procedure DisplayIntro;
      { Displays an introduction on the screen. }
      begin
	 writeln;
	 writeln('*** Day of Week Calculator ***');
	 writeln;
	 writeln('This program calculates the day of the week for any date AD entered,');
	 writeln('using either the Julian or Gregorian calendar.');
	 writeln('The algorithm may be found at the following URL:');
	 writeln('http://www.tondering.dk/claus/cal/node3.html');
	 writeln('I have not yet included error-correction in the program.');
	 writeln('If you make a mistake in entering the date, it will return a false answer.')
      end;

   procedure DisplayInstructions;
      { Displays instructions on the screen. }
      begin
	 writeln;
	 writeln('Enter a date in exactly the following format: MM/DD/YYYY/C');
	 writeln('C = J for Julian or G for Gregorian');
	 writeln('(or enter Q to quit)');
	 write('DATE> ')
      end;

   procedure GetDate (var Date: DateType; var Quit: boolean);
      { Takes input from the user and returns a string to the variable Date.}
      begin
	 readln(Date);
	 if (Date = 'q') or (Date = 'Q') then Quit := true
      end;

   function ItIsGregorian (Date: DateType): boolean;
      { Figures out which calendar has been used, given a correctly-
       formatted date. }
      var   Calendar: string[1];

      begin
	 Calendar := Copy(Date, DateLength, 1);
	 if Calendar = 'G' then ItIsGregorian := true
	     else ItIsGregorian := false
      end;

   procedure ConvertDate (Date: DateType; var Month, Day, Year: integer);
      { Converts a correctly-formatted Date into a separate month,
	day, and year as integers, and passes them back. }
      var   Code: integer; { satisfies the Val procedure }

      begin
	 Val(copy(Date, 1, 2), Month, Code);
	 Val(copy(Date, 4, 2), Day, Code);
	 Val(copy(Date, 7, 4), Year, Code)
      end;

   function a (Month: integer): integer;
      { Calculate a as per Web page. }
      begin
	 a := (14 - Month) div 12
      end;

   function y (Year, a: integer): integer;
      { Calculate y as per Web page. }
      begin
	 y := Year - a
      end;

   function m (Month, a: integer): integer;
      { Calculate m as per Web page. }
      begin
	 m := Month + (12 * a) - 2
      end;

   function CalculateJulianD (Day, y, m: integer): integer;
      { Calculate the Julian day of week as a number from 0 through 6. }
      begin
	 CalculateJulianD := (5 + Day + y + (y div 4) + ((31 * m) div 12)) mod 7
      end;

   function CalculateGregorianD (Day, y, m: integer): integer;
      { Calculate the Gregorian day of week as a number from 0 through 6. }
      begin
	 CalculateGregorianD := (Day + y + (y div 4) - (y div 100) + (y div 400) + ((31 * m) div 12)) mod 7
      end;

   procedure DisplayError;
      begin
	 writeln;
	 writeln ('That input is not valid.  Please try again.')
      end;

   procedure CalculateAnswer (Date: DateType; ItIsGregorian: boolean;
				    var TheAnswer: integer);
      {Runs the primary calculation and returns a number from 0 - 6.}
      var   Month, Day, Year, I, J, K: integer;

      begin
	 ConvertDate (Date, Month, Day, Year);
	 I := a(Month);
	 J := y(Year, I);
	 K := m(Month, I);
	 if ItIsGregorian
	    then TheAnswer := CalculateGregorianD (Day, J, K)
	    else TheAnswer := CalculateJulianD (Day, J, K)
      end;

   procedure DisplayResults (d: integer; FormatCorrect: boolean);
      { Displays the results of the calculation on the screen.
	0 = Sunday, 1 = Monday ... 6 = Saturday. }
      begin
	 if FormatCorrect then
	    begin
	       writeln;
	       write('That date is a ');
	       case d of
		  0: writeln('Sunday.');
		  1: writeln('Monday.');
		  2: writeln('Tuesday.');
		  3: writeln('Wednesday.');
		  4: writeln('Thursday.');
		  5: writeln('Friday.');
		  6: writeln('Saturday.')
	       end {case}
	    end
	    else DisplayError
      end;

   begin {main}
      FormatCorrect := true;  { Remove this line when the FormatCorrect
				function is completed. }
      Quit := false;
      DisplayIntro;
      while not Quit do
	 begin
	    DisplayInstructions;
	    GetDate (Date, Quit);
	    if FormatCorrect then
	       CalculateAnswer (Date, ItIsGregorian (Date), TheAnswer);
	    if not Quit then DisplayResults (TheAnswer, FormatCorrect)
	 end
   end.