Changeset 100 for trunk/UGame.pas

Timestamp:

Dec 26, 2014, 8:10:40 PM (10 years ago)

Author:

chronos

Message:

• Added: Support for autogeneration of bridges between separated areas.

File:

• trunk/UGame.pas (modified) (23 diffs)

trunk/UGame.pas

@@ -26 +26 @@
   TCells = class;
   TMap = class;
+  TCellLinks = class;
+  TMapArea = class;
 
   TFloatPoint = record
@@ -39 +41 @@
   TCell = class
   private
+    FArea: TMapArea;
     FMap: TMap;
     FPower: Integer;
+    procedure SetArea(AValue: TMapArea);
     procedure SetPower(AValue: Integer);
   public
@@ -54 +58 @@
     Neighbors: TCells;
     Mark: Boolean;
+    procedure AreaExtend;
     procedure FixRefId;
     procedure LoadFromNode(Node: TDOMNode);
@@ -66 +71 @@
     property Power: Integer read FPower write SetPower;
     property Map: TMap read FMap write FMap;
+    property Area: TMapArea read FArea write SetArea;
   end;
 
@@ -78 +84 @@
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
+    procedure ClearMark;
+  end;
+
+  TCellLink = class
+    Points: array of TPoint;
+    Cell1: TCell;
+    Cell2: TCell;
+  end;
+
+  TCellLinks = class(TObjectList)
+
   end;
 
@@ -116 +133 @@
   TMapShape = (msRectangle, msImage);
 
+  { TMapArea }
+
+  TMapArea = class
+    Id: Integer;
+    Map: TMap;
+    BridgeCount: Integer;
+    Cells: TCells;
+    procedure GetBorderCells(List: TCells);
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  TMapAreas = class(TObjectList)
+
+  end;
+
   { TMap }
 
@@ -136 +169 @@
     Shape: TMapShape;
     Image: TImage;
+    CellLinks: TCellLinks;
+    Areas: TMapAreas;
     function IsOutsideShape(Coord: TPoint): Boolean; virtual;
     function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
@@ -357 +392 @@
     procedure UpdateRepeatMoves(Player: TPlayer);
     procedure CheckCounterMove(Move: TUnitMove);
+    function SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
+    procedure BuildTerrain;
+    procedure BuildBridges;
+    procedure BuildMapAreas;
   public
     Players: TPlayers;
@@ -377 +416 @@
     FileName: string;
     FogOfWar: Boolean;
+    BridgeEnabled: Boolean;
     function AttackProbability(AttackCount, DefendCount: Integer): Double;
     procedure LoadConfig(Config: TXmlConfig; Path: string);
@@ -499 +539 @@
 end;
 
+{ TMapArea }
+
+procedure TMapArea.GetBorderCells(List: TCells);
+var
+  I: Integer;
+  J: Integer;
+  NeighVoidCount: Integer;
+begin
+  List.Clear;
+
+  // Unset mark for all cells
+  for I := 0 to Map.Cells.Count - 1 do
+    TCell(Map.Cells[I]).Mark := False;
+
+  for I := 0 to Cells.Count - 1 do
+  with TCell(Cells[I]) do begin
+    NeighVoidCount := 0;
+    for J := 0 to Neighbors.Count - 1 do
+    with TCell(Neighbors[J]) do
+      if (Terrain = ttVoid) then Inc(NeighVoidCount);
+
+    if (NeighVoidCount > 0) and (Area = Self) and (not Mark) then begin
+        List.Add(TCell(Self.Cells[I]));
+        Mark := True;
+      end;
+  end;
+end;
+
+constructor TMapArea.Create;
+begin
+  Cells := TCells.Create;
+  Cells.OwnsObjects := False;
+end;
+
+destructor TMapArea.Destroy;
+begin
+  Cells.Free;
+  inherited Destroy;
+end;
+
 { TPlayerCell }
 
@@ -641 +721 @@
   try
     Lock;
+    // Draw cell links
+    Pen.Color := clBlack;
+    Pen.Style := psSolid;
+    Pen.Width := 3;
+    for C := 0 to Player.Game.Map.CellLinks.Count - 1 do
+    with TCellLink(Player.Game.Map.CellLinks[C]) do begin
+      if Length(Points) >= 2 then begin
+        MoveTo(View.CellToCanvasPos(Points[0]));
+        for I := 1 to Length(Points) - 1 do
+          LineTo(View.CellToCanvasPos(Points[I]));
+      end;
+    end;
+
+    // Draw cells
     for C := 0 to Cells.Count - 1 do begin
       Cell := TPlayerCell(Cells[C]);
@@ -769 +863 @@
 end;
 
+procedure TCells.ClearMark;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    TCell(Items[I]).Mark := False;
+end;
+
 { TPlayers }
 
@@ -957 +1059 @@
 
   // Generate neighbours
-  for Y := 0 to self.FSize.Y - 1 do
+  for Y := 0 to Self.FSize.Y - 1 do
   for X := 0 to FSize.X - 1 do
   with TCell(Cells[Y * FSize.X + X]) do begin
