Changeset 100

Timestamp:

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

Author:

chronos

Message:

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

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (7 diffs)
• Forms/UFormMain.pas (modified) (1 diff)
• Forms/UFormNew.lfm (modified) (7 diffs)
• Forms/UFormNew.lrt (modified) (1 diff)
• Forms/UFormNew.pas (modified) (3 diffs)
• Languages/xtactics.cs.po (modified) (5 diffs)
• Languages/xtactics.po (modified) (1 diff)
• UCore.pas (modified) (1 diff)
• UGame.pas (modified) (23 diffs)

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 775
   Caption = 'xTactics'
-  ClientHeight = 592
+  ClientHeight = 595
   ClientWidth = 775
   Menu = MainMenu1
@@ -18 +18 @@
   object StatusBar1: TStatusBar
     Left = 0
-    Height = 29
-    Top = 563
+    Height = 26
+    Top = 569
     Width = 775
     Panels = <    
@@ -35 +35 @@
   object ToolBar1: TToolBar
     Left = 0
-    Height = 563
+    Height = 569
     Top = 0
     Width = 40
@@ -73 +73 @@
     object ToolButton6: TToolButton
       Left = 1
-      Top = 172
+      Top = 194
       Action = AZoomIn
     end
     object ToolButton7: TToolButton
       Left = 1
-      Top = 204
+      Top = 226
       Action = AZoomOut
     end
     object ToolButton8: TToolButton
       Left = 1
-      Top = 236
+      Top = 258
       Action = AZoomAll
     end
     object ToolButton9: TToolButton
       Left = 1
+      Height = 32
       Top = 162
       Width = 32
@@ -94 +95 @@
     object ToolButton10: TToolButton
       Left = 1
-      Top = 268
+      Height = 32
+      Top = 290
       Width = 32
       Style = tbsSeparator
@@ -100 +102 @@
     object ToolButton11: TToolButton
       Left = 1
-      Top = 278
+      Top = 322
       Action = Core.AGameLoad
     end
     object ToolButton12: TToolButton
       Left = 1
-      Top = 310
+      Top = 354
       Action = Core.AGameSave
     end
     object ToolButton13: TToolButton
       Left = 1
-      Top = 342
+      Top = 386
       Action = Core.AExit
     end
@@ -116 +118 @@
   object PaintBox1: TPaintBox
     Left = 40
-    Height = 563
+    Height = 569
     Top = 0
     Width = 735
     Align = alClient
     OnMouseDown = PaintBox1MouseDown
+    OnMouseLeave = PaintBox1MouseLeave
     OnMouseMove = PaintBox1MouseMove
     OnMouseUp = PaintBox1MouseUp
-    OnMouseLeave = PaintBox1MouseLeave
     OnMouseWheelDown = PaintBox1MouseWheelDown
     OnMouseWheelUp = PaintBox1MouseWheelUp

trunk/Forms/UFormMain.pas

@@ -171 +171 @@
     PaintBox1.Repaint;
     StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
-      IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms';
+      IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
+      ' ' + IntToStr(Core.Game.Map.CellLinks.Count);
     NewCaption := 'xTactics';
     if Assigned(Core.Game.CurrentPlayer) then

trunk/Forms/UFormNew.lfm

@@ -49 +49 @@
       object ListView1: TListView
         Left = 4
-        Height = 364
+        Height = 367
         Top = 4
         Width = 1207
@@ -88 +88 @@
         Left = 224
         Height = 25
-        Top = 376
+        Top = 379
         Width = 83
         Action = APlayerRemove
@@ -97 +97 @@
         Left = 16
         Height = 25
-        Top = 376
+        Top = 379
         Width = 83
         Action = APlayerAdd
@@ -106 +106 @@
         Left = 120
         Height = 25
-        Top = 376
+        Top = 379
         Width = 83
         Action = APlayerModify
@@ -330 +330 @@
         Caption = 'Image file:'
         ParentColor = False
+      end
+      object CheckBoxBridges: TCheckBox
+        Left = 8
+        Height = 24
+        Top = 310
+        Width = 204
+        Caption = 'Bridges between cells'
+        TabOrder = 14
       end
     end
