Changeset 50 for trunk

Timestamp:

Aug 17, 2014, 1:12:18 PM (10 years ago)

Author:

chronos

Message:

• Modified: Cell polygons are generated once in TMap descendant Generate method. This will easy support for multiple cell shapes.

File:

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

trunk/UGame.pas

@@ -37 +37 @@
   public
     Pos: TPoint;
+    Polygon: TPointArray;
     Terrain: TTerrainType;
     Player: TPlayer;
@@ -118 +119 @@
     function IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean;
     function GetCellNeighbors2(Cell: TCell): TCellArray;
+    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
   public
     procedure Assign(Source: TMap); override;
@@ -125 +127 @@
     function PosToCell(Pos: TPoint; View: TView): TCell; override;
     function CellToPos(Cell: TCell): TPoint; override;
-    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
+    function GetPixelRect: TRect; override;
     procedure Paint(Canvas: TCanvas; View: TView); override;
     procedure Generate; override;
     constructor Create; override;
     destructor Destroy; override;
-    function GetAllCells: TCellArray; override;
-    function GetPixelRect: TRect; override;
   end;
 
@@ -140 +140 @@
     function IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean;
     function GetCellNeighbors2(Cell: TCell): TCellArray;
+    function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
   public
-    procedure Generate; override;
     function IsValidIndex(Index: TPoint): Boolean; override;
     function PosToCell(Pos: TPoint; View: TView): TCell; override;
     function CellToPos(Cell: TCell): TPoint; override;
-    function GetAllCells: TCellArray; override;
     function GetPixelRect: TRect; override;
     procedure Paint(Canvas: TCanvas; View: TView); override;
+    procedure Generate; override;
     constructor Create; override;
     destructor Destroy; override;
@@ -347 +347 @@
   // Generate neightbours
   for Y := 0 to FSize.Y - 1 do
-  for X := 0 to FSize.X - 1 do begin
+  for X := 0 to FSize.X - 1 do
+  with TCell(Cells[Y * FSize.X + X]) do begin
     NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X]));
     for I := 0 to Length(NeighCells) - 1 do
-      TCell(Cells[Y * FSize.X + X]).Neighbors.Add(NeighCells[I]);
+      Neighbors.Add(NeighCells[I]);
+    Polygon := GetSquarePolygon(Point(Trunc(X * DefaultCellSize.X * SquareCellMulX),
+      Trunc(Y * DefaultCellSize.Y * SquareCellMulY)), DefaultCellSize);
   end;
 end;
@@ -436 +439 @@
 end;
 
-function TSquareMap.GetAllCells: TCellArray;
-var
-  X: Integer;
-  Y: Integer;
-  I: Integer;
-begin
-  SetLength(Result, Size.Y * Size.X);
-  for Y := 0 to Size.Y - 1 do
-  for X := 0 to Size.X - 1 do
-    Result[Y * Size.X + X] := TCell(Cells[Y * FSize.X + X]);
+function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
+begin
+  SetLength(Result, 4);
+  Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
+  Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
+  Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
+  Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
 end;
 
@@ -470 +470 @@
 
 procedure PaintHexagon(Pos: TPoint; Text: string);
+var
+  TextPos: TPoint;
+  I: Integer;
 begin
   with Canvas do begin
@@ -490 +493 @@
       Pen.Width := 0;
     end;
-    Rectangle(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
+    // Transform view
+    SetLength(Points, Length(TCell(Cells[CY * FSize.X + CX]).Polygon));
+    for I := 0 to Length(Points) - 1 do
+      Points[I] := View.CellToCanvasPos(TCell(Cells[CY * FSize.X + CX]).Polygon[I]);
+
+    Polygon(Points, False, 0, Length(Points));
     //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
     Pen.Style := psSolid;
     Font.Color := clWhite;
     Font.Size := Trunc(12 * View.Zoom);
-    TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
+    TextPos := View.CellToCanvasPos(Pos);
+    TextOut(Round(TextPos.X) - TextWidth(Text) div 2, Round(TextPos.Y) - TextHeight(Text) div 2, Text);
   end;
 end;
@@ -516 +525 @@
             else Brush.Color := Cell.GetColor;
           Pen.Color := clBlack;
-          PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
-            Trunc(Y * CellSize.Y))),
+          PaintHexagon(Point(Trunc(X * CellSize.X),
+            Trunc(Y * CellSize.Y)),
             IntToStr(Cell.GetAvialPower));
           // Draw arrows
@@ -750 +759 @@
 end;
 
-
 function TMap.GetAllCells: TCellArray;
-begin
-  SetLength(Result, 0);
+var
+  I: Integer;
+begin
+  SetLength(Result, Cells.Count);
+  for I := 0 to Cells.Count - 1do
+    Result[I] := TCell(Cells[I]);
 end;
 
@@ -1450 +1462 @@
 { THexMap }
 
-function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
-var
-  HexShift: TFloatPoint;
-begin
-  HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
+function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
+var
+  Shift: TFloatPoint;
+begin
+  Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
   SetLength(Result, 6);
