program Amazing; {$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF} uses Crt; type TDirection = (dUp, dRight, dDown, dLeft); TDirections = set of TDirection; var Width: Integer; // H Length: Integer; // V Entry: Integer; MatrixWalls: Array of Array of Integer; MatrixVisited: Array of Array of Integer; const EXIT_DOWN = 1; EXIT_RIGHT = 2; procedure PrintGreeting; begin WriteLN(' ':28, 'AMAZING PROGRAM'); WriteLN(' ':15, 'CREATIVE COMPUTING MORRISTOWN, NEW JERSEY'); WriteLN; WriteLN; WriteLN; WriteLN; end; procedure GetDimensions; begin repeat Write('WHAT ARE YOUR WIDTH AND LENGTH (SPACE IN BETWEEN): '); ReadLN(Width, Length); if (Width = 1) or (Length = 1) then begin WriteLN('MEANINGLESS DIMENSIONS. TRY AGAIN.'); end; until (Width > 1) and (Length > 1); WriteLN; WriteLN; WriteLN; WriteLN; end; procedure ClearMatrices; var indexW: Integer; indexL: Integer; begin SetLength(MatrixWalls, Width, Length); SetLength(MatrixVisited, Width, Length); for indexW:= 0 to Pred(Width) do begin for indexL:= 0 to Pred(Length) do begin MatrixWalls[indexW][indexL]:= 0; MatrixVisited[indexW][indexL]:= 0; end; end; end; function GetRandomDirection(const ADirections: TDirections): TDirection; var count: Integer; position: Integer; directions: array [0..3] of TDirection; begin count:= 0; position:= 0; if dUp in ADirections then begin Inc(count); directions[position]:= dUp; Inc(position); end; if dRight in ADirections then begin Inc(count); directions[position]:= dRight; Inc(position); end; if dDown in ADirections then begin Inc(count); directions[position]:= dDown; Inc(position); end; if dLeft in ADirections then begin Inc(count); directions[position]:= dLeft; Inc(position); end; Result:= directions[Random(count)]; end; procedure BuildMaze; var indexW: Integer; indexL: Integer; direction: TDirection; directions: TDirections; count: Integer; begin Entry:= Random(Width); indexW:= Entry; indexL:= 0; count:= 1; MatrixVisited[indexW][indexL]:= count; Inc(count); repeat directions:= [dUp, dRight, dDown, dLeft]; if (indexW = 0) or (MatrixVisited[Pred(indexW)][indexL] <> 0) then begin Exclude(directions, dLeft); end; if (indexL = 0) or (MatrixVisited[indexW][Pred(indexL)] <> 0) then begin Exclude(directions, dUp); end; if (indexW = Pred(Width)) or (MatrixVisited[Succ(indexW)][indexL] <> 0) then begin Exclude(directions, dRight); end; if (indexL = Pred(Length)) or (MatrixVisited[indexW][Succ(indexL)] <> 0) then begin Exclude(directions, dDown); end; if directions <> [] then begin direction:= GetRandomDirection(directions); case direction of dLeft:begin Dec(indexW); MatrixWalls[indexW][indexL]:= EXIT_RIGHT; end; dUp:begin Dec(indexL); MatrixWalls[indexW][indexL]:= EXIT_DOWN; end; dRight:begin Inc(MatrixWalls[indexW][indexL], EXIT_RIGHT); Inc(indexW); end; dDown:begin Inc(MatrixWalls[indexW][indexL], EXIT_DOWN); Inc(indexL); end; end; MatrixVisited[indexW][indexL]:= count; Inc(count); end else begin while True do begin if indexW <> Pred(Width) then begin Inc(indexW); end else if indexL <> Pred(Length) then begin Inc(indexL); indexW:= 0; end else begin indexW:= 0; indexL:= 0; end; if MatrixVisited[indexW][indexL] <> 0 then begin break; end; end; end; until count = (Width * Length) + 1; indexW:= Random(Width); indexL:= Pred(Length); Inc(MatrixWalls[indexW][indexL]); end; procedure DegubVisited; var indexW: Integer; indexL: Integer; begin WriteLN('Visited'); for indexL:= 0 to Pred(Length) do begin for indexW:= 0 to Pred(Width) do begin Write(MatrixVisited[indexW][indexL]:2,' '); end; WriteLN; end; WriteLN; end; procedure DebugWalls; var indexW: Integer; indexL: Integer; begin WriteLN('Walls'); for indexL:= 0 to Pred(Length) do begin for indexW:= 0 to Pred(Width) do begin Write(MatrixWalls[indexW, indexL]:2, ' '); end; WriteLN; end; WriteLN; end; procedure PrintMaze; var indexW: Integer; indexL: Integer; begin for indexW:= 0 to Pred(Width) do begin if indexW = Entry then begin Write('. '); end else begin Write('.--'); end; end; WriteLN('.'); for indexL:= 0 to Pred(Length) do begin Write('I'); for indexW:= 0 to Pred(Width) do begin if MatrixWalls[indexW, indexL] < 2 then begin Write(' I'); end else begin Write(' '); end; end; WriteLN; for indexW:= 0 to Pred(Width) do begin if (MatrixWalls[indexW, indexL] = 0) or (MatrixWalls[indexW, indexL] = 2) then begin Write(':--'); end else begin Write(': '); end; end; WriteLN('.'); end; WriteLN; end; begin Randomize; ClrScr; PrintGreeting; GetDimensions; ClearMatrices; BuildMaze; //DegubVisited; //DebugWalls; PrintMaze; end.