basic-computer-games/02_Amazing/pascal/object-pascal/maze.pas

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.