-  Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
-  Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
-  Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
-  Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
-  Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
-  Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
+  Result[0] := Point(Round(Pos.X + 0 * Size.X), Round(Pos.Y - 0.5 * Size.Y));
+  Result[1] := Point(Round(Pos.X + Shift.X * Size.X), Round(Pos.Y - Shift.Y * Size.Y));
+  Result[2] := Point(Round(Pos.X + Shift.X * Size.X), Round(Pos.Y + Shift.Y * Size.Y));
+  Result[3] := Point(Round(Pos.X + 0 * Size.X), Round(Pos.Y + 0.5 * Size.Y));
+  Result[4] := Point(Round(Pos.X - Shift.X * Size.X), Round(Pos.Y + Shift.Y * Size.Y));
+  Result[5] := Point(Round(Pos.X - Shift.X * Size.X), Round(Pos.Y - Shift.Y * Size.Y));
 end;
 
@@ -1545 +1557 @@
   HexSize: TFloatPoint;
   CellSize: TFloatPoint;
-  Points: array of TPoint;
 begin
   // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
@@ -1562 +1573 @@
       if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
       if TCell(Cells[CY * FSize.X + CX]).Terrain <> ttVoid then begin
-        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X),
-          Trunc(Y * CellSize.Y)),
-          Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
-        if PtInPoly(Points, Pos) then begin
+        if PtInPoly(TCell(Cells[CY * FSize.X + CX]).Polygon, Pos) then begin
           Result := TCell(Cells[CY * FSize.X + CX]);
           Exit;
@@ -1608 +1616 @@
   ArrowCenter: TPoint;
 
-procedure PaintHexagon(Pos: TPoint; Text: string);
-var
-  Points: array of TPoint;
+procedure PaintHexagon(Pos: TPoint; Text: string; View: TView);
+var
+  I: Integer;
+  TextPos: TPoint;
 begin
   with Canvas do begin
@@ -1631 +1640 @@
       Pen.Width := 0;
     end;
-    Points := GetHexagonPolygon(Point(Trunc(Pos.X), Trunc(Pos.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
+    // Transform view
+    SetLength(Points, Length(TCell(Cells[CY * FSize.X + CX]).Polygon));
+    for I := 0 to Length(Points) - 1 do
+      Points[I] := View.CellToCanvasPos(TCell(Cells[CY * FSize.X + CX]).Polygon[I]);
+
     Polygon(Points, False, 0, Length(Points));
     //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
@@ -1637 +1650 @@
     Font.Color := clWhite;
     Font.Size := Trunc(12 * View.Zoom);
-    TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
+    TextPos := View.CellToCanvasPos(Pos);
+    TextOut(Round(TextPos.X) - TextWidth(Text) div 2, Round(TextPos.Y) - TextHeight(Text) div 2, Text);
   end;
 end;
@@ -1663 +1677 @@
             else Brush.Color := Cell.GetColor;
           Pen.Color := clBlack;
-          PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
-            Trunc(Y * CellSize.Y))),
-            IntToStr(Cell.GetAvialPower));
+          PaintHexagon(Point(Trunc(X * CellSize.X),
+            Trunc(Y * CellSize.Y)),
+            IntToStr(Cell.GetAvialPower), View);
           // Draw arrows
           Pen.Color := clCream;
@@ -1695 +1709 @@
   NewCell: TCell;
   NeighCells: TCellArray;
+  PX, PY: Double;
 begin
   inherited;
@@ -1709 +1724 @@
   // Generate neightbours
   for Y := 0 to FSize.Y - 1 do
-  for X := 0 to FSize.X - 1 do begin
+  for X := 0 to FSize.X - 1 do
+  with TCell(Cells[Y * FSize.X + X]) do begin
     NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X]));
+    Neighbors.Count := Length(NeighCells);
     for I := 0 to Length(NeighCells) - 1 do
-      TCell(Cells[Y * FSize.X + X]).Neighbors.Add(NeighCells[I]);
+      Neighbors[I] := NeighCells[I];
+    PX := X;
+    PY := Y;
+    if (Y and 1) = 1 then begin
+      PX := PX + 0.5;
+      //Y := Y + 0.5;
+    end;
+    Polygon := GetHexagonPolygon(Point(Trunc(PX * DefaultCellSize.X / HexCellMulX),
+      Trunc(PY * DefaultCellSize.Y / HexCellMulY)), DefaultCellSize);
   end;
 end;
@@ -1725 +1750 @@
 begin
   inherited Destroy;
-end;
-
-function THexMap.GetAllCells: TCellArray;
-var
-  X: Integer;
-  Y: Integer;
-  I: Integer;
-begin
-  SetLength(Result, Size.Y * Size.X);
-  for Y := 0 to Size.Y - 1 do
-  for X := 0 to Size.X - 1 do
-    Result[Y * Size.X + X] := TCell(Cells[Y * FSize.X + X]);
 end;