AdventOfCode2023/solvers/UPipeMaze.pas

{
  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.