@@ -361 +369 @@
       object Label6: TLabel
         Left = 8
-        Height = 25
+        Height = 22
         Top = 248
-        Width = 129
+        Width = 116
         Caption = 'Win objective:'
         ParentColor = False
@@ -369 +377 @@
       object ComboBoxWinObjective: TComboBox
         Left = 232
-        Height = 33
+        Height = 30
         Top = 240
         Width = 328

trunk/Forms/UFormNew.lrt

@@ -21 +21 @@
 TFORMNEW.BUTTONIMAGEBROWSE.CAPTION=Browse
 TFORMNEW.LABEL9.CAPTION=Image file:
+TFORMNEW.CHECKBOXBRIDGES.CAPTION=Bridges between cells
 TFORMNEW.TABSHEET3.CAPTION=Rules
 TFORMNEW.RADIOGROUPGROWCELLS.CAPTION=Growing cells

trunk/Forms/UFormNew.pas

@@ -24 +24 @@
     ButtonPlayerModify: TButton;
     ButtonPlayerRemove: TButton;
+    CheckBoxBridges: TCheckBox;
     CheckBoxFogOfWar: TCheckBox;
     CheckBoxCity: TCheckBox;
@@ -354 +355 @@
   EditImageFile.Text := Game.MapImageFileName;
   CheckBoxFogOfWar.Checked := Game.FogOfWar;
+  CheckBoxBridges.Checked := Game.BridgeEnabled;
 end;
 
@@ -383 +385 @@
   Game.MapImageFileName := EditImageFile.Text;
   Game.FogOfWar := CheckBoxFogOfWar.Checked;
+  Game.BridgeEnabled := CheckBoxBridges.Checked;
 end;
 

trunk/Languages/xtactics.cs.po

@@ -267 +267 @@
 msgstr "Nová hra"
 
+#: tformnew.checkboxbridges.caption
+msgid "Bridges between cells"
+msgstr "Mosty mezi buňkami"
+
 #: tformnew.checkboxcity.caption
 msgid "Cities"
@@ -420 +424 @@
 #: tformsettings.checkbox2.caption
 msgid "Automatic DPI"
-msgstr ""
+msgstr "Automatické DPI"
 
 #: tformsettings.checkboxdevelmode.caption
@@ -441 +445 @@
 #: tformsettings.label4.caption
 msgid "DPI:"
-msgstr ""
+msgstr "DPI:"
 
 #: tformsettings.label5.caption
 msgid "x"
-msgstr ""
+msgstr "x"
 
 #: tformsettings.tabsheetdebug.caption
 msgid "Debug"
-msgstr ""
+msgstr "Ladění"
 
 #: tformsettings.tabsheetgeneral.caption
 msgid "General"
-msgstr ""
+msgstr "Obecné"
 
 #: ucore.sendgame
@@ -578 +582 @@
 #: uformplayer.sagronotattacking
 msgid "Not attacking"
-msgstr ""
+msgstr "Neútočící"
 
 #: uformplayer.scomputer
@@ -627 +631 @@
 #: ugame.szerozoomnotalowed
 msgid "Zero zoom not allowed"
-msgstr ""
-
+msgstr "Nulové přiblížení není povoleno"

trunk/Languages/xtactics.po

@@ -255 +255 @@
 msgstr ""
 
+#: tformnew.checkboxbridges.caption
+msgid "Bridges between cells"
+msgstr ""
+
 #: tformnew.checkboxcity.caption
 msgid "Cities"

trunk/UCore.pas

@@ -359 +359 @@
     //ApplyToAll(DesignDPI);
     FormNew.Show;
+    FormNew.Hide;
     for I := 0 to Screen.FormCount - 1 do begin
       StoreDimensions(Screen.Forms[I], StoredDimension);
       ScaleDimensions(Screen.Forms[I], StoredDimension);
     end;
-    FormNew.Hide;
     ScaleImageList(Core.ImageListSmall, DesignDPI);
     ScaleImageList(Core.ImageListLarge, DesignDPI);

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]);