Changeset 13 for trunk

Timestamp:

Feb 19, 2014, 10:42:16 PM (11 years ago)

Author:

chronos

Message:

• Modified: Map size is now stored as private member of type TPoint.
• Modified: Introduced parent TMap class inheried by THexMap to support multiple map types in future.
• Added: Visualization of planned moves between cells for next turn.

Location:

trunk

Files:

• UFormMain.pas (modified) (1 diff)
• UGame.pas (modified) (19 diffs)
• xtactics.lpi (modified) (1 diff)

trunk/UFormMain.pas

@@ -186 +186 @@
   Shift: TShiftState; X, Y: Integer);
 begin
-  if (StartMousePoint.X = X) and (StartMousePoint.Y = Y) then begin
+  if (Abs(StartMousePoint.X - X) < 5) and (Abs(StartMousePoint.Y - Y) < 5) then begin
     if Game.CurrentPlayer.Mode = pmHuman then begin
       Game.CurrentPlayer.SelectCell(Point(X, Y));

trunk/UGame.pas

@@ -23 +23 @@
 
   TCell = class
+    Pos: TPoint;
     Terrain: TTerrainType;
     Power: Integer;
     Player: TPlayer;
+    MovesFrom: TObjectList;
+    MovesTo: TObjectList;
     function GetColor: TColor;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -32 +37 @@
 
   TMap = class
+
+  end;
+
+  { THexMap }
+
+  THexMap = class(TMap)
   private
+    FSize: TPoint;
+    procedure SetSize(AValue: TPoint);
   public
+    Game: TGame;
     MaxPower: Integer;
     DefaultCellSize: TPoint;
@@ -39 +53 @@
     function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double
       ): TPoint;
+    function CellToPos(Cell: TCell; Rect: TRect; Zoom: Double
+      ): TPoint;
     function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
     procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
     constructor Create;
     destructor Destroy; override;
-    procedure Init(Size: TPoint);
     procedure Grow(APlayer: TPlayer);
+    procedure ClearCellMoves;
+    property Size: TPoint read FSize write SetSize;
   end;
 
@@ -83 +100 @@
   public
     Players: TObjectList; // TList<TPlayer>
-    Map: TMap;
+    Map: THexMap;
     VoidEnabled: Boolean;
     CurrentPlayer: TPlayer;
@@ -151 +168 @@
 end;
 
+constructor TCell.Create;
+begin
+  MovesFrom := TObjectList.Create;
+  MovesFrom.OwnsObjects := False;
+  MovesTo := TObjectList.Create;
+  MovesTo.OwnsObjects := False;
+end;
+
+destructor TCell.Destroy;
+begin
+  FreeAndNil(MovesFrom);
+  FreeAndNil(MovesTo);
+  inherited Destroy;
+end;
+
 { TPlayer }
 
@@ -163 +195 @@
 begin
   NewSelectedCell := Game.Map.PosToCell(Pos, View, ViewZoom);
-  if (NewSelectedCell.X >= 0) and (NewSelectedCell.X < Length(Game.Map.Cells[0])) and
-    (NewSelectedCell.Y >= 0) and (NewSelectedCell.Y < Length(Game.Map.Cells)) then begin
+  if (NewSelectedCell.X >= 0) and (NewSelectedCell.X < Game.Map.Size.X) and
+    (NewSelectedCell.Y >= 0) and (NewSelectedCell.Y < Game.Map.Size.Y) then begin
     if IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
       Game.SetMove(TCell(Game.Map.Cells[SelectedCell.Y, SelectedCell.X]),
@@ -287 +319 @@
   //VoidEnabled := True;
 
-  Map := TMap.Create;
+  Map := THexMap.Create;
+  Map.Game := Self;
   Moves := TObjectList.Create;
 end;
@@ -306 +339 @@
   StartCell: TCell;
 begin
-  Map.Init(Point(20, 20));
-  for Y := 0 to Length(Map.Cells) - 1 do
-  for X := 0 to Length(Map.Cells[0]) - 1 do
+  Map.Size := Point(20, 20);
+  for Y := 0 to Map.Size.Y - 1 do
+  for X := 0 to Map.Size.X - 1 do
   with Map.Cells[Y, X] do begin
     if VoidEnabled and (Random(2) = 0) then Terrain := ttVoid
@@ -316 +349 @@
   for I := 0 to Players.Count - 1 do
   with TPlayer(Players[I]) do begin
-    StartCell := Map.Cells[Random(Length(Map.Cells)), Random(Length(Map.Cells[0]))];
+    StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)];
     StartCell.Terrain := ttNormal;
     StartCell.Player := TPlayer(Players[I]);
@@ -323 +356 @@
 end;
 
-{ TMap }
-
-function TMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
+{ THexMap }
+
+function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
 var
   HexShift: TFloatPoint;
@@ -339 +372 @@
 end;
 
-function TMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
+procedure THexMap.SetSize(AValue: TPoint);
+var
+  X, Y: Integer;
+  NewCell: TCell;
+  C: Integer;
+begin
+  // Free previous
+  for Y := 0 to FSize.Y - 1 do
+  for X := 0 to FSize.X - 1 do begin
+    Cells[Y, X].Destroy;
+  end;
+  FSize := AValue;
+  // Allocate and init new
+  SetLength(Cells, FSize.X, FSize.Y);
+  for Y := 0 to FSize.Y - 1 do
+  for X := 0 to FSize.X - 1 do begin
+    NewCell := TCell.Create;
+    NewCell.Pos := Point(X, Y);
+    Cells[Y, X] := NewCell;
+  end;
+end;
+
+function THexMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
 var
   CX, CY: Integer;