@@ -1288 +1390 @@
   I: Integer;
   NewCell: TCell;
-  NeighCells: TCellArray;
 begin
   // Free previous
@@ -1313 +1414 @@
   Size := Point(0, 0);
   Image := TImage.Create(nil);
+  CellLinks := TCellLinks.Create;
+  Areas := TMapAreas.Create;
 end;
 
 destructor TMap.Destroy;
 begin
+  Areas.Free;
+  CellLinks.Free;
   Image.Free;
   Size := Point(0, 0);
@@ -1467 +1572 @@
     raise Exception.Create('Not allowed to substract power under zero do negative value');
   FPower := AValue;
+end;
+
+procedure TCell.SetArea(AValue: TMapArea);
+begin
+  if FArea = AValue then Exit;
+  if Assigned(FArea) then FArea.Cells.Remove(Self);
+  FArea := AValue;
+  if Assigned(FArea) then FArea.Cells.Add(Self);
+end;
+
+procedure TCell.AreaExtend;
+var
+  I: Integer;
+begin
+  for I := 0 to Neighbors.Count - 1 do
+  with TCell(Neighbors[I]) do
+  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
+    Area := Self.Area;
+    AreaExtend;
+  end;
 end;
 
@@ -2385 +2510 @@
 end;
 
+function TGame.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
+var
+  NewList: TCells;
+  NewListVoid: TCells;
+  I: Integer;
+  C: Integer;
+begin
+  Result := nil;
+  NewList := TCells.Create;
+  NewList.OwnsObjects := False;
+  NewListVoid := TCells.Create;
+  NewListVoid.OwnsObjects := False;
+
+  for C := 0 to List.Count - 1 do
+  with TCell(List[C]) do begin
+    for I := 0 to Neighbors.Count - 1 do
+    with TCell(Neighbors[I]) do
+    if (not Mark) and (Terrain <> ttVoid) and (Area <> SourceArea) and ((DestArea = nil) or (DestArea = Area)) then begin
+      NewList.Add(TCell(TCell(List[C]).Neighbors[I]));
+      Mark := True;
+    end else
+    if (not Mark) and (Terrain = ttVoid) then begin
+      NewListVoid.Add(TCell(TCell(List[C]).Neighbors[I]));
+      Mark := True;
+    end;
+  end;
+
+  if NewList.Count > 0 then begin
+    // We found cell with different area
+    Result := TCell(NewList[Random(NewList.Count)]);
+  end else
+  if NewListVoid.Count > 0 then begin
+    // Cell was not found but we have more void cells to check
+    Result := SearchDifferentCellArea(NewListVoid, SourceArea, DestArea);
+  end;
+
+  NewListVoid.Free;
+  NewList.Free;
+end;
+
+procedure TGame.BuildTerrain;
+var
+  C: Integer;
+begin
+  if (Map.Shape = msImage) and FileExists(MapImageFileName) and
+  (LoadedImageFileName <> MapImageFileName) then begin
+    LoadedImageFileName := MapImageFileName;
+    Map.Image.Picture.LoadFromFile(MapImageFileName);
+  end;
+
+  // Randomize map terrain
+  for C := 0 to Map.Cells.Count - 1 do
+  with TCell(Map.Cells[C]) do begin
+    if (VoidEnabled and (Random < VoidPercentage / 100)) or
+    (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
+      else begin
+        if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
+          else Terrain := ttNormal;
+      end;
+    Power := Random(MaxNeutralUnits + 1);
+    Player := nil;
+  end;
+end;
+
+procedure TGame.BuildBridges;
+var
+  List: TCells;
+  Cell: TCell;
+  FoundCell1: TCell;
+  FoundCell2: TCell;
+  I: Integer;
+  J: Integer;
+  NewLink: TCellLink;
+begin
+  // Build area bridges
+  if Map.Areas.Count > 1 then
+  for I := 0 to Map.Areas.Count - 1 do
+  with TMapArea(Map.Areas[I]) do begin
+    List := TCells.Create;
+    List.OwnsObjects := False;
+    GetBorderCells(List);
+    Cell := TCell(List[Random(List.Count)]);
+    List.Clear;
+    List.Add(Cell);
+
+    Map.Cells.ClearMark;
+
+    // Find nearest cell with different area
+    FoundCell1 := SearchDifferentCellArea(List, TMapArea(Map.Areas[I]), nil);
+    if Assigned(FoundCell1) then begin
+      // Again find back nearest cell with different area.
+      // This will ensure that both cells are closest ones
+
+      Map.Cells.ClearMark;
+      List[0] := FoundCell1;
+      FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
+      if Assigned(FoundCell2) then begin
+        FoundCell1.Neighbors.Add(FoundCell2);
+        FoundCell2.Neighbors.Add(FoundCell1);
+        NewLink := TCellLink.Create;
+        SetLength(NewLink.Points, 2);
+        NewLink.Cell1 := FoundCell2;
+        NewLink.Points[0] := FoundCell2.PosPx;
+        NewLink.Cell2 := FoundCell1;
+        NewLink.Points[1] := FoundCell1.PosPx;
+        Map.CellLinks.Add(NewLink);
+        Inc(BridgeCount);
+      end;
+    end;
+
+    List.Free;
+  end;
+end;
+
+procedure TGame.BuildMapAreas;
+var
+  C: Integer;
+  NewArea: TMapArea;
+begin
+  for C := 0 to Map.Cells.Count - 1 do
+  with TCell(Map.Cells[C]) do
+    Area := nil;
+  Map.Areas.Clear;
+  for C := 0 to Map.Cells.Count - 1 do
+  with TCell(Map.Cells[C]) do
+  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
+    NewArea := TMapArea(Map.Areas[Map.Areas.Add(TMapArea.Create)]);
+    NewArea.Id := Map.Areas.Count;
+    NewArea.Map := Map;
+    Area := NewArea;
+    AreaExtend;
+  end;
+end;
+
 procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
 begin
@@ -2399 +2658 @@
     SetValue(Path + '/CityEnabled', CityEnabled);
     SetValue(Path + '/CityPercentage', CityPercentage);
+    SetValue(Path + '/BridgeEnabled', BridgeEnabled);
     SetValue(Path + '/GrowAmount', Integer(GrowAmount));
     SetValue(Path + '/GrowCells', Integer(GrowCells));
@@ -2421 +2681 @@
     CityEnabled := GetValue(Path + '/CityEnabled', False);
     CityPercentage := GetValue(Path + '/CityPercentage', 10);
+    BridgeEnabled := GetValue(Path + '/BridgeEnabled', True);
     GrowAmount := TGrowAmount(GetValue(Path + '/GrowAmount', Integer(gaBySquareRoot)));
     GrowCells := TGrowCells(GetValue(Path + '/GrowCells', Integer(gcPlayerAll)));
@@ -2450 +2711 @@
       CityEnabled := ReadBoolean(RootNode, 'CityEnabled', False);
       CityPercentage := ReadInteger(RootNode, 'CityPercentage', 0);
+      BridgeEnabled := ReadBoolean(RootNode, 'BridgeEnabled', False);
       TurnCounter := ReadInteger(RootNode, 'TurnCounter', 0);
       WinObjective := TWinObjective(ReadInteger(RootNode, 'WinObjective', Integer(woDefeatAllOponents)));
@@ -2503 +2765 @@
       WriteBoolean(RootNode, 'CityEnabled', CityEnabled);
       WriteInteger(RootNode, 'CityPercentage', CityPercentage);
+      WriteBoolean(RootNode, 'BridgeEnabled', BridgeEnabled);
       WriteInteger(RootNode, 'TurnCounter', TurnCounter);
       WriteInteger(RootNode, 'WinObjective', Integer(WinObjective));
@@ -2655 +2918 @@
   Counter: Integer;
   C: Integer;
+  LastAreaCount: Integer;
 begin
   FileName := SNewGameFile;
   TurnCounter := 1;
   Moves.Clear;
-  if (Map.Shape = msImage) and FileExists(MapImageFileName) and
-  (LoadedImageFileName <> MapImageFileName) then begin
-    LoadedImageFileName := MapImageFileName;
-    Map.Image.Picture.LoadFromFile(MapImageFileName);
-  end;
-  for C := 0 to Map.Cells.Count - 1 do
-  with TCell(Map.Cells[C]) do begin
-    if (VoidEnabled and (Random < VoidPercentage / 100)) or
-    (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
-      else begin
-        if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
-          else Terrain := ttNormal;
-      end;
-    Power := Random(MaxNeutralUnits + 1);
-    Player := nil;
+
+  BuildTerrain;
+  if BridgeEnabled then begin
+    // Connect all areas to all cells be accessible
+    for I := 0 to Map.CellLinks.Count - 1 do
+    with TCellLink(Map.CellLinks[I]) do begin
+      Cell1.Neighbors.Remove(Cell2);
+      Cell2.Neighbors.Remove(Cell1);
+    end;
+    Map.CellLinks.Clear;
+    BuildMapAreas;
+    LastAreaCount := -1;
+    while (Map.Areas.Count > 1) and (Map.Areas.Count <> LastAreaCount) do begin
+      LastAreaCount := Map.Areas.Count;
+      BuildBridges;
+      BuildMapAreas;
+    end;
   end;
 
@@ -2819 +3085 @@
   try
     Lock;
+
+    // Draw cell links
+    Pen.Color := clBlack;
+    Pen.Style := psSolid;
+    Pen.Width := 3;
+    for C := 0 to CellLinks.Count - 1 do
+    with TCellLink(CellLinks[C]) do begin
+      if Length(Points) >= 2 then begin
+        MoveTo(Points[0]);
+        for I := 1 to Length(Points) - 1 do
+          LineTo(Points[I]);
+      end;
+    end;
+
+    // Draw cells
     for C := 0 to Cells.Count - 1 do begin
       Cell := TCell(Cells[C]);