Changeset 39


Ignore:
Timestamp:
Mar 10, 2014, 11:01:14 PM (11 years ago)
Author:
chronos
Message:
  • Added: Option to create hexagonal or square map. This is implemented using object inheritance and virtual methods of class TMap.
  • Added: Dummy actions to load and save map.
Location:
trunk
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r35 r39  
    101101        Action = Core.AGameEndTurn
    102102      end
     103      object MenuItem14: TMenuItem
     104        Action = Core.AGameLoad
     105      end
     106      object MenuItem15: TMenuItem
     107        Action = Core.AGameSave
     108      end
    103109      object MenuItem5: TMenuItem
    104110        Caption = '-'

  • trunk/Forms/UFormMain.pas

    r35 r39  
    2727    MenuItem12: TMenuItem;
    2828    MenuItem13: TMenuItem;
     29    MenuItem14: TMenuItem;
     30    MenuItem15: TMenuItem;
    2931    MenuItem2: TMenuItem;
    3032    MenuItem3: TMenuItem;
    … …  
    242244    if Assigned(Cell) then begin
    243245      Core.Game.CurrentPlayer.View.FocusedCell := Cell;
    244       StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
     246      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) +
     247        '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
    245248    end else begin
    246249      Core.Game.CurrentPlayer.View.FocusedCell := nil;

  • trunk/Forms/UFormNew.lfm

    r38 r39  
    3535    Height = 24
    3636    Top = 276
    37     Width = 194
     37    Width = 175
    3838    Caption = 'Inaccessible places'
    3939    OnChange = CheckBoxVoidChange
    … …  
    9292    Height = 22
    9393    Top = 184
    94     Width = 99
     94    Width = 88
    9595    Caption = 'Map width:'
    9696    ParentColor = False
    … …  
    139139    Height = 22
    140140    Top = 277
    141     Width = 17
     141    Width = 15
    142142    Caption = '%'
    143143    ParentColor = False
    … …  
    173173    Height = 22
    174174    Top = 232
    175     Width = 106
     175    Width = 94
    176176    Caption = 'Map height:'
    177177    ParentColor = False
    … …  
    181181    Height = 24
    182182    Top = 316
    183     Width = 73
     183    Width = 68
    184184    Caption = 'Cities'
    185185    OnChange = CheckBoxCityChange
    … …  
    199199    Height = 22
    200200    Top = 317
    201     Width = 17
     201    Width = 15
    202202    Caption = '%'
    203203    ParentColor = False
    … …  
    248248    TabOrder = 15
    249249  end
     250  object ComboBoxGridType: TComboBox
     251    Left = 320
     252    Height = 32
     253    Top = 376
     254    Width = 208
     255    ItemHeight = 0
     256    Items.Strings = (
     257      'Hexagonal'
     258      'Square'
     259    )
     260    Style = csDropDownList
     261    TabOrder = 16
     262  end
     263  object Label5: TLabel
     264    Left = 224
     265    Height = 22
     266    Top = 376
     267    Width = 79
     268    Caption = 'Grid type:'
     269    ParentColor = False
     270  end
    250271end

  • trunk/Forms/UFormNew.lrt

    r38 r39  
    1717TFORMNEW.RADIOGROUPGROWAMOUNT.CAPTION=Per turn grow amount
    1818TFORMNEW.RADIOGROUPGROWCELLS.CAPTION=Growing cells
     19TFORMNEW.LABEL5.CAPTION=Grid type:

  • trunk/Forms/UFormNew.pas

    r38 r39  
    2121    CheckBoxVoid: TCheckBox;
    2222    CheckBoxCity: TCheckBox;
     23    ComboBoxGridType: TComboBox;
    2324    Label1: TLabel;
    2425    Label2: TLabel;
    2526    Label3: TLabel;
    2627    Label4: TLabel;
     28    Label5: TLabel;
    2729    ListView1: TListView;
    2830    RadioGroupGrowCells: TRadioGroup;
    … …  
    194196  RadioGroupGrowAmount.ItemIndex := Integer(Game.GrowAmount);
    195197  RadioGroupGrowCells.ItemIndex := Integer(Game.GrowCells);
     198  ComboBoxGridType.ItemIndex := Integer(Game.MapType) - 1;
    196199end;
    197200
    … …  
    215218  Game.GrowAmount := TGrowAmount(RadioGroupGrowAmount.ItemIndex);
    216219  Game.GrowCells := TGrowCells(RadioGroupGrowCells.ItemIndex);
     220  Game.MapType := TMapType(ComboBoxGridType.ItemIndex + 1);
    217221end;
    218222

  • trunk/Languages/xtactics.cs.po

    r38 r39  
    3838msgstr "Ukončit tah hráče"
    3939
     40#: tcore.agameload.caption
     41msgid "Load"
     42msgstr "Načíst"
     43
    4044#: tcore.agamenew.caption
    4145msgctxt "TCORE.AGAMENEW.CAPTION"
    … …  
    5660msgid "Restart game"
    5761msgstr "Restartovat hru"
     62
     63#: tcore.agamesave.caption
     64msgid "Save"
     65msgstr "Uložit"
    5866
    5967#: tcore.asettings.caption
    … …  
    177185msgstr "%"
    178186
     187#: tformnew.label5.caption
     188msgid "Grid type:"
     189msgstr "Typ mřížky:"
     190
    179191#: tformnew.listview1.columns[0].caption
    180192msgid "Name"
    … …  
    260272msgstr "tah"
    261273
     274#: ugame.scannotsetplayerstartcells
     275msgid "Cannot choose start cell for player"
     276msgstr "Nelze vybrat počáteční buňky hráčů."
     277
    262278#: ugame.scomputer
    263279msgid "Computer"

  • trunk/Languages/xtactics.po

    r38 r39  
    2929msgstr ""
    3030
     31#: tcore.agameload.caption
     32msgid "Load"
     33msgstr ""
     34
    3135#: tcore.agamenew.caption
    3236msgctxt "TCORE.AGAMENEW.CAPTION"
    … …  
    4852msgstr ""
    4953
     54#: tcore.agamesave.caption
     55msgid "Save"
     56msgstr ""
     57
    5058#: tcore.asettings.caption
    5159msgctxt "tcore.asettings.caption"
    … …  
    165173msgstr ""
    166174
     175#: tformnew.label5.caption
     176msgid "Grid type:"
     177msgstr ""
     178
    167179#: tformnew.listview1.columns[0].caption
    168180msgid "Name"
    … …  
    248260msgstr ""
    249261
     262#: ugame.scannotsetplayerstartcells
     263msgid "Cannot choose start cell for player"
     264msgstr ""
     265
    250266#: ugame.scomputer
    251267msgid "Computer"

  • trunk/UCore.lfm

    r36 r39  
    5252      OnExecute = ASettingsExecute
    5353      ShortCut = 120
     54    end
     55    object AGameSave: TAction
     56      Caption = 'Save'
     57      OnExecute = AGameSaveExecute
     58      ShortCut = 16467
     59    end
     60    object AGameLoad: TAction
     61      Caption = 'Load'
     62      OnExecute = AGameLoadExecute
     63      ShortCut = 16463
    5464    end
    5565  end
    … …  
    435445    top = 360
    436446  end
     447  object OpenDialog1: TOpenDialog
     448    DefaultExt = '.xtmap'
     449    left = 600
     450    top = 155
     451  end
     452  object SaveDialog1: TSaveDialog
     453    DefaultExt = '.xtmap'
     454    left = 600
     455    top = 88
     456  end
    437457end

  • trunk/UCore.lrt

    r34 r39  
    1111TCORE.ASETTINGS.CAPTION=Settings
    1212TCORE.ASETTINGS.HINT=Application settings
     13TCORE.AGAMESAVE.CAPTION=Save
     14TCORE.AGAMELOAD.CAPTION=Load

  • trunk/UCore.pas

    r36 r39  
    1414
    1515  TCore = class(TDataModule)
     16    AGameSave: TAction;
     17    AGameLoad: TAction;
    1618    ASettings: TAction;
    1719    ActionList1: TActionList;
    … …  
    2426    ImageListLarge: TImageList;
    2527    ImageListSmall: TImageList;
     28    OpenDialog1: TOpenDialog;
     29    SaveDialog1: TSaveDialog;
    2630    XMLConfig1: TXMLConfig;
    2731    procedure AExitExecute(Sender: TObject);
    2832    procedure AGameEndExecute(Sender: TObject);
    2933    procedure AGameEndTurnExecute(Sender: TObject);
     34    procedure AGameLoadExecute(Sender: TObject);
    3035    procedure AGameNewExecute(Sender: TObject);
    3136    procedure AGameRestartExecute(Sender: TObject);
     37    procedure AGameSaveExecute(Sender: TObject);
    3238    procedure ASettingsExecute(Sender: TObject);
    3339    procedure CoolTranslator1Translate(Sender: TObject);
    … …  
    4248    Game: TGame;
    4349    UseSingleView: Boolean;
     50    LastMapFileName: string;
    4451    View: TView;
    4552    procedure Init;
    … …  
    114121end;
    115122
     123procedure TCore.AGameLoadExecute(Sender: TObject);
     124begin
     125  OpenDialog1.FileName := LastMapFileName;
     126  if OpenDialog1.Execute then begin
     127    Game.Map.LoadFromFile(OpenDialog1.FileName);
     128    LastMapFileName := OpenDialog1.FileName;
     129    FormMain.Redraw;
     130  end;
     131end;
     132
    116133procedure TCore.AGameNewExecute(Sender: TObject);
    117134begin
    … …  
    132149end;
    133150
     151procedure TCore.AGameSaveExecute(Sender: TObject);
     152begin
     153  SaveDialog1.FileName := ExtractFileDir(LastMapFileName);
     154  if SaveDialog1.Execute then begin
     155    Game.Map.SaveToFile(SaveDialog1.FileName);
     156    LastMapFileName := SaveDialog1.FileName;
     157  end;
     158end;
     159
    134160procedure TCore.ASettingsExecute(Sender: TObject);
    135161begin
    … …  
    155181  Game.SaveConfig(XMLConfig1, 'Game');
    156182  XMLConfig1.SetValue('Language', CoolTranslator1.Language.Code);
     183  XMLConfig1.SetValue('LastMapFileName', LastMapFileName);
    157184  FreeAndNil(Game);
    158185end;
    … …  
    163190begin
    164191  FInitialized := True;
     192  LastMapFileName := XMLConfig1.GetValue('LastMapFileName', '');
    165193  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(XMLConfig1.GetValue('Language', ''));
    166194  for I := 0 to Game.Players.Count - 1 do

  • trunk/UGame.pas

    r38 r39  
    66
    77uses
    8   Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf;
     8  Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf, XMLRead, XMLWrite,
     9  DOM;
    910
    1011const
    … …  
    4647
    4748  TCellArray = array of TCell;
    48 
    49   { TMap }
    50 
    51   TMap = class
    52 
    53   end;
    5449
    5550  { TView }
    … …  
    8075  end;
    8176
    82   { THexMap }
    83 
    84   THexMap = class(TMap)
     77  { TMap }
     78
     79  TMap = class
    8580  private
    86     FSize: TPoint;
    87     procedure SetSize(AValue: TPoint);
     81    function GetSize: TPoint; virtual;
     82    procedure SetSize(AValue: TPoint); virtual;
    8883  public
    8984    Game: TGame;
    9085    MaxPower: Integer;
    9186    DefaultCellSize: TPoint;
     87    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
     88    function IsValidIndex(Index: TPoint): Boolean; virtual;
     89    procedure Assign(Source: TMap); virtual;
     90    procedure LoadFromFile(FileName: string); virtual;
     91    procedure SaveToFile(FileName: string); virtual;
     92    function PosToCell(Pos: TPoint; View: TView): TCell; virtual;
     93    function CellToPos(Cell: TCell): TPoint; virtual;
     94    procedure Grow(APlayer: TPlayer); virtual;
     95    procedure ComputePlayerStats; virtual;
     96    constructor Create; virtual;
     97    destructor Destroy; override;
     98    function GetCellNeighbours(Cell: TCell): TCellArray; virtual;
     99    procedure Paint(Canvas: TCanvas; View: TView); virtual;
     100    function GetPixelRect: TRect; virtual;
     101    function GetAllCells: TCellArray; virtual;
     102    procedure ForEachCells(Method: TMethod); virtual;
     103    property Size: TPoint read GetSize write SetSize;
     104  end;
     105
     106  { THexMap }
     107
     108  THexMap = class(TMap)
     109  private
     110    FSize: TPoint;
     111    function GetSize: TPoint; override;
     112    procedure SetSize(AValue: TPoint); override;
     113  public
    92114    Cells: array of array of TCell;
    93     function IsValidIndex(Index: TPoint): Boolean;
    94     function GetCellNeighbours(Cell: TCell): TCellArray;
    95     function PosToCell(Pos: TPoint; View: TView): TCell;
    96     function CellToPos(Cell: TCell; View: TView): TPoint;
     115    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
     116    procedure Assign(Source: TMap); virtual;
     117    procedure LoadFromFile(FileName: string); override;
     118    procedure SaveToFile(FileName: string); override;
     119    function IsValidIndex(Index: TPoint): Boolean; override;
     120    function GetCellNeighbours(Cell: TCell): TCellArray; override;
     121    function PosToCell(Pos: TPoint; View: TView): TCell; override;
     122    function CellToPos(Cell: TCell): TPoint; override;
    97123    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
    98     procedure Paint(Canvas: TCanvas; View: TView);
    99     constructor Create;
     124    procedure Paint(Canvas: TCanvas; View: TView); override;
     125    constructor Create; override;
    100126    destructor Destroy; override;
    101     procedure Grow(APlayer: TPlayer);
    102     procedure ComputePlayerStats;
    103     function GetPixelRect: TRect;
     127    function GetAllCells: TCellArray; override;
     128    function GetPixelRect: TRect; override;
     129  end;
     130
     131  { TSquareMap }
     132
     133  TSquareMap = class(TMap)
     134  private
     135    FSize: TPoint;
     136    function GetSize: TPoint; override;
     137    procedure SetSize(AValue: TPoint); override;
     138  public
     139    Cells: array of array of TCell;
     140    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
     141    function IsValidIndex(Index: TPoint): Boolean; override;
     142    function PosToCell(Pos: TPoint; View: TView): TCell; override;
     143    function CellToPos(Cell: TCell): TPoint; override;
     144    function GetCellNeighbours(Cell: TCell): TCellArray; override;
     145    function GetAllCells: TCellArray; override;
     146    function GetPixelRect: TRect; override;
     147    procedure Paint(Canvas: TCanvas; View: TView); override;
     148    constructor Create; override;
     149    destructor Destroy; override;
    104150    property Size: TPoint read FSize write SetSize;
    105151  end;
    106 
    107152
    108153  TPlayerMode = (pmHuman, pmComputer);
    … …  
    162207  TGrowAmount = (gaByOne, gaBySquareRoot);
    163208  TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
     209  TMapType = (mtNone, mtHexagon, mtSquare);
    164210
    165211  TGame = class
    166212  private
     213    FMapType: TMapType;
    167214    FOnMove: TMoveEvent;
    168215    FOnWin: TWinEvent;
    … …  
    171218    procedure MoveAll(Player: TPlayer);
    172219    procedure ClearMovesFromCell(Cell: TCell);
     220    procedure SetMapType(AValue: TMapType);
    173221    procedure SetMove(CellFrom, CellTo: TCell; Power: Integer);
    174222    procedure SetRunning(AValue: Boolean);
    … …  
    176224  public
    177225    Players: TPlayers;
    178     Map: THexMap;
     226    Map: TMap;
    179227    VoidEnabled: Boolean;
    180228    VoidPercentage: Integer;
    … …  
    195243    procedure New;
    196244    property Running: Boolean read FRunning write SetRunning;
     245    property MapType: TMapType read FMapType write SetMapType;
    197246  published
    198247    property OnMove: TMoveEvent read FOnMove write FOnMove;
    … …  
    218267  SHuman = 'Human';
    219268  SComputer = 'Computer';
     269  SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
    220270
    221271procedure InitStrings;
    … …  
    235285  Result := (A.Left = B.Left) and (A.Top = B.Top) and
    236286    (A.Right = B.Right) and (A.Bottom = B.Bottom);
     287end;
     288
     289function PtInRect(const Rect: TRect; Pos: TPoint): Boolean;
     290begin
     291  Result := (Pos.X >= Rect.Left) and (Pos.Y >= Rect.Top) and
     292    (Pos.X <= Rect.Right) and (Pos.Y <= Rect.Bottom);
    237293end;
    238294
    … …  
    244300  Count := Length(Points) ;
    245301  J := Count - 1;
    246   for K := 0 to Count-1 do begin
     302  for K := 0 to Count - 1 do begin
    247303  if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
    248304    ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
    … …  
    257313end;
    258314
    259 function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
     315{ TSquareMap }
     316
     317function TSquareMap.GetSize: TPoint;
     318begin
     319  Result := FSize;
     320end;
     321
     322procedure TSquareMap.SetSize(AValue: TPoint);
     323var
     324  X, Y: Integer;
     325  NewCell: TCell;
     326  C: Integer;
     327begin
     328  if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
     329    // Free previous
     330    for Y := 0 to FSize.Y - 1 do
     331    for X := 0 to FSize.X - 1 do begin
     332      TCell(Cells[Y, X]).Destroy;
     333    end;
     334    FSize := AValue;
     335    // Allocate and init new
     336    SetLength(Cells, FSize.Y, FSize.X);
     337    for Y := 0 to FSize.Y - 1 do
     338    for X := 0 to FSize.X - 1 do begin
     339      NewCell := TCell.Create;
     340      NewCell.Pos := Point(X, Y);
     341      Cells[Y, X] := NewCell;
     342    end;
     343  end;
     344end;
     345
     346function TSquareMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
    260347var
    261348  DX: Integer;
    … …  
    267354  DX := Cell2.Pos.X - Cell1.Pos.X;
    268355  DY := Cell2.Pos.Y - Cell1.Pos.Y;
    269   Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
    270   ((((MinY mod 2) = 1) and
    271     not ((DX = 1) and (DY = -1)) and
    272     not ((DX = -1) and (DY = 1))) or
    273     (((MinY mod 2) = 0) and
    274     not ((DX = -1) and (DY = -1)) and
    275     not ((DX = 1) and (DY = 1))));
     356  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1);
    276357  Result := Result and not (Cell1 = Cell2);
     358end;
     359
     360function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
     361begin
     362  Result := (Index.X >= 0) and (Index.X < Size.X) and
     363    (Index.Y >= 0) and (Index.Y < Size.Y);
     364end;
     365
     366function TSquareMap.PosToCell(Pos: TPoint; View: TView): TCell;
     367var
     368  CX, CY: Integer;
     369  X, Y: Double;
     370  HexSize: TFloatPoint;
     371  CellSize: TFloatPoint;
     372  Frame: TRect;
     373begin
     374  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
     375  Result := nil;
     376  CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     377  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     378  with View do
     379    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
     380    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
     381      X := CX;
     382      Y := CY;
     383      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
     384      if Cells[CY, CX].Terrain <> ttVoid then begin
     385        Frame := Rect(Trunc(X * CellSize.X - HexSize.X / 2),
     386          Trunc(Y * CellSize.Y - HexSize.Y / 2),
     387          Trunc(X * CellSize.X + HexSize.X / 2),
     388          Trunc(Y * CellSize.Y + HexSize.Y / 2));
     389        if PtInRect(Frame, Pos) then begin
     390          Result := Cells[CY, CX];
     391          Exit;
     392        end;
     393      end;
     394    end;
     395end;
     396
     397function TSquareMap.CellToPos(Cell: TCell): TPoint;
     398var
     399  CX, CY: Integer;
     400  X, Y: Double;
     401  HexSize: TFloatPoint;
     402  CellSize: TFloatPoint;
     403  Points: array of TPoint;
     404begin
     405  CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     406  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     407  X := Cell.Pos.X;
     408  Y := Cell.Pos.Y;
     409
     410  Result.X := Trunc(X * CellSize.X);
     411  Result.Y := Trunc(Y * CellSize.Y);
     412end;
     413
     414function TSquareMap.GetCellNeighbours(Cell: TCell): TCellArray;
     415var
     416  X, Y: Integer;
     417begin
     418  SetLength(Result, 0);
     419  for Y := -1 to 1 do
     420  for X := -1 to 1 do
     421  if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and
     422  IsCellsNeighbor(Cell, Cells[Cell.Pos.Y + Y, Cell.Pos.X + X]) then begin
     423    SetLength(Result, Length(Result) + 1);
     424    Result[Length(Result) - 1] := Cells[Cell.Pos.Y + Y, Cell.Pos.X + X];
     425  end;
     426end;
     427
     428function TSquareMap.GetAllCells: TCellArray;
     429var
     430  X: Integer;
     431  Y: Integer;
     432  I: Integer;
     433begin
     434  SetLength(Result, Size.Y * Size.X);
     435  for Y := 0 to Size.Y - 1 do
     436  for X := 0 to Size.X - 1 do
     437    Result[Y * Size.X + X] := Cells[Y, X];
     438end;
     439
     440function TSquareMap.GetPixelRect: TRect;
     441begin
     442  Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
     443    Trunc(-0.5 * DefaultCellSize.Y),
     444    Trunc((Size.X + 0.5) * DefaultCellSize.X),
     445    Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
     446end;
     447
     448procedure TSquareMap.Paint(Canvas: TCanvas; View: TView);
     449var
     450  CX, CY: Integer;
     451  X, Y: Double;
     452  CellSizeZoomed: TFloatPoint;
     453  CellSize: TFloatPoint;
     454  HexSize: TFloatPoint;
     455  I: Integer;
     456  Points: array of TPoint;
     457  Cell: TCell;
     458  PosFrom, PosTo: TPoint;
     459
     460procedure PaintHexagon(Pos: TPoint; Text: string);
     461begin
     462  with Canvas do begin
     463    if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin
     464      Pen.Color := clYellow;
     465      Pen.Style := psSolid;
     466      Pen.Width := 1;
     467    end else
     468    if TCell(Cells[CY, CX]).Terrain = ttCity then begin
     469      // Cannot set clear border as it will display shifted on gtk2
     470      //Pen.Style := psClear;
     471      Pen.Color := clBlack;
     472      Pen.Style := psSolid;
     473      Pen.Width := 3;
     474    end else begin
     475      // Cannot set clear border as it will display shifted on gtk2
     476      //Pen.Style := psClear;
     477      Pen.Color := Brush.Color;
     478      Pen.Style := psSolid;
     479      Pen.Width := 0;
     480    end;
     481    FillRect(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
     482    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
     483    Pen.Style := psSolid;
     484    Font.Color := clWhite;
     485    Font.Size := Trunc(12 * View.Zoom);
     486    TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
     487  end;
     488end;
     489
     490begin
     491  CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     492  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
     493  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
     494  with Canvas, View do try
     495    Lock;
     496    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
     497    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
     498      X := CX;
     499      Y := CY;
     500      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
     501        Cell := Cells[CY, CX];
     502        if Cell.Terrain <> ttVoid then begin
     503          if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY, CX])) then Brush.Color := clGreen
     504            else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY, CX])) then Brush.Color := clPurple
     505            else Brush.Color := Cell.GetColor;
     506          Pen.Color := clBlack;
     507          PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
     508            Trunc(Y * CellSize.Y))),
     509            IntToStr(Cell.GetAvialPower));
     510          // Draw arrows
     511          Pen.Color := clCream;
     512          for I := 0 to Cell.MovesFrom.Count - 1 do begin
     513            PosFrom := CellToPos(Cell);
     514            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
     515            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
     516              else Pen.Width := 1;
     517            Line(View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
     518              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4))),
     519              View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
     520              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2))));
     521            Pen.Width := 1;
     522          end;
     523        end;
     524      end;
     525    end;
     526  finally
     527    Unlock;
     528  end;
     529end;
     530
     531constructor TSquareMap.Create;
     532begin
     533  inherited;
     534end;
     535
     536destructor TSquareMap.Destroy;
     537begin
     538  inherited Destroy;
     539end;
     540
     541{ TMap }
     542
     543function TMap.GetSize: TPoint;
     544begin
     545  Result:= Point(0, 0);
     546end;
     547
     548procedure TMap.SetSize(AValue: TPoint);
     549begin
     550
     551end;
     552
     553function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
     554begin
     555  Result := False;
     556end;
     557
     558function TMap.IsValidIndex(Index: TPoint): Boolean;
     559begin
     560  Result := False;
     561end;
     562
     563procedure TMap.Assign(Source: TMap);
     564begin
     565  MaxPower := Source.MaxPower;
     566  Game := Source.Game;
     567  Size := Source.Size;
     568  DefaultCellSize := Source.DefaultCellSize;
     569end;
     570
     571procedure TMap.LoadFromFile(FileName: string);
     572begin
     573
     574end;
     575
     576procedure TMap.SaveToFile(FileName: string);
     577begin
     578
     579end;
     580
     581function TMap.PosToCell(Pos: TPoint; View: TView): TCell;
     582begin
     583  Result := nil;
     584end;
     585
     586function TMap.CellToPos(Cell: TCell): TPoint;
     587begin
     588  Result := Point(0, 0);
     589end;
     590
     591procedure TMap.Grow(APlayer: TPlayer);
     592var
     593  I: Integer;
     594  Addition: Integer;
     595  Cells: TCellArray;
     596begin
     597  Cells := GetAllCells;
     598  for I := 0 to Length(Cells) - 1 do
     599  with TCell(Cells[I]) do begin
     600    if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
     601    ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
     602      if Game.GrowAmount = gaByOne then Addition := 1
     603        else if Game.GrowAmount = gaBySquareRoot then begin
     604          Addition := Trunc(Sqrt(Power));
     605          if Addition = 0 then Addition := 1;
     606        end;
     607      Power := Power + Addition;
     608      if Power > MaxPower then Power := MaxPower;
     609    end;
     610  end;
     611end;
     612
     613procedure TMap.ComputePlayerStats;
     614var
     615  Cells: TCellArray;
     616  I: Integer;
     617begin
     618  Cells := GetAllCells;
     619  for I := 0 to Length(Cells) - 1 do
     620  with Cells[I] do begin
     621    if Assigned(Player) then begin
     622      Player.TotalCells := Player.TotalCells + 1;
     623      Player.TotalUnits := Player.TotalUnits + Power;
     624    end;
     625  end;
     626end;
     627
     628constructor TMap.Create;
     629begin
     630  MaxPower := 99;
     631  DefaultCellSize := Point(62, 62);
     632end;
     633
     634destructor TMap.Destroy;
     635begin
     636  Size := Point(0, 0);
     637  inherited Destroy;
     638end;
     639
     640function TMap.GetCellNeighbours(Cell: TCell): TCellArray;
     641begin
     642
     643end;
     644
     645procedure TMap.Paint(Canvas: TCanvas; View: TView);
     646begin
     647
     648end;
     649
     650function TMap.GetPixelRect: TRect;
     651var
     652  Cells: TCellArray;
     653  I: Integer;
     654  CellPos: TPoint;
     655begin
     656  Result := Rect(0, 0, 0, 0);
     657  // This is generic iterative algorithm to determine map pixel size
     658  Cells := GetAllCells;
     659  for I := 0 to Length(Cells) - 1 do begin
     660    CellPos := CellToPos(Cells[I]);
     661    if I = 0 then Result := Rect(CellPos.X, CellPos.Y, CellPos.X, CellPos.Y)
     662      else begin
     663        if CellPos.X > Result.Right then Result.Right := CellPos.X;
     664        if CellPos.Y > Result.Bottom then Result.Bottom := CellPos.Y;
     665        if CellPos.X < Result.Left then Result.Left := CellPos.X;
     666        if CellPos.Y < Result.Top then  Result.Top := CellPos.Y;
     667      end;
     668  end;
     669end;
     670
     671
     672function TMap.GetAllCells: TCellArray;
     673begin
     674
     675end;
     676
     677procedure TMap.ForEachCells(Method: TMethod);
     678begin
     679
    277680end;
    278681
    … …  
    464867procedure TPlayer.ComputerTurn;
    465868var
     869  AllCells: TCellArray;
    466870  Cells: TCellArray;
    467871  X, Y: Integer;
    … …  
    470874  TotalAttackPower: Integer;
    471875  I: Integer;
     876  C: Integer;
    472877  CanAttack: Integer;
    473878begin
    474   for Y := 0 to Game.Map.Size.Y - 1 do
    475   for X := 0 to Game.Map.Size.X - 1 do
    476   with TCell(Game.Map.Cells[Y, X]) do begin
     879  AllCells := Game.Map.GetAllCells;
     880  for C := 0 to Length(AllCells) - 1 do
     881  with AllCells[C] do begin
    477882    if (Terrain <> ttVoid) and (Player <> Self) then begin
    478883      // Attack to not owned cell yet
    479884      // Count own possible power
    480       Cells := Game.Map.GetCellNeighbours(Game.Map.Cells[Y, X]);
     885      Cells := Game.Map.GetCellNeighbours(AllCells[C]);
    481886      TotalPower := 0;
    482887      for I := 0 to Length(Cells) - 1 do
    … …  
    493898          if Cells[I].GetAvialPower < AttackPower then
    494899            AttackPower := Cells[I].GetAvialPower;
    495           Game.SetMove(Cells[I], Game.Map.Cells[Y, X], AttackPower);
     900          Game.SetMove(Cells[I], AllCells[C], AttackPower);
    496901          TotalAttackPower := TotalAttackPower + AttackPower;
    497902        end;
    … …  
    502907      // We need to move available power to borders to be available for attacks
    503908      // or defense
    504       Cells := Game.Map.GetCellNeighbours(Game.Map.Cells[Y, X]);
     909      Cells := Game.Map.GetCellNeighbours(AllCells[C]);
    505910      CanAttack := 0;
    506911      for I := 0 to Length(Cells) - 1 do
    … …  
    512917        // For simplicty just try to balance inner area cells power
    513918        for I := 0 to Length(Cells) - 1 do
    514         if (Cells[I].Player = Self) and (Cells[I].Power < Game.Map.Cells[Y, X].GetAvialPower) then begin
    515           Game.SetMove(Game.Map.Cells[Y, X], Cells[I], (Game.Map.Cells[Y, X].GetAvialPower - Cells[I].Power) div 2);
     919        if (Cells[I].Player = Self) and (Cells[I].Power < AllCells[C].GetAvialPower) then begin
     920          Game.SetMove(AllCells[C], Cells[I], (AllCells[C].GetAvialPower - Cells[I].Power) div 2);
    516921        end;
    517922      end;
    … …  
    528933  NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self);
    529934  if Assigned(NewSelectedCell) then begin
    530     if Assigned(SelectedCell) and IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
     935    if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
    531936      Game.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power);
    532937      SelectedCell := nil;
    … …  
    6101015  while I < Moves.Count do
    6111016  with TMove(Moves[I]) do begin
     1017  if CountOnce > 0 then begin
    6121018    if CellFrom.Player = Player then begin
    6131019      if CellTo.Player = Player then begin
    … …  
    6331039      CountOnce := 0;
    6341040    end;
     1041    end;
    6351042    Inc(I);
    6361043  end;
    … …  
    6491056  if TMove(Moves[I]).CellFrom = Cell then
    6501057    Moves.Delete(I);
     1058end;
     1059
     1060procedure TGame.SetMapType(AValue: TMapType);
     1061var
     1062  OldMap: TMap;
     1063begin
     1064  if FMapType = AValue then Exit;
     1065  OldMap := Map;
     1066  case AValue of
     1067    mtNone: Map := TMap.Create;
     1068    mtHexagon: Map := THexMap.Create;
     1069    mtSquare: Map := TSquareMap.Create;
     1070  end;
     1071  Map.Assign(OldMap);
     1072  OldMap.Free;
     1073  FMapType := AValue;
    6511074end;
    6521075
    … …  
    7311154begin
    7321155  with Config do begin
     1156    SetValue(Path + '/GridType', Integer(MapType));
    7331157    SetValue(Path + '/VoidEnabled', VoidEnabled);
    7341158    SetValue(Path + '/VoidPercentage', VoidPercentage);
    … …  
    7451169begin
    7461170  with Config do begin
     1171    MapType := TMapType(GetValue(Path + '/GridType', Integer(mtHexagon)));
    7471172    VoidEnabled := GetValue(Path + '/VoidEnabled', True);
    7481173    VoidPercentage := GetValue(Path + '/VoidPercentage', 20);
    … …  
    8091234begin
    8101235  Moves := TObjectList.Create;
    811   Map := THexMap.Create;
     1236  Map := TMap.Create;
    8121237  Players := TPlayers.Create;
    8131238
    … …  
    8481273  StartCell: TCell;
    8491274  Counter: Integer;
     1275  AllCells: TCellArray;
     1276  C: Integer;
    8501277begin
    8511278  TurnCounter := 1;
    8521279  Moves.Clear;
    853   for Y := 0 to Map.Size.Y - 1 do
    854   for X := 0 to Map.Size.X - 1 do
    855   with Map.Cells[Y, X] do begin
     1280  AllCells := Map.GetAllCells;
     1281  for C := 0 to Length(AllCells) - 1 do
     1282  with AllCells[C] do begin
    8561283    if VoidEnabled and (Random < VoidPercentage / 100) then Terrain := ttVoid
    8571284      else begin
    … …  
    8701297      Counter := 0;
    8711298      while not Assigned(StartCell) or Assigned(StartCell.Player) do begin
    872         StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)];
     1299        StartCell := AllCells[Random(Length(AllCells))];
    8731300        Inc(Counter);
    8741301        if Counter > 100 then
    875           raise Exception.Create('Cannot choose start cell for player');
     1302          raise Exception.Create(SCannotSetPlayerStartCells);
    8761303      end;
    8771304      if CityEnabled then StartCell.Terrain := ttCity
    … …  
    9021329end;
    9031330
     1331function THexMap.GetSize: TPoint;
     1332begin
     1333  Result := FSize;
     1334end;
     1335
    9041336procedure THexMap.SetSize(AValue: TPoint);
    9051337var
    … …  
    9241356    end;
    9251357  end;
     1358end;
     1359
     1360function THexMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
     1361var
     1362  DX: Integer;
     1363  DY: Integer;
     1364  MinY: Integer;
     1365begin
     1366  if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y
     1367    else MinY := Cell2.Pos.Y;
     1368  DX := Cell2.Pos.X - Cell1.Pos.X;
     1369  DY := Cell2.Pos.Y - Cell1.Pos.Y;
     1370  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
     1371  ((((MinY mod 2) = 1) and
     1372    not ((DX = 1) and (DY = -1)) and
     1373    not ((DX = -1) and (DY = 1))) or
     1374    (((MinY mod 2) = 0) and
     1375    not ((DX = -1) and (DY = -1)) and
     1376    not ((DX = 1) and (DY = 1))));
     1377  Result := Result and not (Cell1 = Cell2);
     1378end;
     1379
     1380procedure THexMap.Assign(Source: TMap);
     1381begin
     1382end;
     1383
     1384procedure THexMap.LoadFromFile(FileName: string);
     1385var
     1386  Doc: TXMLDocument;
     1387begin
     1388  try
     1389    ReadXMLFile(Doc, FileName);
     1390    if Doc.DocumentElement.TagName <> 'Map' then
     1391      raise Exception.Create('Invalid map format');
     1392  finally
     1393    Doc.Free;
     1394  end;
     1395  inherited LoadFromFile(FileName);
     1396end;
     1397
     1398procedure THexMap.SaveToFile(FileName: string);
     1399var
     1400  Doc: TXMLDocument;
     1401  RootNode: TDOMNode;
     1402begin
     1403  try
     1404    Doc := TXMLDocument.Create;
     1405    RootNode := Doc.CreateElement('Map');
     1406    Doc.Appendchild(RootNode);
     1407    WriteXMLFile(Doc, FileName);
     1408  finally
     1409    Doc.Free;
     1410  end;
     1411  inherited SaveToFile(FileName);
    9261412end;
    9271413
    … …  
    9801466end;
    9811467
    982 function THexMap.CellToPos(Cell: TCell; View: TView): TPoint;
     1468function THexMap.CellToPos(Cell: TCell): TPoint;
    9831469var
    9841470  CX, CY: Integer;
    … …  
    10731559          Pen.Color := clCream;
    10741560          for I := 0 to Cell.MovesFrom.Count - 1 do begin
    1075             PosFrom := CellToPos(Cell, View);
    1076             PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, View);
     1561            PosFrom := CellToPos(Cell);
     1562            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
    10771563            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
    10781564              else Pen.Width := 1;
    … …  
    10931579constructor THexMap.Create;
    10941580begin
    1095   DefaultCellSize := Point(62, 62);
    1096   MaxPower := 99;
     1581  inherited;
    10971582end;
    10981583
    10991584destructor THexMap.Destroy;
    11001585begin
    1101   Size := Point(0, 0);
    11021586  inherited Destroy;
    11031587end;
    11041588
    1105 procedure THexMap.Grow(APlayer: TPlayer);
    1106 var
    1107   X, Y: Integer;
    1108   Addition: Integer;
    1109 begin
     1589function THexMap.GetAllCells: TCellArray;
     1590var
     1591  X: Integer;
     1592  Y: Integer;
     1593  I: Integer;
     1594begin
     1595  SetLength(Result, Size.Y * Size.X);
    11101596  for Y := 0 to Size.Y - 1 do
    11111597  for X := 0 to Size.X - 1 do
    1112   with TCell(Cells[Y, X]) do begin
    1113     if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
    1114     ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
    1115       if Game.GrowAmount = gaByOne then Addition := 1
    1116         else if Game.GrowAmount = gaBySquareRoot then begin
    1117           Addition := Trunc(Sqrt(Power));
    1118           if Addition = 0 then Addition := 1;
    1119         end;
    1120       Power := Power + Addition;
    1121       if Power > MaxPower then Power := MaxPower;
    1122     end;
    1123   end;
    1124 end;
    1125 
    1126 procedure THexMap.ComputePlayerStats;
    1127 var
    1128   X, Y: Integer;
    1129 begin
    1130   for Y := 0 to Size.Y - 1 do
    1131   for X := 0 to Size.X - 1 do
    1132   with Cells[Y, X] do begin
    1133     if Assigned(Player) then begin
    1134       Player.TotalCells := Player.TotalCells + 1;
    1135       Player.TotalUnits := Player.TotalUnits + Power;
    1136     end;
    1137   end;
     1598    Result[Y * Size.X + X] := Cells[Y, X];
    11381599end;
    11391600
Note: See TracChangeset for help on using the changeset viewer.