Changeset 13 for trunk


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

Legend:

Unmodified
Added
Removed
  • trunk/UFormMain.pas

    r12 r13  
    186186  Shift: TShiftState; X, Y: Integer);
    187187begin
    188   if (StartMousePoint.X = X) and (StartMousePoint.Y = Y) then begin
     188  if (Abs(StartMousePoint.X - X) < 5) and (Abs(StartMousePoint.Y - Y) < 5) then begin
    189189    if Game.CurrentPlayer.Mode = pmHuman then begin
    190190      Game.CurrentPlayer.SelectCell(Point(X, Y));
  • trunk/UGame.pas

    r12 r13  
    2323
    2424  TCell = class
     25    Pos: TPoint;
    2526    Terrain: TTerrainType;
    2627    Power: Integer;
    2728    Player: TPlayer;
     29    MovesFrom: TObjectList;
     30    MovesTo: TObjectList;
    2831    function GetColor: TColor;
     32    constructor Create;
     33    destructor Destroy; override;
    2934  end;
    3035
     
    3237
    3338  TMap = class
     39
     40  end;
     41
     42  { THexMap }
     43
     44  THexMap = class(TMap)
    3445  private
     46    FSize: TPoint;
     47    procedure SetSize(AValue: TPoint);
    3548  public
     49    Game: TGame;
    3650    MaxPower: Integer;
    3751    DefaultCellSize: TPoint;
     
    3953    function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double
    4054      ): TPoint;
     55    function CellToPos(Cell: TCell; Rect: TRect; Zoom: Double
     56      ): TPoint;
    4157    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
    4258    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
    4359    constructor Create;
    4460    destructor Destroy; override;
    45     procedure Init(Size: TPoint);
    4661    procedure Grow(APlayer: TPlayer);
     62    procedure ClearCellMoves;
     63    property Size: TPoint read FSize write SetSize;
    4764  end;
    4865
     
    83100  public
    84101    Players: TObjectList; // TList<TPlayer>
    85     Map: TMap;
     102    Map: THexMap;
    86103    VoidEnabled: Boolean;
    87104    CurrentPlayer: TPlayer;
     
    151168end;
    152169
     170constructor TCell.Create;
     171begin
     172  MovesFrom := TObjectList.Create;
     173  MovesFrom.OwnsObjects := False;
     174  MovesTo := TObjectList.Create;
     175  MovesTo.OwnsObjects := False;
     176end;
     177
     178destructor TCell.Destroy;
     179begin
     180  FreeAndNil(MovesFrom);
     181  FreeAndNil(MovesTo);
     182  inherited Destroy;
     183end;
     184
    153185{ TPlayer }
    154186
     
    163195begin
    164196  NewSelectedCell := Game.Map.PosToCell(Pos, View, ViewZoom);
    165   if (NewSelectedCell.X >= 0) and (NewSelectedCell.X < Length(Game.Map.Cells[0])) and
    166     (NewSelectedCell.Y >= 0) and (NewSelectedCell.Y < Length(Game.Map.Cells)) then begin
     197  if (NewSelectedCell.X >= 0) and (NewSelectedCell.X < Game.Map.Size.X) and
     198    (NewSelectedCell.Y >= 0) and (NewSelectedCell.Y < Game.Map.Size.Y) then begin
    167199    if IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
    168200      Game.SetMove(TCell(Game.Map.Cells[SelectedCell.Y, SelectedCell.X]),
     
    287319  //VoidEnabled := True;
    288320
    289   Map := TMap.Create;
     321  Map := THexMap.Create;
     322  Map.Game := Self;
    290323  Moves := TObjectList.Create;
    291324end;
     
    306339  StartCell: TCell;
    307340begin
    308   Map.Init(Point(20, 20));
    309   for Y := 0 to Length(Map.Cells) - 1 do
    310   for X := 0 to Length(Map.Cells[0]) - 1 do
     341  Map.Size := Point(20, 20);
     342  for Y := 0 to Map.Size.Y - 1 do
     343  for X := 0 to Map.Size.X - 1 do
    311344  with Map.Cells[Y, X] do begin
    312345    if VoidEnabled and (Random(2) = 0) then Terrain := ttVoid
     
    316349  for I := 0 to Players.Count - 1 do
    317350  with TPlayer(Players[I]) do begin
    318     StartCell := Map.Cells[Random(Length(Map.Cells)), Random(Length(Map.Cells[0]))];
     351    StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)];
    319352    StartCell.Terrain := ttNormal;
    320353    StartCell.Player := TPlayer(Players[I]);
     
    323356end;
    324357
    325 { TMap }
    326 
    327 function TMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
     358{ THexMap }
     359
     360function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
    328361var
    329362  HexShift: TFloatPoint;
     
    339372end;
    340373
    341 function TMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
     374procedure THexMap.SetSize(AValue: TPoint);
     375var
     376  X, Y: Integer;
     377  NewCell: TCell;
     378  C: Integer;
     379begin
     380  // Free previous
     381  for Y := 0 to FSize.Y - 1 do
     382  for X := 0 to FSize.X - 1 do begin
     383    Cells[Y, X].Destroy;
     384  end;
     385  FSize := AValue;
     386  // Allocate and init new
     387  SetLength(Cells, FSize.X, FSize.Y);
     388  for Y := 0 to FSize.Y - 1 do
     389  for X := 0 to FSize.X - 1 do begin
     390    NewCell := TCell.Create;
     391    NewCell.Pos := Point(X, Y);
     392    Cells[Y, X] := NewCell;
     393  end;
     394end;
     395
     396function THexMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
    342397var
    343398  CX, CY: Integer;
     
    357412        //Y := Y + 0.5;
    358413      end;
    359       if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
     414      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
    360415      if Cells[CY, CX].Terrain = ttNormal then begin
    361416        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X),
     
    369424end;
    370425
    371 
    372 procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
     426function THexMap.CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;
    373427var
    374428  CX, CY: Integer;
     
    376430  HexSize: TFloatPoint;
    377431  CellSize: TFloatPoint;
     432  Points: array of TPoint;
     433begin
     434  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
     435  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
     436  X := Cell.Pos.X - Trunc(Rect.Left / CellSize.X);
     437  Y := Cell.Pos.Y - Trunc(Rect.Top / CellSize.Y);
     438  if (Cell.Pos.Y and 1) = 1 then begin
     439    X := X + 0.5;
     440    //Y := Y + 0.5;
     441  end;
     442
     443  Result.X := Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X);
     444  Result.Y := Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y);
     445end;
     446
     447
     448procedure THexMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
     449var
     450  CX, CY: Integer;
     451  X, Y: Double;
     452  HexSize: TFloatPoint;
     453  CellSize: TFloatPoint;
     454  I: Integer;
     455  Points: array of TPoint;
     456  Cell: TCell;
     457  PosFrom, PosTo: TPoint;
    378458
    379459procedure PaintHexagon(X, Y: Double; Text: string);
     
    395475  with Canvas do try
    396476    Lock;
     477    ClearCellMoves;
     478    // Update moves in cells
     479    for I := 0 to Game.Moves.Count - 1 do
     480    with TMove(Game.Moves[I]) do begin
     481      CellFrom.MovesFrom.Add(TMove(Game.Moves[I]));
     482      CellTo.MovesTo.Add(TMove(Game.Moves[I]));
     483    end;
     484
    397485    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
    398486    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
     
    403491        //Y := Y + 0.5;
    404492      end;
    405       if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
    406       if Cells[CY, CX].Terrain = ttNormal then begin
    407         if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
    408           else if IsCellsNeighbor(SelectedCell, Point(CX, CY)) then Brush.Color := clPurple
    409           else Brush.Color := Cells[CY, CX].GetColor;
    410         PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
    411           Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cells[CY, CX].Power));
     493      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
     494        Cell := Cells[CY, CX];
     495        if Cell.Terrain = ttNormal then begin
     496          if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
     497            else if IsCellsNeighbor(SelectedCell, Point(CX, CY)) then Brush.Color := clPurple
     498            else Brush.Color := Cell.GetColor;
     499          Pen.Color := clBlack;
     500          PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
     501            Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cell.Power));
     502          // Draw arrows
     503          Pen.Color := clCream;
     504          for I := 0 to Cell.MovesFrom.Count - 1 do begin
     505            PosFrom := CellToPos(Cell, Rect, Zoom);
     506            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, Rect, Zoom);
     507            Line(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
     508              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4),
     509              Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
     510              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2));
     511          end;
     512        end;
    412513      end;
    413514    end;
     
    417518end;
    418519
    419 constructor TMap.Create;
     520constructor THexMap.Create;
    420521begin
    421522  DefaultCellSize := Point(62, 62);
     
    423524end;
    424525
    425 destructor TMap.Destroy;
    426 begin
    427   Init(Point(0, 0));
     526destructor THexMap.Destroy;
     527begin
     528  Size := Point(0, 0);
    428529  inherited Destroy;
    429530end;
    430531
    431 procedure TMap.Init(Size: TPoint);
     532procedure THexMap.Grow(APlayer: TPlayer);
    432533var
    433534  X, Y: Integer;
    434   NewCell: TCell;
    435   C: Integer;
    436 begin
    437   // Free previous
    438   for Y := 0 to Length(Cells) - 1 do
    439   for X := 0 to Length(Cells[0]) - 1 do begin
    440     Cells[Y, X].Destroy;
    441   end;
    442   // Allocate and init new
    443   SetLength(Cells, Size.X, Size.Y);
    444   for Y := 0 to Length(Cells) - 1 do
    445   for X := 0 to Length(Cells[0]) - 1 do begin
    446     NewCell := TCell.Create;
    447     Cells[Y, X] := NewCell;
    448   end;
    449 end;
    450 
    451 procedure TMap.Grow(APlayer: TPlayer);
    452 var
    453   X, Y: Integer;
    454 begin
    455   for Y := 0 to Length(Cells) - 1 do
    456   for X := 0 to Length(Cells[0]) - 1 do
     535begin
     536  for Y := 0 to Size.Y - 1 do
     537  for X := 0 to Size.X - 1 do
    457538  with TCell(Cells[Y, X]) do begin
    458539    if Player = APlayer then begin
     
    463544end;
    464545
     546procedure THexMap.ClearCellMoves;
     547var
     548  X, Y: Integer;
     549begin
     550  for Y := 0 to Size.Y - 1 do
     551  for X := 0 to Size.X - 1 do begin
     552    Cells[Y, X].MovesFrom.Clear;
     553    Cells[Y, X].MovesTo.Clear;
     554  end;
     555end;
     556
    465557end.
    466558
  • trunk/xtactics.lpi

    r12 r13  
    6363        <IsPartOfProject Value="True"/>
    6464        <ComponentName Value="FormMove"/>
     65        <HasResources Value="True"/>
    6566        <ResourceBaseClass Value="Form"/>
    6667        <UnitName Value="UFormMove"/>
Note: See TracChangeset for help on using the changeset viewer.