Changeset 50 for trunk


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/UGame.pas

    r49 r50  
    3737  public
    3838    Pos: TPoint;
     39    Polygon: TPointArray;
    3940    Terrain: TTerrainType;
    4041    Player: TPlayer;
     
    118119    function IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean;
    119120    function GetCellNeighbors2(Cell: TCell): TCellArray;
     121    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
    120122  public
    121123    procedure Assign(Source: TMap); override;
     
    125127    function PosToCell(Pos: TPoint; View: TView): TCell; override;
    126128    function CellToPos(Cell: TCell): TPoint; override;
    127     function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
     129    function GetPixelRect: TRect; override;
    128130    procedure Paint(Canvas: TCanvas; View: TView); override;
    129131    procedure Generate; override;
    130132    constructor Create; override;
    131133    destructor Destroy; override;
    132     function GetAllCells: TCellArray; override;
    133     function GetPixelRect: TRect; override;
    134134  end;
    135135
     
    140140    function IsCellsNeighbor2(Cell1, Cell2: TCell): Boolean;
    141141    function GetCellNeighbors2(Cell: TCell): TCellArray;
     142    function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
    142143  public
    143     procedure Generate; override;
    144144    function IsValidIndex(Index: TPoint): Boolean; override;
    145145    function PosToCell(Pos: TPoint; View: TView): TCell; override;
    146146    function CellToPos(Cell: TCell): TPoint; override;
    147     function GetAllCells: TCellArray; override;
    148147    function GetPixelRect: TRect; override;
    149148    procedure Paint(Canvas: TCanvas; View: TView); override;
     149    procedure Generate; override;
    150150    constructor Create; override;
    151151    destructor Destroy; override;
     
    347347  // Generate neightbours
    348348  for Y := 0 to FSize.Y - 1 do
    349   for X := 0 to FSize.X - 1 do begin
     349  for X := 0 to FSize.X - 1 do
     350  with TCell(Cells[Y * FSize.X + X]) do begin
    350351    NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X]));
    351352    for I := 0 to Length(NeighCells) - 1 do
    352       TCell(Cells[Y * FSize.X + X]).Neighbors.Add(NeighCells[I]);
     353      Neighbors.Add(NeighCells[I]);
     354    Polygon := GetSquarePolygon(Point(Trunc(X * DefaultCellSize.X * SquareCellMulX),
     355      Trunc(Y * DefaultCellSize.Y * SquareCellMulY)), DefaultCellSize);
    353356  end;
    354357end;
     
    436439end;
    437440
    438 function TSquareMap.GetAllCells: TCellArray;
    439 var
    440   X: Integer;
    441   Y: Integer;
    442   I: Integer;
    443 begin
    444   SetLength(Result, Size.Y * Size.X);
    445   for Y := 0 to Size.Y - 1 do
    446   for X := 0 to Size.X - 1 do
    447     Result[Y * Size.X + X] := TCell(Cells[Y * FSize.X + X]);
     441function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
     442begin
     443  SetLength(Result, 4);
     444  Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
     445  Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
     446  Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
     447  Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
    448448end;
    449449
     
    470470
    471471procedure PaintHexagon(Pos: TPoint; Text: string);
     472var
     473  TextPos: TPoint;
     474  I: Integer;
    472475begin
    473476  with Canvas do begin
     
    490493      Pen.Width := 0;
    491494    end;
    492     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));
     495    // Transform view
     496    SetLength(Points, Length(TCell(Cells[CY * FSize.X + CX]).Polygon));
     497    for I := 0 to Length(Points) - 1 do
     498      Points[I] := View.CellToCanvasPos(TCell(Cells[CY * FSize.X + CX]).Polygon[I]);
     499
     500    Polygon(Points, False, 0, Length(Points));
    493501    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
    494502    Pen.Style := psSolid;
    495503    Font.Color := clWhite;
    496504    Font.Size := Trunc(12 * View.Zoom);
    497     TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
     505    TextPos := View.CellToCanvasPos(Pos);
     506    TextOut(Round(TextPos.X) - TextWidth(Text) div 2, Round(TextPos.Y) - TextHeight(Text) div 2, Text);
    498507  end;
    499508end;
     
    516525            else Brush.Color := Cell.GetColor;
    517526          Pen.Color := clBlack;
    518           PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
    519             Trunc(Y * CellSize.Y))),
     527          PaintHexagon(Point(Trunc(X * CellSize.X),
     528            Trunc(Y * CellSize.Y)),
    520529            IntToStr(Cell.GetAvialPower));
    521530          // Draw arrows
     
    750759end;
    751760
    752 
    753761function TMap.GetAllCells: TCellArray;
    754 begin
    755   SetLength(Result, 0);
     762var
     763  I: Integer;
     764begin
     765  SetLength(Result, Cells.Count);
     766  for I := 0 to Cells.Count - 1do
     767    Result[I] := TCell(Cells[I]);
    756768end;
    757769
     
    14501462{ THexMap }
    14511463
    1452 function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
    1453 var
    1454   HexShift: TFloatPoint;
    1455 begin
    1456   HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
     1464function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
     1465var
     1466  Shift: TFloatPoint;
     1467begin
     1468  Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
    14571469  SetLength(Result, 6);
    1458   Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
    1459   Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
    1460   Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
    1461   Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
    1462   Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
    1463   Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
     1470  Result[0] := Point(Round(Pos.X + 0 * Size.X), Round(Pos.Y - 0.5 * Size.Y));
     1471  Result[1] := Point(Round(Pos.X + Shift.X * Size.X), Round(Pos.Y - Shift.Y * Size.Y));
     1472  Result[2] := Point(Round(Pos.X + Shift.X * Size.X), Round(Pos.Y + Shift.Y * Size.Y));
     1473  Result[3] := Point(Round(Pos.X + 0 * Size.X), Round(Pos.Y + 0.5 * Size.Y));
     1474  Result[4] := Point(Round(Pos.X - Shift.X * Size.X), Round(Pos.Y + Shift.Y * Size.Y));
     1475  Result[5] := Point(Round(Pos.X - Shift.X * Size.X), Round(Pos.Y - Shift.Y * Size.Y));
    14641476end;
    14651477
     
    15451557  HexSize: TFloatPoint;
    15461558  CellSize: TFloatPoint;
    1547   Points: array of TPoint;
    15481559begin
    15491560  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
     
    15621573      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
    15631574      if TCell(Cells[CY * FSize.X + CX]).Terrain <> ttVoid then begin
    1564         Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X),
    1565           Trunc(Y * CellSize.Y)),
    1566           Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
    1567         if PtInPoly(Points, Pos) then begin
     1575        if PtInPoly(TCell(Cells[CY * FSize.X + CX]).Polygon, Pos) then begin
    15681576          Result := TCell(Cells[CY * FSize.X + CX]);
    15691577          Exit;
     
    16081616  ArrowCenter: TPoint;
    16091617
    1610 procedure PaintHexagon(Pos: TPoint; Text: string);
    1611 var
    1612   Points: array of TPoint;
     1618procedure PaintHexagon(Pos: TPoint; Text: string; View: TView);
     1619var
     1620  I: Integer;
     1621  TextPos: TPoint;
    16131622begin
    16141623  with Canvas do begin
     
    16311640      Pen.Width := 0;
    16321641    end;
    1633     Points := GetHexagonPolygon(Point(Trunc(Pos.X), Trunc(Pos.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
     1642    // Transform view
     1643    SetLength(Points, Length(TCell(Cells[CY * FSize.X + CX]).Polygon));
     1644    for I := 0 to Length(Points) - 1 do
     1645      Points[I] := View.CellToCanvasPos(TCell(Cells[CY * FSize.X + CX]).Polygon[I]);
     1646
    16341647    Polygon(Points, False, 0, Length(Points));
    16351648    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
     
    16371650    Font.Color := clWhite;
    16381651    Font.Size := Trunc(12 * View.Zoom);
    1639     TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
     1652    TextPos := View.CellToCanvasPos(Pos);
     1653    TextOut(Round(TextPos.X) - TextWidth(Text) div 2, Round(TextPos.Y) - TextHeight(Text) div 2, Text);
    16401654  end;
    16411655end;
     
    16631677            else Brush.Color := Cell.GetColor;
    16641678          Pen.Color := clBlack;
    1665           PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
    1666             Trunc(Y * CellSize.Y))),
    1667             IntToStr(Cell.GetAvialPower));
     1679          PaintHexagon(Point(Trunc(X * CellSize.X),
     1680            Trunc(Y * CellSize.Y)),
     1681            IntToStr(Cell.GetAvialPower), View);
    16681682          // Draw arrows
    16691683          Pen.Color := clCream;
     
    16951709  NewCell: TCell;
    16961710  NeighCells: TCellArray;
     1711  PX, PY: Double;
    16971712begin
    16981713  inherited;
     
    17091724  // Generate neightbours
    17101725  for Y := 0 to FSize.Y - 1 do
    1711   for X := 0 to FSize.X - 1 do begin
     1726  for X := 0 to FSize.X - 1 do
     1727  with TCell(Cells[Y * FSize.X + X]) do begin
    17121728    NeighCells := GetCellNeighbors2(TCell(Cells[Y * FSize.X + X]));
     1729    Neighbors.Count := Length(NeighCells);
    17131730    for I := 0 to Length(NeighCells) - 1 do
    1714       TCell(Cells[Y * FSize.X + X]).Neighbors.Add(NeighCells[I]);
     1731      Neighbors[I] := NeighCells[I];
     1732    PX := X;
     1733    PY := Y;
     1734    if (Y and 1) = 1 then begin
     1735      PX := PX + 0.5;
     1736      //Y := Y + 0.5;
     1737    end;
     1738    Polygon := GetHexagonPolygon(Point(Trunc(PX * DefaultCellSize.X / HexCellMulX),
     1739      Trunc(PY * DefaultCellSize.Y / HexCellMulY)), DefaultCellSize);
    17151740  end;
    17161741end;
     
    17251750begin
    17261751  inherited Destroy;
    1727 end;
    1728 
    1729 function THexMap.GetAllCells: TCellArray;
    1730 var
    1731   X: Integer;
    1732   Y: Integer;
    1733   I: Integer;
    1734 begin
    1735   SetLength(Result, Size.Y * Size.X);
    1736   for Y := 0 to Size.Y - 1 do
    1737   for X := 0 to Size.X - 1 do
    1738     Result[Y * Size.X + X] := TCell(Cells[Y * FSize.X + X]);
    17391752end;
    17401753
Note: See TracChangeset for help on using the changeset viewer.