@@ -357 +412 @@
         //Y := Y + 0.5;
       end;
-      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
+      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
       if Cells[CY, CX].Terrain = ttNormal then begin
         Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X),
@@ -369 +424 @@
 end;
 
-
-procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
+function THexMap.CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;
 var
   CX, CY: Integer;
@@ -376 +430 @@
   HexSize: TFloatPoint;
   CellSize: TFloatPoint;
+  Points: array of TPoint;
+begin
+  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
+  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
+  X := Cell.Pos.X - Trunc(Rect.Left / CellSize.X);
+  Y := Cell.Pos.Y - Trunc(Rect.Top / CellSize.Y);
+  if (Cell.Pos.Y and 1) = 1 then begin
+    X := X + 0.5;
+    //Y := Y + 0.5;
+  end;
+
+  Result.X := Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X);
+  Result.Y := Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y);
+end;
+
+
+procedure THexMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
+var
+  CX, CY: Integer;
+  X, Y: Double;
+  HexSize: TFloatPoint;
+  CellSize: TFloatPoint;
+  I: Integer;
+  Points: array of TPoint;
+  Cell: TCell;
+  PosFrom, PosTo: TPoint;
 
 procedure PaintHexagon(X, Y: Double; Text: string);
@@ -395 +475 @@
   with Canvas do try
     Lock;
+    ClearCellMoves;
+    // Update moves in cells
+    for I := 0 to Game.Moves.Count - 1 do
+    with TMove(Game.Moves[I]) do begin
+      CellFrom.MovesFrom.Add(TMove(Game.Moves[I]));
+      CellTo.MovesTo.Add(TMove(Game.Moves[I]));
+    end;
+
     for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
     for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
@@ -403 +491 @@
         //Y := Y + 0.5;
       end;
-      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
-      if Cells[CY, CX].Terrain = ttNormal then begin
-        if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
-          else if IsCellsNeighbor(SelectedCell, Point(CX, CY)) then Brush.Color := clPurple
-          else Brush.Color := Cells[CY, CX].GetColor;
-        PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
-          Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cells[CY, CX].Power));
+      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
+        Cell := Cells[CY, CX];
+        if Cell.Terrain = ttNormal then begin
+          if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
+            else if IsCellsNeighbor(SelectedCell, Point(CX, CY)) then Brush.Color := clPurple
+            else Brush.Color := Cell.GetColor;
+          Pen.Color := clBlack;
+          PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
+            Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cell.Power));
+          // Draw arrows
+          Pen.Color := clCream;
+          for I := 0 to Cell.MovesFrom.Count - 1 do begin
+            PosFrom := CellToPos(Cell, Rect, Zoom);
+            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, Rect, Zoom);
+            Line(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
+              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4),
+              Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
+              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2));
+          end;
+        end;
       end;
     end;
@@ -417 +518 @@
 end;
 
-constructor TMap.Create;
+constructor THexMap.Create;
 begin
   DefaultCellSize := Point(62, 62);
@@ -423 +524 @@
 end;
 
-destructor TMap.Destroy;
-begin
-  Init(Point(0, 0));
+destructor THexMap.Destroy;
+begin
+  Size := Point(0, 0);
   inherited Destroy;
 end;
 
-procedure TMap.Init(Size: TPoint);
+procedure THexMap.Grow(APlayer: TPlayer);
 var
   X, Y: Integer;
-  NewCell: TCell;
-  C: Integer;
-begin
-  // Free previous
-  for Y := 0 to Length(Cells) - 1 do
-  for X := 0 to Length(Cells[0]) - 1 do begin
-    Cells[Y, X].Destroy;
-  end;
-  // Allocate and init new
-  SetLength(Cells, Size.X, Size.Y);
-  for Y := 0 to Length(Cells) - 1 do
-  for X := 0 to Length(Cells[0]) - 1 do begin
-    NewCell := TCell.Create;
-    Cells[Y, X] := NewCell;
-  end;
-end;
-
-procedure TMap.Grow(APlayer: TPlayer);
-var
-  X, Y: Integer;
-begin
-  for Y := 0 to Length(Cells) - 1 do
-  for X := 0 to Length(Cells[0]) - 1 do
+begin
+  for Y := 0 to Size.Y - 1 do
+  for X := 0 to Size.X - 1 do
   with TCell(Cells[Y, X]) do begin
     if Player = APlayer then begin
@@ -463 +544 @@
 end;
 
+procedure THexMap.ClearCellMoves;
+var
+  X, Y: Integer;
+begin
+  for Y := 0 to Size.Y - 1 do
+  for X := 0 to Size.X - 1 do begin
+    Cells[Y, X].MovesFrom.Clear;
+    Cells[Y, X].MovesTo.Clear;
+  end;
+end;
+
 end.
 

trunk/xtactics.lpi

@@ -63 +63 @@
         <IsPartOfProject Value="True"/>
         <ComponentName Value="FormMove"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UFormMove"/>