Program Maze;
{Written May 15, 1989 by David Rusin, Dept. of Math, Northern IL Univ, DeKalb IL

We define a maze to be an Xmax x Ymax display consisting of two kinds of spaces:
paths and boundaries.

Primary Restrictions:
	Path includes (2,1) ("start") and (Xmax-1, Ymax) ("end")
	Boundary includes rest of edges
	Path is connected (using UDLR motions)
Secondary restrictions: (apply only if primary ones are met)
	Path component simply-connected
	Path component includes no 4 adjacent corners of a square
	Path takes all possible directions with equal likelihood
	Path is a maximal subset of display subject to those conditions
}

const
	Xmax=75;
	Ymax=21; {Make it bigger and you get no instructions. See PrintMaze}
	block: char=#176;

var
	X,Y,X1,Y1,Z,madepath: integer; {X,Y=present position, X1,Y1=next, Z=misc.}
	PrevDir, maze: array[1..Xmax, 1..Ymax] of integer;
	Again,ch,soln:char;

procedure Welcome;
begin
	ClrScr;
	Writeln('This is a pedestrian maze-maker program. Until fixed, you need');
	Writeln(' to remember to hit NumLock before using arrow keys.');
	Again:='y';
end;

procedure Init;
begin
	for X:=1 to Xmax do begin
		for Y:=1 to Ymax do begin
			PrevDir[X,Y]:=0; {0=undefined; 1,2,3,4: see GoTry}
			maze[X,Y]:=0;
{Code: 0=open, 1=Boundary, 2=Path, 3=Solution path, 4=User's path}
		end;
	end;
	for X:= 1 to Xmax do begin
		maze[X,1]:=1;
		maze[X,Ymax]:=1;
	end;
	for Y := 1 to Ymax do begin
		maze[1,Y]:=1;
		maze[Xmax,Y]:=1;
	end;
	madepath:=3; {change to 2 when a path is made}
	maze[2,1]:=madepath;
	maze[Xmax-1,Ymax]:=madepath;
	maze[Xmax-1,Ymax-1]:=madepath;
	PrevDir[Xmax-1,Ymax-1]:=4;
	X:=Xmax-1;
	Y:=Ymax-1;
	soln:=' ';
end;

procedure GoTry;
begin
	if Z=1 then begin X1:=X+1; Y1:=Y; end;
	if Z=2 then begin X1:=X; Y1:=Y-1; end;
	if Z=3 then begin X1:=X-1; Y1:=Y; end;
	if Z=4 then begin X1:=X; Y1:=Y+1; end;
end;	

procedure CheckforSquares(A,B:integer);
begin
	if (maze[A,B]=maze[A+1,B]) and (maze[A,B]=maze[A+1,B+1]) and
		(maze[A,B]=maze[A,B+1]) then Z:=0;
end;

procedure CheckforLoops;
var oldX, oldY, oldZ, bad: integer;
begin
	oldX:=X; oldY:=Y;
	X:=X1; Y:=Y1;
	oldZ:=Z;
	bad:=0;
	for Z:=1 to 4 do begin
		GoTry;
		if ((X1<>oldX) or (Y1<>oldY)) and (maze[X1,Y1]>1) then bad:=1;
	end;
	if bad=1 then maze[X,Y]:=1; {might as well leave it recognized as a boundary}
	if bad=1 then Z:=0 else Z:=oldZ;
	X1:=X;Y1:=Y;
	X:=oldX; Y:=oldY;
end;

procedure CheckforBadSpots;
begin
	if (X1=1) or (X1=Xmax) or (Y1=1) or (Y1=Ymax) then Z:=0;
	if (maze[X1,Y1]>0) then Z:=0;
	if Z>0 then begin {not an edge or a declared spot}
		maze[X1,Y1]:=madepath;
		CheckforSquares(X1,Y1);
		CheckforSquares(X1,Y1-1);
		CheckforSquares(X1-1,Y1-1);
		CheckforSquares(X1-1,Y1);
		maze[X1,Y1]:=0;
	end;
	if Z>0 then CheckforLoops;
end;

procedure ChooseNextDirection;
var 
	PossibleDir,Choices:integer;
	ChoiceList: array[1..4] of Integer;
begin
	Choices:=0;
	for PossibleDir:=1 to 4 do begin
		Z:=PossibleDir;
		GoTry;
		CheckforBadSpots;
		if Z>0 then begin
			Choices:=Choices+1;
			ChoiceList[Choices]:=Z;
		end;
	end;
	if Choices=0 then Z:=0;
	if Choices>0 then Z:=ChoiceList[1+Round(Random(Choices))];
end;

procedure MoveBack;
begin
	if (madepath=3) then maze[X,Y]:=2;
	Z:=PrevDir[X,Y];
	GoTry;
	X:=X1;
	Y:=Y1;
end;

procedure MoveOn;
begin
	GoTry;
	X:=X1;
	Y:=Y1;
	maze[X,Y]:=madepath;
	Z:=Z+2;
	if Z>4 then Z:=Z-4;
	PrevDir[X,Y]:=Z;
end;

procedure Fillup;
begin
	{First ensure that there really is a path:}
	{Warning: this will not mark correct path if end was never reached!}
	X:=1; Y:=2;
	while maze[X,Y]<2 do begin
		if Y=2 then begin
			Y:=X+2;
			X:=1;
		end;
		X:=X+1;Y:=Y-1;
	end; {Now X,Y=closest path point to start. So go left then up:}
	while X>2 do begin
		X:=X-1; maze[X,Y]:=3;  end;
	while Y>1 do begin
		Y:=Y-1; maze[X,Y]:=3; end;
	{Now fill in the places not yet committed; matter of taste}
	for X:=1 to Xmax do begin
		for Y:=1 to Ymax do begin
{			if maze[X,Y]=0 then maze[X,Y]:=Round(Random(2));}
{			if maze[X,Y]=0 then maze[X,Y]:=Round(1+Random(2));}
{			if maze[X,Y]=0 then maze[X,Y]:=Round(1.1+Random(1));}
			if maze[X,Y]=0 then maze[X,Y]:=1;
		end;
	end;
end;

procedure PrintMaze;
var A,B:integer;
begin
	ClrScr;
	maze[2,1]:=4;
	for A:= 1 to Ymax do begin 
		for B:=1 to Xmax do begin
			if maze[B,A]=0 then Write('E'); {Error!}
			if maze[B,A]=1 then Write(block);
			if maze[B,A]=2 then Write(' ');
			if maze[B,A]=3 then Write(soln);
			if maze[B,A]=4 then Write('*');
		end;
		Writeln('');
	end;
	GoToXY(3,1);Write('START');
	GoToXY(Xmax-1,Ymax+1);
	Writeln('END');
	if (Ymax<22) then begin
		Writeln('Options:');
		Write('4,h: Move Left   6,l: Move Right   ');
		Write('8,j: Move Up   2,k: Move Down   ');
		Writeln('q: Quit');
	end;
	soln:='+';
end;

procedure MoveSpot;
begin
	if ((ch='8') or (ch='j')) and (maze[X,Y-1]<>1) then begin
		Y:=Y-1; maze[X,Y]:=4; end;
	if ((ch='2') or (ch='k')) and (maze[X,Y+1]<>1) then begin
		Y:=Y+1; maze[X,Y]:=4; end;
	if ((ch='4') or (ch='h')) and (maze[X-1,Y]<>1) then begin
		X:=X-1; maze[X,Y]:=4; end;
	if ((ch='6') or (ch='l')) and (maze[X+1,Y]<>1) then begin
		X:=X+1; maze[X,Y]:=4; end;
	if (ch='^X') and (maze[X+1,Y]<>1) then begin
		X:=X+1; maze[X,Y]:=4; end;
	GoToXY(X,Y);
	Write('*');
	GoToXY(X,Y);
	if ch='q' then begin PrintMaze; X:=Xmax-1; Y:=Ymax; end;
end;


{*******************MAIN PROGRAM**********************}
begin
	Welcome;
	while (Again='y') or (Again='Y') do begin
		Init;
		while (X<Xmax-1) or (Y<Ymax) do begin
			ChooseNextDirection;
			if Z=0 then MoveBack else MoveOn;
		{make an educated guess as to when you're going to make it:}
			if (X<=3) and (Y<=3) then madepath:=2;
		end;
		Fillup;
		PrintMaze;
		X:=2; Y:=1; GoToXY(X,Y);
		while (X<Xmax-1) or (Y<Ymax) do begin
			Read(kbd,ch);
			MoveSpot;
		end;
		GoToXY(1,Ymax+1);
		Write('Would you like to play again?');
		Read(kbd,Again);Write(Again);
	end;
end.