Program East;
{
	This program follows the Hartmann algorithm to find out
	the date of ascension day etc.; it works from 1900 to 2199.
	Restricted in validity to 1978 .. 2113, an Organiser file is built.

	Designed for compilation using PCQ,(c) Partick Quaid,1990 
}


CONST

Version='$VER:East1.0_(FREEWARE) ';
AppFile="RAM:East.org";
Template="East.tpl";
Catalog="East.catalog";
BadCat="Bad cat";
Holnum:integer=4;
Offset:Array[1..5]of integer=(-2,0,39,49,60);
Decimal:Array[0..3]of integer=(1000,100,10,1);
Binary:Array[1..3]of integer=(131072,512,2);
Fullmonths:Array[1..4]of integer =(59,90,120,151);
Blip:Boolean=false;
Blop:Boolean=false;

VAR

Message:Array[1..17]of string;
Cnt1,Cnt2,Cnt3,Cnt4,Cnt5,Year,Result : integer;
Pull,Push:text;
Chartemp : char;

{ Some definitions from PCQ include files,(c) Partick Quaid,1990}

	Function AllocString(l : Integer) : String;
 	   external;

	Procedure GetParam(n : Short; Var S : String);
	    External;

Procedure Break(x:integer);
begin
	if x = 0 then writeln (badcat) else writeln (Message[x]);
	if blip then close (Push);
	if blop then close (Pull);
	exit (0);
end;

procedure lnginit;
begin
	if reopen(Catalog,Pull) then
		begin
		blip := true;
		for Cnt1 := 1 to 17 do begin
			Message[Cnt1] := AllocString(80);
			if not eof(Pull) then
				 readln (Pull,Message[Cnt1])
			else break(0);
			end;
		if not eof(Pull)then break(0);
		close (Pull);
		blip := false;
		end
	else break(0);
end;

procedure getyear;
begin
	Getparam(1, message[14]);
	If  message[14]^ = '?' Then break(17);	{ Show template }
	If  message[14]^ = 'c' Then
		Begin				{ Also show Corpus Christi }
			Holnum := 5;
			Getparam(2, message[14]);
		End;
	If  message[14]^ = Chr(0) Then
		Begin				{ No parameter }
			WriteLn(Message[16]);
			Readln(Year);
		End
	Else
		Begin
			For Cnt1 := 0 to 3 do
				Year:=Year + Decimal[Cnt1] * ord(message[14][Cnt1]);
			Year := Year-53328;
		End;
end;

procedure rescalc;
begin
	If Year > 2099	then Cnt4 := 14
			else Cnt4 := 13;
	Cnt1 := Year mod 19;
	Cnt2 := (204-11*Cnt1) mod 30;
	If Cnt2 = 28 then Cnt2 := 27 else
		If Cnt2 = 29 then Cnt2 := 28;
	Cnt3 := (Year+(Year div 4)+Cnt2-Cnt4) mod 7;
	Result := 87+Cnt2-Cnt3;
end;

procedure typeout;

begin
	If (Year < 1900) or (Year > 2199) then break(11);
	for Cnt1 := 1 to Holnum do begin
		write (Message[4+Cnt1]);
		Cnt5 := Result+Offset[Cnt1];
		case Cnt5 of
         60..90:  Cnt3 := 1;
         91..120: Cnt3 := 2;
         121..151:Cnt3 := 3;
         else     Cnt3 := 4;
		end;
		write (Cnt5-Fullmonths[Cnt3]);
		writeln (Message[Cnt3]);
	end;
end;

procedure orgfile;

begin
	If (Year < 1978) or (Year > 2113) then break (10);
	If not Open (AppFile,Push) then break(15);
	If ReOpen (Template,Pull) then
	begin
		blip := true;
		blop := true;
		Cnt2 := 1;
		While not eof(Pull) do begin
			read (Pull,Chartemp);
			if Chartemp <> 'N' then 
				write (Push,Chartemp)
			else begin
					for Cnt1 := 1 to 10 do begin
						write (Push,Chartemp);
						if not eof(Pull) then read (Pull,Chartemp)
								 else break(12);
					end;
					for Cnt4 := 1 to 3 do read (Pull,Chartemp);
					if Cnt2 > Holnum then break(12)
					else Cnt1 := pred(Result+Offset[Cnt2]);

					If Year > 2099 then Cnt1 := pred(Cnt1); {Gregorian exception}
	 				Cnt1 := (Year-1978) * 365 + (Year-1976) div 4 + Cnt1;

					Cnt1 := Cnt1 * 675;
					For Cnt5 := 1 to 3 do begin		
						Cnt3 := Cnt1 div binary[Cnt5];
						write (Push,chr(Cnt3));
						Cnt1 := Cnt1-binary[Cnt5]*Cnt3;
					end;
					write (Push,chr(Cnt1*128));
					Cnt2 := succ(Cnt2);
			end;
		end;
		break(13);
	end
	else break(12);
end;


{main program}

begin
	lnginit; {get local expressions}
	getyear; {read parameter from command line or console}
	rescalc; {calculating number of day in year}
	typeout; {typing result on screen}
	orgfile; {writing organiser file}

end.