Added solution for "Day 10: Pipe Maze", part 1

solvers/UPipeMaze.pas

@@ -0,0 +1,240 @@
+{
+  Solutions to the Advent Of Code.
+  Copyright (C) 2023  Stefan Müller
+
+  This program is free software: you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free Software
+  Foundation, either version 3 of the License, or (at your option) any later
+  version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License along with
+  this program.  If not, see <http://www.gnu.org/licenses/>.
+}
+
+unit UPipeMaze;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, USolver;
+
+const
+  CStartChar = 'S';
+
+type
+  TDirection = (drEast, drSouth, drWest, drNorth);
+
+  { TPipeMaze }
+
+  TPipeMaze = class(TSolver)
+  private
+    FWidth, FHeight: Integer;
+    FStrings: TStringList;
+    procedure ParseMaze;
+    function FindStart: TPoint;
+    procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
+    procedure DoStep(var APosition: TPoint; var ADirection: TDirection);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure ProcessDataLine(const ALine: string); override;
+    procedure Finish; override;
+    function GetDataFileName: string; override;
+    function GetPuzzleName: string; override;
+  end;
+
+implementation
+
+{ TPipeMaze }
+
+procedure TPipeMaze.ParseMaze;
+var
+  start, current: TPoint;
+  nextDirection: TDirection;
+begin
+  FHeight := FStrings.Count;
+  FWidth := Length(FStrings[0]);
+
+  start := FindStart;
+  current := start;
+
+  DoFirstStep(current, nextDirection);
+  DoStep(current, nextDirection);
+  Inc(FPart1);
+
+  repeat
+    DoStep(current, nextDirection);
+    DoStep(current, nextDirection);
+    Inc(FPart1);
+  until current = start;
+end;
+
+function TPipeMaze.FindStart: TPoint;
+var
+  i, j: Integer;
+  foundStart: Boolean;
+begin
+  foundStart := False;
+  i := 0;
+  while not foundStart and (i < FStrings.Count) do
+  begin
+    j := 1;
+    while not foundStart and (j <= Length(FStrings[i])) do
+    begin
+      if FStrings[i][j] = CStartChar then
+      begin
+        foundStart := True;
+        Result.X := j;
+        Result.Y := i;
+      end;
+      Inc(j);
+    end;
+    Inc(i);
+  end;
+end;
+
+procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
+begin
+  // Checks going East.
+  if APosition.X < FWidth then
+  begin
+    if FStrings[APosition.Y][APosition.X + 1] = '-' then
+    begin
+      Inc(APosition.X);
+      OStartDirection := drEast;
+      Exit;
+    end
+    else if FStrings[APosition.Y][APosition.X + 1] = 'J' then
+    begin
+      Inc(APosition.X);
+      OStartDirection := drNorth;
+      Exit;
+    end
+    else if FStrings[APosition.Y][APosition.X + 1] = '7' then
+    begin
+      Inc(APosition.X);
+      OStartDirection := drSouth;
+      Exit;
+    end;
+  end;
+
+  // Checks going South.
+  if APosition.Y < FHeight - 1 then
+  begin
+    if FStrings[APosition.Y + 1][APosition.X] = '|' then
+    begin
+      Inc(APosition.Y);
+      OStartDirection := drSouth;
+      Exit;
+    end
+    else if FStrings[APosition.Y + 1][APosition.X] = 'L' then
+    begin
+      Inc(APosition.Y);
+      OStartDirection := drEast;
+      Exit;
+    end
+    else if FStrings[APosition.Y + 1][APosition.X] = 'J' then
+    begin
+      Inc(APosition.Y);
+      OStartDirection := drWest;
+      Exit;
+    end;
+  end;
+
+  // Checks going West.
+  if APosition.X > 1 then
+  begin
+    if FStrings[APosition.Y][APosition.X - 1] = '-' then
+    begin
+      Dec(APosition.X);
+      OStartDirection := drWest;
+      Exit;
+    end
+    else if FStrings[APosition.Y][APosition.X - 1] = 'L' then
+    begin
+      Dec(APosition.X);
+      OStartDirection := drNorth;
+      Exit;
+    end
+    else if FStrings[APosition.Y][APosition.X - 1] = 'F' then
+    begin
+      Dec(APosition.X);
+      OStartDirection := drSouth;
+      Exit;
+    end;
+  end;
+end;
+
+procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TDirection);
+begin
+  case ADirection of
+    drEast: begin
+      Inc(APosition.X);
+      case FStrings[APosition.Y][APosition.X] of
+        'J': ADirection := drNorth;
+        '7': ADirection := drSouth;
+      end;
+    end;
+    drSouth: begin
+      Inc(APosition.Y);
+      case FStrings[APosition.Y][APosition.X] of
+        'L': ADirection := drEast;
+        'J': ADirection := drWest;
+      end;
+    end;
+    drWest: begin
+      Dec(APosition.X);
+      case FStrings[APosition.Y][APosition.X] of
+        'L': ADirection := drNorth;
+        'F': ADirection := drSouth;
+      end;
+    end;
+    drNorth: begin
+      Dec(APosition.Y);
+      case FStrings[APosition.Y][APosition.X] of
+        '7': ADirection := drWest;
+        'F': ADirection := drEast;
+      end;
+    end;
+  end;
+end;
+
+constructor TPipeMaze.Create;
+begin
+  FStrings := TStringList.Create;
+end;
+
+destructor TPipeMaze.Destroy;
+begin
+  FStrings.Free;
+  inherited Destroy;
+end;
+
+procedure TPipeMaze.ProcessDataLine(const ALine: string);
+begin
+  FStrings.Add(ALine);
+end;
+
+procedure TPipeMaze.Finish;
+begin
+  ParseMaze;
+end;
+
+function TPipeMaze.GetDataFileName: string;
+begin
+  Result := 'pipe_maze.txt';
+end;
+
+function TPipeMaze.GetPuzzleName: string;
+begin
+  Result := 'Day 10: Pipe Maze';
+end;
+
+end.
+