mirror of
https://github.com/coding-horror/basic-computer-games.git
synced 2025-12-28 13:46:06 -08:00
Merge pull request #201 from gcarreno/02-amazing-pascal-simple
Adding port for 02 Amazing pascal simple
This commit is contained in:
Jeff Atwood
36
02 Amazing/pascal/.gitattributes
vendored
Normal file
36
02 Amazing/pascal/.gitattributes
vendored
Normal file
@@ -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
|
||||
63
02 Amazing/pascal/.gitignore
vendored
Normal file
63
02 Amazing/pascal/.gitignore
vendored
Normal file
@@ -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
|
||||
@@ -1,3 +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))
|
||||
Conversion to [Pascal](https://en.wikipedia.org/wiki/Pascal_(programming_language)) by Gustavo Carreno [gcarreno@github](https://github.com/gcarreno)
|
||||
|
||||
58
02 Amazing/pascal/simple/amazing.lpi
Normal file
58
02 Amazing/pascal/simple/amazing.lpi
Normal file
@@ -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>
|
||||
284
02 Amazing/pascal/simple/amazing.pas
Normal file
284
02 Amazing/pascal/simple/amazing.pas
Normal file
@@ -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