From 212a1c292d5d56d543a7f0157b673fc184b45a5a Mon Sep 17 00:00:00 2001 From: Gustavo Carreno Date: Fri, 5 Mar 2021 17:25:46 +0000 Subject: [PATCH] Adding port of 02 Amazing to pascal object-pascal Adding complete implementation of 02 Amazing in Object-Pascal --- 02 Amazing/pascal/object-pascal/amazing.lpi | 71 +++++ 02 Amazing/pascal/object-pascal/amazing.pas | 17 ++ .../object-pascal/amazingapplication.pas | 104 +++++++ 02 Amazing/pascal/object-pascal/maze.pas | 280 ++++++++++++++++++ 02 Amazing/pascal/object-pascal/room.pas | 71 +++++ 5 files changed, 543 insertions(+) create mode 100644 02 Amazing/pascal/object-pascal/amazing.lpi create mode 100644 02 Amazing/pascal/object-pascal/amazing.pas create mode 100644 02 Amazing/pascal/object-pascal/amazingapplication.pas create mode 100644 02 Amazing/pascal/object-pascal/maze.pas create mode 100644 02 Amazing/pascal/object-pascal/room.pas diff --git a/02 Amazing/pascal/object-pascal/amazing.lpi b/02 Amazing/pascal/object-pascal/amazing.lpi new file mode 100644 index 00000000..0c53b6db --- /dev/null +++ b/02 Amazing/pascal/object-pascal/amazing.lpi @@ -0,0 +1,71 @@ + + + + + + + + + + + + + <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> diff --git a/02 Amazing/pascal/object-pascal/amazing.pas b/02 Amazing/pascal/object-pascal/amazing.pas new file mode 100644 index 00000000..716bd1da --- /dev/null +++ b/02 Amazing/pascal/object-pascal/amazing.pas @@ -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. + diff --git a/02 Amazing/pascal/object-pascal/amazingapplication.pas b/02 Amazing/pascal/object-pascal/amazingapplication.pas new file mode 100644 index 00000000..1431fd67 --- /dev/null +++ b/02 Amazing/pascal/object-pascal/amazingapplication.pas @@ -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. + diff --git a/02 Amazing/pascal/object-pascal/maze.pas b/02 Amazing/pascal/object-pascal/maze.pas new file mode 100644 index 00000000..1f5b3247 --- /dev/null +++ b/02 Amazing/pascal/object-pascal/maze.pas @@ -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. + diff --git a/02 Amazing/pascal/object-pascal/room.pas b/02 Amazing/pascal/object-pascal/room.pas new file mode 100644 index 00000000..f0b74103 --- /dev/null +++ b/02 Amazing/pascal/object-pascal/room.pas @@ -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. +