From 943250f37672825078be01abb190e80bc483c354 Mon Sep 17 00:00:00 2001 From: Gustavo Carreno Date: Fri, 5 Mar 2021 15:13:13 +0000 Subject: [PATCH] Adding 02 Amazing pascal simple --- 02 Amazing/pascal/.gitattributes | 36 ++++ 02 Amazing/pascal/.gitignore | 63 ++++++ 02 Amazing/pascal/README.md | 2 +- 02 Amazing/pascal/simple/amazing.lpi | 58 ++++++ 02 Amazing/pascal/simple/amazing.pas | 284 +++++++++++++++++++++++++++ 5 files changed, 442 insertions(+), 1 deletion(-) create mode 100644 02 Amazing/pascal/.gitattributes create mode 100644 02 Amazing/pascal/.gitignore create mode 100644 02 Amazing/pascal/simple/amazing.lpi create mode 100644 02 Amazing/pascal/simple/amazing.pas diff --git a/02 Amazing/pascal/.gitattributes b/02 Amazing/pascal/.gitattributes new file mode 100644 index 00000000..f59d5ede --- /dev/null +++ b/02 Amazing/pascal/.gitattributes @@ -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 diff --git a/02 Amazing/pascal/.gitignore b/02 Amazing/pascal/.gitignore new file mode 100644 index 00000000..f9028d41 --- /dev/null +++ b/02 Amazing/pascal/.gitignore @@ -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 diff --git a/02 Amazing/pascal/README.md b/02 Amazing/pascal/README.md index aa1b3ae5..3f97be91 100644 --- a/02 Amazing/pascal/README.md +++ b/02 Amazing/pascal/README.md @@ -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) diff --git a/02 Amazing/pascal/simple/amazing.lpi b/02 Amazing/pascal/simple/amazing.lpi new file mode 100644 index 00000000..b401a451 --- /dev/null +++ b/02 Amazing/pascal/simple/amazing.lpi @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + <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> diff --git a/02 Amazing/pascal/simple/amazing.pas b/02 Amazing/pascal/simple/amazing.pas new file mode 100644 index 00000000..dc5d7610 --- /dev/null +++ b/02 Amazing/pascal/simple/amazing.pas @@ -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. +