mirror of
https://github.com/coding-horror/basic-computer-games.git
synced 2026-07-11 22:51:35 -07:00
Removed spaces from top-level directory names.
Spaces tend to cause annoyances in a Unix-style shell environment. This change fixes that.
This commit is contained in:
Chris Reuter
@@ -0,0 +1,36 @@
|
||||
# Set the default behavior, in case people don't have core.autocrlf set.
|
||||
* text=auto
|
||||
|
||||
# Explicitly declare text files you want to always be normalized and converted
|
||||
# to native line endings on checkout.
|
||||
*.inc text
|
||||
*.pas text
|
||||
*.pp text
|
||||
*.lpk text
|
||||
*.lpi text
|
||||
*.lps text
|
||||
*.lpr text
|
||||
*.def text
|
||||
*.css text
|
||||
*.html text
|
||||
*.xml text
|
||||
*.sql text
|
||||
|
||||
# Declare files that will always have CRLF line endings on checkout.
|
||||
*.dpk text eol=crlf
|
||||
*.dproj text eol=crlf
|
||||
|
||||
# Declare files that will always have LF line endings on checkout.
|
||||
|
||||
|
||||
# Denote all files that are truly binary and should not be modified.
|
||||
*.png binary
|
||||
*.jpg binary
|
||||
*.exe binary
|
||||
*.res binary
|
||||
*.ico binary
|
||||
*.dll binary
|
||||
|
||||
# Keep these files from archive/exports, mainly from production.
|
||||
.gitignore export-ignore
|
||||
.gitattributes export-ignore
|
||||
@@ -0,0 +1,63 @@
|
||||
# Basic Computer Programs project specific
|
||||
amazing
|
||||
amazing.exe
|
||||
|
||||
# Compiled l10n files: .mo should be ignored
|
||||
*.mo
|
||||
|
||||
# Ghostwriter backups
|
||||
*.backup
|
||||
|
||||
# nano editor backup files
|
||||
*.swp
|
||||
|
||||
# Uncomment these types if you want even more clean repository. But be careful.
|
||||
# It can make harm to an existing project source. Read explanations below.
|
||||
#
|
||||
# Resource files are binaries containing manifest, project icon and version info.
|
||||
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
|
||||
*.res
|
||||
|
||||
# Delphi/Lazarus compiler-generated binaries (safe to delete)
|
||||
*.exe
|
||||
*.dll
|
||||
*.bpl
|
||||
*.bpi
|
||||
*.dcp
|
||||
*.so
|
||||
*.apk
|
||||
*.drc
|
||||
*.map
|
||||
*.dres
|
||||
*.rsm
|
||||
*.tds
|
||||
*.dcu
|
||||
*.lib
|
||||
*.[ao]
|
||||
*.or
|
||||
*.ppu
|
||||
*.dbg
|
||||
*.compiled
|
||||
|
||||
# Delphi autogenerated files (duplicated info)
|
||||
*.cfg
|
||||
*Resource.rc
|
||||
|
||||
# Delphi local files (user-specific info)
|
||||
*.local
|
||||
*.identcache
|
||||
*.projdata
|
||||
*.tvsconfig
|
||||
*.dsk
|
||||
|
||||
# Delphi history and backups
|
||||
__history/
|
||||
*.~*
|
||||
|
||||
# Lazarus history, backups and session
|
||||
backup/
|
||||
*.bak
|
||||
*.lps
|
||||
|
||||
# Castalia statistics file
|
||||
*.stat
|
||||
@@ -0,0 +1,3 @@
|
||||
Original source downloaded [from Vintage Basic](http://www.vintage-basic.net/games.html)
|
||||
|
||||
Conversion to [Pascal](https://en.wikipedia.org/wiki/Pascal_(programming_language)) by Gustavo Carreno [gcarreno@github](https://github.com/gcarreno)
|
||||
@@ -0,0 +1,71 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="amazing"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="amazing.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="amazingapplication.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="AmazingApplication"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="maze.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Maze"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="room.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Room"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="amazing"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,17 @@
|
||||
program amazing;
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode ObjFPC}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
uses
|
||||
AmazingApplication, maze, Room;
|
||||
|
||||
var
|
||||
AmazingApp: TAmazingApplication;
|
||||
|
||||
begin
|
||||
AmazingApp:= TAmazingApplication.Create;
|
||||
AmazingApp.Run;
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,104 @@
|
||||
unit AmazingApplication;
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode ObjFPC}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes
|
||||
, SysUtils
|
||||
, Crt
|
||||
, Maze
|
||||
;
|
||||
|
||||
type
|
||||
{ TAmazingApplication }
|
||||
TAmazingApplication = class(TObject)
|
||||
private
|
||||
FMaze: TMaze;
|
||||
|
||||
procedure PrintGreeting;
|
||||
procedure GetDimensions;
|
||||
procedure BuildMaze;
|
||||
procedure PrintMaze;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Run;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TAmazingApplication }
|
||||
|
||||
procedure TAmazingApplication.PrintGreeting;
|
||||
begin
|
||||
WriteLN(' ':28, 'AMAZING PROGRAM');
|
||||
WriteLN(' ':15, 'CREATIVE COMPUTING MORRISTOWN, NEW JERSEY');
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
end;
|
||||
|
||||
procedure TAmazingApplication.GetDimensions;
|
||||
var
|
||||
width: Integer;
|
||||
length: Integer;
|
||||
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);
|
||||
FMaze:= TMaze.Create(width, length);
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
WriteLN;
|
||||
end;
|
||||
|
||||
procedure TAmazingApplication.BuildMaze;
|
||||
begin
|
||||
FMaze.Build;
|
||||
end;
|
||||
|
||||
procedure TAmazingApplication.PrintMaze;
|
||||
begin
|
||||
FMaze.Print;
|
||||
WriteLN;
|
||||
end;
|
||||
|
||||
constructor TAmazingApplication.Create;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
destructor TAmazingApplication.Destroy;
|
||||
begin
|
||||
if Assigned(FMaze) then
|
||||
begin
|
||||
FMaze.Free;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TAmazingApplication.Run;
|
||||
begin
|
||||
//ClrScr;
|
||||
PrintGreeting;
|
||||
GetDimensions;
|
||||
BuildMaze;
|
||||
PrintMaze;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,280 @@
|
||||
unit Maze;
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode ObjFPC}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes
|
||||
, SysUtils
|
||||
, Room
|
||||
;
|
||||
|
||||
type
|
||||
TDirection = (dUp, dRight, dDown, dLeft);
|
||||
TDirections = set of TDirection;
|
||||
{ TMaze }
|
||||
TMaze = class(TObject)
|
||||
private
|
||||
FWidth: Integer;
|
||||
FLength: Integer;
|
||||
FEntry: Integer;
|
||||
FLabyrinth: Array of Array of TRoom;
|
||||
|
||||
function GetRandomDirection(const ADirections: TDirections): TDirection;
|
||||
|
||||
procedure DebugVisited;
|
||||
procedure DebugWalls;
|
||||
protected
|
||||
public
|
||||
constructor Create(const AWidth, ALength: Integer);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Build;
|
||||
procedure Print;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
EXIT_DOWN = 1;
|
||||
EXIT_RIGHT = 2;
|
||||
|
||||
{ TMaze }
|
||||
|
||||
function TMaze.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 TMaze.DebugVisited;
|
||||
var
|
||||
indexW: Integer;
|
||||
indexL: Integer;
|
||||
begin
|
||||
WriteLN('Visited');
|
||||
for indexL:= 0 to Pred(FLength) do
|
||||
begin
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
Write(FLabyrinth[indexW][indexL].Visited:3,' ');
|
||||
end;
|
||||
WriteLN;
|
||||
end;
|
||||
WriteLN;
|
||||
end;
|
||||
|
||||
procedure TMaze.DebugWalls;
|
||||
var
|
||||
indexW: Integer;
|
||||
indexL: Integer;
|
||||
begin
|
||||
WriteLN('Walls');
|
||||
for indexL:= 0 to Pred(FLength) do
|
||||
begin
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
Write(FLabyrinth[indexW][indexL].Walls:3,' ');
|
||||
end;
|
||||
WriteLN;
|
||||
end;
|
||||
WriteLN;
|
||||
end;
|
||||
|
||||
constructor TMaze.Create(const AWidth, ALength: Integer);
|
||||
var
|
||||
indexW: Integer;
|
||||
indexL: Integer;
|
||||
begin
|
||||
Randomize;
|
||||
FWidth:= AWidth;
|
||||
FLength:= ALength;
|
||||
FEntry:= Random(FWidth);
|
||||
SetLength(FLabyrinth, FWidth, FLength);
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
for indexL:= 0 to Pred(FLength) do
|
||||
begin
|
||||
FLabyrinth[indexW][indexL]:= TRoom.Create;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMaze.Destroy;
|
||||
var
|
||||
indexW: Integer;
|
||||
indexL: Integer;
|
||||
begin
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
for indexL:= 0 to Pred(FLength) do
|
||||
begin
|
||||
if Assigned(FLabyrinth[indexW][indexL]) then
|
||||
begin
|
||||
FLabyrinth[indexW][indexL].Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMaze.Build;
|
||||
var
|
||||
indexW: Integer;
|
||||
indexL: Integer;
|
||||
direction: TDirection;
|
||||
directions: TDirections;
|
||||
count: Integer;
|
||||
begin
|
||||
FEntry:= Random(FWidth);
|
||||
indexW:= FEntry;
|
||||
indexL:= 0;
|
||||
count:= 1;
|
||||
FLabyrinth[indexW][indexL].Visited:= count;
|
||||
Inc(count);
|
||||
repeat
|
||||
directions:= [dUp, dRight, dDown, dLeft];
|
||||
if (indexW = 0) or (FLabyrinth[Pred(indexW)][indexL].Visited <> 0) then
|
||||
begin
|
||||
Exclude(directions, dLeft);
|
||||
end;
|
||||
if (indexL = 0) or (FLabyrinth[indexW][Pred(indexL)].Visited <> 0) then
|
||||
begin
|
||||
Exclude(directions, dUp);
|
||||
end;
|
||||
if (indexW = Pred(FWidth)) or (FLabyrinth[Succ(indexW)][indexL].Visited <> 0) then
|
||||
begin
|
||||
Exclude(directions, dRight);
|
||||
end;
|
||||
if (indexL = Pred(FLength)) or (FLabyrinth[indexW][Succ(indexL)].Visited <> 0) then
|
||||
begin
|
||||
Exclude(directions, dDown);
|
||||
end;
|
||||
|
||||
if directions <> [] then
|
||||
begin
|
||||
direction:= GetRandomDirection(directions);
|
||||
case direction of
|
||||
dLeft:begin
|
||||
Dec(indexW);
|
||||
FLabyrinth[indexW][indexL].Walls:= EXIT_RIGHT;
|
||||
end;
|
||||
dUp:begin
|
||||
Dec(indexL);
|
||||
FLabyrinth[indexW][indexL].Walls:= EXIT_DOWN;
|
||||
end;
|
||||
dRight:begin
|
||||
FLabyrinth[indexW][indexL].Walls:= FLabyrinth[indexW][indexL].Walls + EXIT_RIGHT;
|
||||
Inc(indexW);
|
||||
end;
|
||||
dDown:begin
|
||||
FLabyrinth[indexW][indexL].Walls:= FLabyrinth[indexW][indexL].Walls + EXIT_DOWN;
|
||||
Inc(indexL);
|
||||
end;
|
||||
end;
|
||||
FLabyrinth[indexW][indexL].Visited:= count;
|
||||
Inc(count);
|
||||
end
|
||||
else
|
||||
begin
|
||||
while True do
|
||||
begin
|
||||
if indexW <> Pred(FWidth) then
|
||||
begin
|
||||
Inc(indexW);
|
||||
end
|
||||
else if indexL <> Pred(FLength) then
|
||||
begin
|
||||
Inc(indexL);
|
||||
indexW:= 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
indexW:= 0;
|
||||
indexL:= 0;
|
||||
end;
|
||||
if FLabyrinth[indexW][indexL].Visited <> 0 then
|
||||
begin
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until count = (FWidth * FLength) + 1;
|
||||
indexW:= Random(FWidth);
|
||||
indexL:= Pred(FLength);
|
||||
FLabyrinth[indexW][indexL].Walls:= FLabyrinth[indexW][indexL].Walls + 1;
|
||||
end;
|
||||
|
||||
procedure TMaze.Print;
|
||||
var
|
||||
indexW:Integer;
|
||||
indexL: Integer;
|
||||
begin
|
||||
|
||||
//DebugVisited;
|
||||
//DebugWalls;
|
||||
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
if indexW = FEntry then
|
||||
begin
|
||||
Write('. ');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Write('.--');
|
||||
end;
|
||||
end;
|
||||
WriteLN('.');
|
||||
|
||||
for indexL:= 0 to Pred(FLength) do
|
||||
begin
|
||||
Write('I');
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
FLabyrinth[indexW][indexL].PrintRoom;
|
||||
end;
|
||||
WriteLN;
|
||||
for indexW:= 0 to Pred(FWidth) do
|
||||
begin
|
||||
FLabyrinth[indexW][indexL].PrintWall;
|
||||
end;
|
||||
WriteLN('.');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,71 @@
|
||||
unit Room;
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode ObjFPC}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes
|
||||
, SysUtils
|
||||
;
|
||||
|
||||
type
|
||||
{ TRoom }
|
||||
TRoom = class(TObject)
|
||||
private
|
||||
FVisited: Integer;
|
||||
FWalls: Integer;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
procedure PrintRoom;
|
||||
procedure PrintWall;
|
||||
|
||||
property Visited: Integer
|
||||
read FVisited
|
||||
write FVisited;
|
||||
property Walls: Integer
|
||||
read FWalls
|
||||
write FWalls;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TRoom }
|
||||
|
||||
constructor TRoom.Create;
|
||||
begin
|
||||
FVisited:= 0;
|
||||
FWalls:= 0;
|
||||
end;
|
||||
|
||||
procedure TRoom.PrintRoom;
|
||||
begin
|
||||
if FWalls < 2 then
|
||||
begin
|
||||
Write(' I');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Write(' ');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRoom.PrintWall;
|
||||
begin
|
||||
if (FWalls = 0) or (FWalls = 2) then
|
||||
begin
|
||||
Write(':--');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Write(': ');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,58 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="amazing"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="amazing.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Amazing"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="amazing"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,284 @@
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user