Changeset 281 for trunk


Ignore:
Timestamp:
Feb 21, 2019, 10:45:41 PM (6 years ago)
Author:
chronos
Message:
  • Added: New map type hexagonal horizontal.
  • Added: Limit allowed map type according selected game system.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormNew.lfm

    r279 r281  
    2121    Top = 60
    2222    Width = 806
    23     ActivePage = TabSheetPlayers
     23    ActivePage = TabSheetMap
    2424    Align = alClient
    2525    BorderSpacing.Around = 4
    26     TabIndex = 1
     26    TabIndex = 2
    2727    TabOrder = 0
    2828    OnChange = PageControl1Change
    … …  
    178178      object Panel1: TPanel
    179179        Left = 0
    180         Height = 652
     180        Height = 596
    181181        Top = 0
    182182        Width = 796
    183183        Align = alClient
    184184        BevelOuter = bvNone
    185         ClientHeight = 652
     185        ClientHeight = 596
    186186        ClientWidth = 796
    187187        TabOrder = 0
    … …  
    260260          Height = 38
    261261          Top = 104
    262           Width = 208
     262          Width = 304
    263263          ItemHeight = 0
    264264          Items.Strings = (
    … …  
    277277          Height = 38
    278278          Top = 144
    279           Width = 208
     279          Width = 304
    280280          ItemHeight = 0
    281281          Items.Strings = (
    … …  
    579579          object TabSheetCaptureCells: TTabSheet
    580580            ClientHeight = 74
    581             ClientWidth = 763
     581            ClientWidth = 769
    582582            object Label14: TLabel
    583583              Left = 8
    … …  
    601601          object TabSheetStayAliveTurns: TTabSheet
    602602            ClientHeight = 74
    603             ClientWidth = 763
     603            ClientWidth = 769
    604604            object Label13: TLabel
    605605              Left = 8
    … …  
    701701      Width = 254
    702702      ItemHeight = 0
     703      OnChange = ComboBoxGameSystemChange
    703704      Style = csDropDownList
    704705      TabOrder = 0

  • trunk/Forms/UFormNew.pas

    r279 r281  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    99  ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry, UPlayer,
    10   UGameServer, UServerList, UMap, UFormPlayers;
     10  UGameServer, UServerList, UMap, UFormPlayers, UGameSystem;
    1111
    1212type
    … …  
    111111    procedure CheckBoxSymetricMapChange(Sender: TObject);
    112112    procedure CheckBoxVoidChange(Sender: TObject);
     113    procedure ComboBoxGameSystemChange(Sender: TObject);
    113114    procedure ComboBoxGridTypeChange(Sender: TObject);
    114115    procedure ComboBoxMapShapeChange(Sender: TObject);
    … …  
    143144    NewRandSeed: Cardinal;
    144145    FormPlayers: TFormPlayers;
     146    GameSystem: TGameSystem;
    145147    procedure LoadGame(Game: TGame);
    146148    procedure SaveGame(Game: TGame);
    … …  
    165167
    166168uses
    167   UFormPlayer, UFormChat, UCore, UFormServer, UClientGUI, UFormClient,
    168   UFormGameSystems, UGameSystem;
     169  UFormChat, UCore, UFormServer, UClientGUI, UFormClient,
     170  UFormGameSystems, UMapType;
    169171
    170172resourcestring
    171   SGridTypeHexagon = 'Hexagonal';
    172   SGridTypeSquare = 'Square';
    173   SGridTypeTriangle = 'Triangural';
    174   SGridTypeRandom = 'Random';
    175   SGridTypeIsometric = 'Isometric';
    176173  SWinObjectiveNone = 'None';
    177174  SWinObjectiveDefeatAllOponents = 'Defeat all oponents';
    … …  
    296293    RadioGroupGrowAmount.ItemIndex := Integer(GrowAmount);
    297294    RadioGroupGrowCells.ItemIndex := Integer(GrowCells);
    298     ComboBoxGridType.ItemIndex := Integer(MapType) - 1;
     295    ComboBoxGridType.ItemIndex := ComboBoxGridType.Items.IndexOfObject(TObject(MapType));
    299296    ComboBoxWinObjective.ItemIndex := Integer(WinObjective);
    300297    SpinEditNeutralUnits.Value := MaxNeutralUnits;
    … …  
    325322    GrowAmount := TGrowAmount(RadioGroupGrowAmount.ItemIndex);
    326323    GrowCells := TGrowCells(RadioGroupGrowCells.ItemIndex);
    327     MapType := TMapType(ComboBoxGridType.ItemIndex + 1);
     324    MapType := TMapType(ComboBoxGridType.Items.Objects[ComboBoxGridType.ItemIndex]);
    328325    WinObjective := TWinObjective(ComboBoxWinObjective.ItemIndex);
    329326    MaxNeutralUnits := SpinEditNeutralUnits.Value;
    … …  
    406403    LastIndex := ItemIndex;
    407404    Clear;
    408     Items.Add(SGridTypeHexagon);
    409     Items.Add(SGridTypeSquare);
    410     Items.Add(SGridTypeTriangle);
    411     Items.Add(SGridTypeRandom);
    412     Items.Add(SGridTypeIsometric);
     405    Items.AddObject(SGridTypeHexagonVertical, TObject(mtHexagonVertical));
     406    Items.AddObject(SGridTypeHexagonHorizontal, TObject(mtHexagonHorizontal));
     407    Items.AddObject(SGridTypeSquare, TObject(mtSquare));
     408    Items.AddObject(SGridTypeTriangle, TObject(mtTriangle));
     409    Items.AddObject(SGridTypeRandom, TObject(mtRandom));
     410    Items.AddObject(SGridTypeIsometric, TObject(mtIsometric));
    413411    ItemIndex := LastIndex;
    414412  end;
    … …  
    462460  WinObjective: TWinObjective;
    463461begin
     462  GameSystem := TGameSystem(ComboBoxGameSystem.Items.Objects[ComboBoxGameSystem.ItemIndex]);
     463  ComboBoxGridType.Enabled := GameSystem.PreferedMapType = mtNone;
     464  if GameSystem.PreferedMapType <> mtNone then
     465    ComboBoxGridType.ItemIndex := ComboBoxGridType.Items.IndexOfObject(TObject(GameSystem.PreferedMapType));
    464466  EditImageFile.Enabled := ComboBoxMapShape.ItemIndex = Integer(msImage);
    465467  ButtonImageBrowse.Enabled := ComboBoxMapShape.ItemIndex = Integer(msImage);
    … …  
    544546end;
    545547
     548procedure TFormNew.ComboBoxGameSystemChange(Sender: TObject);
     549begin
     550  UpdateInterface;
     551  MapPreviewRedraw;
     552end;
     553
    546554procedure TFormNew.ComboBoxGridTypeChange(Sender: TObject);
    547555begin

  • trunk/Languages/xtactics.cs.po

    r280 r281  
    10931093msgstr "Obrázek ze souboru"
    10941094
    1095 #: uformnew.sgridtypehexagon
    1096 msgid "Hexagonal"
    1097 msgstr "Hexagonální"
    1098 
    1099 #: uformnew.sgridtypeisometric
    1100 msgid "Isometric"
    1101 msgstr "Izometrická"
    1102 
    1103 #: uformnew.sgridtyperandom
    1104 msgid "Random"
    1105 msgstr "Náhodná"
    1106 
    1107 #: uformnew.sgridtypesquare
    1108 msgid "Square"
    1109 msgstr "Čtvercová"
    1110 
    1111 #: uformnew.sgridtypetriangle
    1112 msgid "Triangural"
    1113 msgstr "Trojúhelníková"
    1114 
    11151095#: uformnew.sgrowamountbyone
    11161096msgid "By one"
    … …  
    12721252msgstr "Není povoleno odečíst sílu pod nulu do záporné hodnoty"
    12731253
     1254#: umaptype.sgridtypehexagonhorizontal
     1255msgid "Hexagonal horizontal"
     1256msgstr "Hexagonální vodorovná"
     1257
     1258#: umaptype.sgridtypehexagonvertical
     1259msgid "Hexagonal vertical"
     1260msgstr "Hexagonální svislá"
     1261
     1262#: umaptype.sgridtypeisometric
     1263msgctxt "umaptype.sgridtypeisometric"
     1264msgid "Isometric"
     1265msgstr "Izometrická"
     1266
     1267#: umaptype.sgridtyperandom
     1268msgctxt "umaptype.sgridtyperandom"
     1269msgid "Random"
     1270msgstr "Náhodná"
     1271
     1272#: umaptype.sgridtypesquare
     1273msgctxt "umaptype.sgridtypesquare"
     1274msgid "Square"
     1275msgstr "Čtvercová"
     1276
     1277#: umaptype.sgridtypetriangle
     1278msgctxt "umaptype.sgridtypetriangle"
     1279msgid "Triangural"
     1280msgstr "Trojúhelníková"
     1281
    12741282#: uplayer.sattackerpowerpositive
    12751283msgctxt "uplayer.sattackerpowerpositive"

  • trunk/Languages/xtactics.po

    r279 r281  
    10691069msgstr ""
    10701070
    1071 #: uformnew.sgridtypehexagon
    1072 msgid "Hexagonal"
    1073 msgstr ""
    1074 
    1075 #: uformnew.sgridtypeisometric
    1076 msgid "Isometric"
    1077 msgstr ""
    1078 
    1079 #: uformnew.sgridtyperandom
    1080 msgid "Random"
    1081 msgstr ""
    1082 
    1083 #: uformnew.sgridtypesquare
    1084 msgid "Square"
    1085 msgstr ""
    1086 
    1087 #: uformnew.sgridtypetriangle
    1088 msgid "Triangural"
    1089 msgstr ""
    1090 
    10911071#: uformnew.sgrowamountbyone
    10921072msgid "By one"
    … …  
    12461226msgstr ""
    12471227
     1228#: umaptype.sgridtypehexagonhorizontal
     1229msgid "Hexagonal horizontal"
     1230msgstr ""
     1231
     1232#: umaptype.sgridtypehexagonvertical
     1233msgid "Hexagonal vertical"
     1234msgstr ""
     1235
     1236#: umaptype.sgridtypeisometric
     1237msgid "Isometric"
     1238msgstr ""
     1239
     1240#: umaptype.sgridtyperandom
     1241msgid "Random"
     1242msgstr ""
     1243
     1244#: umaptype.sgridtypesquare
     1245msgid "Square"
     1246msgstr ""
     1247
     1248#: umaptype.sgridtypetriangle
     1249msgid "Triangural"
     1250msgstr ""
     1251
    12481252#: uplayer.sattackerpowerpositive
    12491253msgid "Attacker power have to be higher then 0."

  • trunk/UCore.pas

    r277 r281  
    125125uses
    126126  UFormMain, UFormNew, UFormSettings, UFormAbout, UClientAI, UFormKeyShortcuts,
    127   UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI;
     127  UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI, UMapType;
    128128
    129129const
    … …  
    514514procedure TCore.InitGameSystems;
    515515begin
    516   with GameSystems.AddNew('HexWars') do begin
     516  with GameSystems.AddNew('Custom') do begin
     517    PreferedMapType := mtNone;
    517518    MaxPlayerCount := 3;
    518519    with UnitKinds.AddNew('Unit') do begin
    … …  
    522523  end;
    523524
    524   with GameSystems.AddNew('Civilization') do begin
     525  with GameSystems.AddNew('HexWars') do begin
     526    PreferedMapType := mtHexagonVertical;
     527    MaxPlayerCount := 3;
     528    with UnitKinds.AddNew('Unit') do begin
     529      Moves := 1;
     530      Power := 99;
     531    end;
     532  end;
     533
     534  with GameSystems.AddNew('Civilization I') do begin
     535    PreferedMapType := mtSquare;
    525536    MaxPlayerCount := 3;
    526537    with UnitKinds.AddNew('Scout') do begin
    … …  
    534545  end;
    535546
     547  with GameSystems.AddNew('Civilization II') do begin
     548    PreferedMapType := mtIsometric;
     549    MaxPlayerCount := 3;
     550    with UnitKinds.AddNew('Scout') do begin
     551      Moves := 1;
     552      Power := 1;
     553    end;
     554    with UnitKinds.AddNew('Settler') do begin
     555      Moves := 1;
     556      Power := 1;
     557    end;
     558  end;
     559
     560  with GameSystems.AddNew('Civilization III') do begin
     561    PreferedMapType := mtIsometric;
     562    MaxPlayerCount := 3;
     563    with UnitKinds.AddNew('Scout') do begin
     564      Moves := 1;
     565      Power := 1;
     566    end;
     567    with UnitKinds.AddNew('Settler') do begin
     568      Moves := 1;
     569      Power := 1;
     570    end;
     571  end;
     572
     573  with GameSystems.AddNew('Civilization IV') do begin
     574    PreferedMapType := mtIsometric;
     575    MaxPlayerCount := 3;
     576    with UnitKinds.AddNew('Scout') do begin
     577      Moves := 1;
     578      Power := 1;
     579    end;
     580    with UnitKinds.AddNew('Settler') do begin
     581      Moves := 1;
     582      Power := 1;
     583    end;
     584  end;
     585
     586  with GameSystems.AddNew('Civilization V') do begin
     587    PreferedMapType := mtHexagonHorizontal;
     588    MaxPlayerCount := 3;
     589    with UnitKinds.AddNew('Scout') do begin
     590      Moves := 1;
     591      Power := 1;
     592    end;
     593    with UnitKinds.AddNew('Settler') do begin
     594      Moves := 1;
     595      Power := 1;
     596    end;
     597  end;
     598
     599  with GameSystems.AddNew('Civilization VI') do begin
     600    PreferedMapType := mtHexagonHorizontal;
     601    MaxPlayerCount := 3;
     602    with UnitKinds.AddNew('Scout') do begin
     603      Moves := 1;
     604      Power := 1;
     605    end;
     606    with UnitKinds.AddNew('Settler') do begin
     607      Moves := 1;
     608      Power := 1;
     609    end;
     610  end;
     611
    536612  with GameSystems.AddNew('Dune 2') do begin
     613    PreferedMapType := mtSquare;
    537614    MaxPlayerCount := 3;
    538615    with UnitKinds.AddNew('Light Infantry') do begin
    … …  
    551628
    552629  with GameSystems.AddNew('Battle Isle 2') do begin
     630    PreferedMapType := mtHexagonHorizontal;
    553631    MaxPlayerCount := 8;
    554632    with UnitKinds.AddNew('Demon 132') do begin
    … …  
    567645      Moves := 10;
    568646      Power := 10;
     647    end;
     648  end;
     649
     650  with GameSystems.AddNew('Panzer General') do begin
     651    PreferedMapType := mtHexagonHorizontal;
     652    MaxPlayerCount := 2;
     653    with UnitKinds.AddNew('Rifle Team') do begin
     654      Moves := 1;
     655    end;
     656    with UnitKinds.AddNew('Machine Gun') do begin
     657      Moves := 1;
     658    end;
     659    with UnitKinds.AddNew('Heavy Infantry') do begin
     660      Moves := 1;
     661    end;
     662    with UnitKinds.AddNew('Granadiers') do begin
     663      Moves := 1;
    569664    end;
    570665  end;

  • trunk/UGame.pas

    r277 r281  
    3030  TGrowAmount = (gaByOne, gaBySquareRoot);
    3131  TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
    32   TMapType = (mtNone, mtHexagon, mtSquare, mtTriangle, mtRandom, mtIsometric);
    3332  TWinObjective = (woNone, woDefeatAllOponents, woDefeatAllOponentsCities,
    3433    woSpecialCaptureCell, woStayAliveForDefinedTurns, woCaptureEntireMap);
    … …  
    268267  case AValue of
    269268    mtNone: Map := TMap.Create;
    270     mtHexagon: Map := THexMap.Create;
     269    mtHexagonVertical: Map := THexMapVertical.Create;
    271270    mtSquare: Map := TSquareMap.Create;
    272271    mtTriangle: Map := TTriangleMap.Create;
    273272    mtRandom: Map := TVoronoiMap.Create;
    274273    mtIsometric: Map := TIsometricMap.Create;
     274    mtHexagonHorizontal: Map := THexMapHorizontal.Create;
    275275    else raise Exception.Create(SUnsupportedMapType);
    276276  end;
    … …  
    537537  with Config do begin
    538538    StoredRandSeed := GetValue(DOMString(Path + '/RandSeed'), 0);
    539     MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon)));
     539    MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagonVertical)));
    540540    Map.Size := TPoint.Create(GetValue(DOMString(Path + '/MapSizeX'), 10),
    541541      GetValue(DOMString(Path + '/MapSizeY'), 10));

  • trunk/UGameSystem.pas

    r277 r281  
    77uses
    88  Classes, SysUtils, fgl, UUnit, DOM, XMLRead, XMLWrite, UXMLUtils, XMLConf,
    9   FileUtil;
     9  FileUtil, UMapType;
    1010
    1111type
    … …  
    2121    EmptyCellsNeutral: Boolean;
    2222    UnitsMoveImmediately: Boolean;
     23    PreferedMapType: TMapType;
    2324    constructor Create;
    2425    destructor Destroy; override;
    … …  
    99100  UnitsSplitMerge := Source.UnitsSplitMerge;
    100101  EmptyCellsNeutral := Source.EmptyCellsNeutral;
     102  PreferedMapType := Source.PreferedMapType;
    101103  UnitKinds.Assign(Source.UnitKinds);
    102104end;
    … …  
    109111  EmptyCellsNeutral := ReadBoolean(Node, 'EmptyCellsNeutral', False);
    110112  UnitsMoveImmediately := ReadBoolean(Node, 'UnitsMoveImmediately', False);
     113  PreferedMapType := TMapType(ReadInteger(Node, 'PreferedMapType', Integer(mtNone)));
    111114
    112115  NewNode := Node.FindNode('UnitKinds');
    … …  
    122125  WriteBoolean(Node, 'EmptyCellsNeutral', EmptyCellsNeutral);
    123126  WriteBoolean(Node, 'UnitsMoveImmediately', UnitsMoveImmediately);
     127  WriteInteger(Node, 'PreferedMapType', Integer(PreferedMapType));
    124128
    125129  NewNode := Node.OwnerDocument.CreateElement('UnitKinds');
    … …  
    171175    EmptyCellsNeutral := GetValue(DOMString(Path + '/EmptyCellsNeutral'), False);
    172176    UnitsMoveImmediately := GetValue(DOMString(Path + '/UnitsMoveImmediately'), False);
     177    PreferedMapType := TMapType(GetValue(DOMString(Path + '/PreferedMapType'), Integer(mtNone)));
    173178  end;
    174179end;
    … …  
    180185    SetValue(DOMString(Path + '/EmptyCellsNeutral'), EmptyCellsNeutral);
    181186    SetValue(DOMString(Path + '/UnitsMoveImmediately'), UnitsMoveImmediately);
     187    SetValue(DOMString(Path + '/PreferedMapType'), Integer(PreferedMapType));
    182188  end;
    183189end;

  • trunk/UMapType.pas

    r268 r281  
    99
    1010type
     11  TMapType = (mtNone, mtHexagonVertical, mtSquare, mtTriangle, mtRandom, mtIsometric,
     12    mtHexagonHorizontal);
     13
    1114  TCellsDistance = class
    1215    Cell1: TCell;
    … …  
    1518  end;
    1619
    17   { THexMap }
    18 
    19   THexMap = class(TMap)
     20  { THexMapVertical }
     21
     22  THexMapVertical = class(TMap)
    2023  private
    2124    const
    … …  
    3437  end;
    3538
     39  { THexMapHorizontal }
     40
     41  THexMapHorizontal = class(TMap)
     42  private
     43    const
     44      CellMulX = 1.292 * 1.03;
     45      CellMulY = 1.12 * 1.028;
     46    function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
     47    procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
     48    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
     49  protected
     50    procedure SetSize(AValue: TPoint); override;
     51  public
     52    function CalculatePixelRect: TRect; override;
     53    procedure LoadFromFile(FileName: string); override;
     54    procedure SaveToFile(FileName: string); override;
     55    procedure Generate; override;
     56  end;
     57
    3658  { TSquareMap }
    3759
    … …  
    82104  end;
    83105
     106resourcestring
     107  SGridTypeHexagonVertical = 'Hexagonal vertical';
     108  SGridTypeHexagonHorizontal = 'Hexagonal horizontal';
     109  SGridTypeSquare = 'Square';
     110  SGridTypeTriangle = 'Triangural';
     111  SGridTypeRandom = 'Random';
     112  SGridTypeIsometric = 'Isometric';
     113
    84114
    85115implementation
    86116
    87 { TIsometricMap }
    88 
    89 function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
    90 begin
    91   SetLength(Result.Points, 4);
    92   Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5));
    93   Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y);
    94   Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5));
    95   Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y);
    96 end;
    97 
    98 procedure TIsometricMap.SetSize(AValue: TPoint);
    99 begin
    100   inherited;
    101   if Cyclic then
    102     FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
    103 end;
    104 
    105 procedure TIsometricMap.Generate;
    106 var
    107   X, Y: Integer;
    108   NewCell: TCell;
    109   PX, PY: Double;
    110   P: TPoint;
    111   Cell: TCell;
    112 begin
    113   Clear;
    114 
    115   // Allocate and init new
    116   Cells.Count := Size.Y * Size.X;
    117   for Y := 0 to Size.Y - 1 do
    118   for X := 0 to Size.X - 1 do begin
    119     NewCell := TCell.Create;
    120     NewCell.Map := Self;
    121     PX := X;
    122     PY := Y;
    123     if (Y and 1) = 1 then begin
    124       PX := PX + 0.5;
    125       //Y := Y + 0.5;
    126     end;
    127     NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
    128       Trunc(PY * DefaultCellSize.Y / CellMulY));
    129     NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize);
    130     NewCell.Id := GetNewCellId;
    131     Cells[Y * Size.X + X] := NewCell;
    132   end;
    133 
    134   // Generate neightbours
    135   for Y := 0 to Size.Y - 1 do
    136   for X := 0 to Size.X - 1 do
    137   with Cells[Y * Size.X + X] do begin
    138     Cell := Cells[Y * Size.X + X];
    139     if Cyclic then begin
    140       P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
    141       P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    142       Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    143       P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
    144       P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    145       Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    146       P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
    147       P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    148       Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    149       P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
    150       P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    151       Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    152     end else begin
    153       P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
    154       if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    155       P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
    156       if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    157       P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
    158       if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    159       P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
    160       if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    161     end;
    162   end;
    163 
    164   FPixelRect := CalculatePixelRect;
    165 end;
    166 
    167 function TIsometricMap.CalculatePixelRect: TRect;
    168 begin
    169   Result := inherited CalculatePixelRect;
    170   Result.P2 := Result.P2 - TPoint.Create(
    171     Trunc(0.5 * DefaultCellSize.X / CellMulX),
    172     Trunc(DefaultCellSize.Y / CellMulY)
    173   );
    174 end;
    175 
    176 { THexMap }
    177 
    178 function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
    179 var
    180   Shift: TPointF;
    181   Angle: Double;
    182 begin
    183   Angle := 30 / 180 * Pi;
    184   Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
    185   SetLength(Result.Points, 6);
    186   Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
    187   Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
    188   Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
    189   Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
    190   Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
    191   Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
    192 end;
    193 
    194 procedure THexMap.SetSize(AValue: TPoint);
    195 begin
    196   inherited;
    197   if Cyclic then
    198     FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
    199 end;
    200 
    201 function THexMap.CalculatePixelRect: TRect;
    202 var
    203   Shift: TPointF;
    204   Angle: Double;
    205 begin
    206   Result := inherited CalculatePixelRect;
    207   Angle := 30 / 180 * Pi;
    208   Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
    209   Result.P2 := Result.P2 - TPoint.Create(
    210     Trunc(0.5 * DefaultCellSize.X / CellMulX),
    211     Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY)
    212   );
    213 end;
    214 
    215 function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
     117{ THexMapHorizontal }
     118
     119function THexMapHorizontal.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint
     120  ): Boolean;
    216121var
    217122  DX: Integer;
    … …  
    233138end;
    234139
    235 procedure THexMap.LoadFromFile(FileName: string);
    236 var
    237   Doc: TXMLDocument;
    238 begin
    239   try
    240     ReadXMLFile(Doc, FileName);
    241     if Doc.DocumentElement.TagName <> 'Map' then
    242       raise Exception.Create('Invalid map format');
    243   finally
    244     Doc.Free;
    245   end;
    246   inherited LoadFromFile(FileName);
    247 end;
    248 
    249 procedure THexMap.SaveToFile(FileName: string);
    250 var
    251   Doc: TXMLDocument;
    252   RootNode: TDOMNode;
    253 begin
    254   try
    255     Doc := TXMLDocument.Create;
    256     RootNode := Doc.CreateElement('Map');
    257     Doc.Appendchild(RootNode);
    258     WriteXMLFile(Doc, FileName);
    259   finally
    260     Doc.Free;
    261   end;
    262   inherited SaveToFile(FileName);
    263 end;
    264 
    265 procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
     140procedure THexMapHorizontal.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
    266141var
    267142  X, Y: Integer;
    … …  
    285160end;
    286161
    287 procedure THexMap.Generate;
     162function THexMapHorizontal.GetHexagonPolygon(Pos: TPoint; Size: TPoint
     163  ): TPolygon;
     164var
     165  Shift: TPointF;
     166  Angle: Double;
     167begin
     168  Angle := 60 / 180 * Pi;
     169  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
     170  SetLength(Result.Points, 6);
     171  Result.Points[0] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
     172  Result.Points[1] := TPoint.Create(Trunc(Pos.X + 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
     173  Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
     174  Result.Points[3] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
     175  Result.Points[4] := TPoint.Create(Trunc(Pos.X - 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
     176  Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
     177end;
     178
     179procedure THexMapHorizontal.SetSize(AValue: TPoint);
     180begin
     181  inherited;
     182  if Cyclic then
     183    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
     184end;
     185
     186function THexMapHorizontal.CalculatePixelRect: TRect;
     187var
     188  Shift: TPointF;
     189  Angle: Double;
     190begin
     191  Result := inherited CalculatePixelRect;
     192  Angle := 60 / 180 * Pi;
     193  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
     194  Result.P2 := Result.P2 - TPoint.Create(
     195    Trunc(1.35 * Shift.X * DefaultCellSize.X / CellMulX),
     196    Trunc(0.5 * DefaultCellSize.Y / CellMulY)
     197  );
     198end;
     199
     200procedure THexMapHorizontal.LoadFromFile(FileName: string);
     201var
     202  Doc: TXMLDocument;
     203begin
     204  try
     205    ReadXMLFile(Doc, FileName);
     206    if Doc.DocumentElement.TagName <> 'Map' then
     207      raise Exception.Create('Invalid map format');
     208  finally
     209    Doc.Free;
     210  end;
     211  inherited LoadFromFile(FileName);
     212end;
     213
     214procedure THexMapHorizontal.SaveToFile(FileName: string);
     215var
     216  Doc: TXMLDocument;
     217  RootNode: TDOMNode;
     218begin
     219  try
     220    Doc := TXMLDocument.Create;
     221    RootNode := Doc.CreateElement('Map');
     222    Doc.Appendchild(RootNode);
     223    WriteXMLFile(Doc, FileName);
     224  finally
     225    Doc.Free;
     226  end;
     227  inherited SaveToFile(FileName);
     228end;
     229
     230procedure THexMapHorizontal.Generate;
    288231var
    289232  X, Y: Integer;
    290233  NewCell: TCell;
    291234  PX, PY: Double;
     235begin
     236  Clear;
     237
     238  // Allocate and init new
     239  Cells.Count := Size.Y * Size.X;
     240  for Y := 0 to Size.Y - 1 do
     241  for X := 0 to Size.X - 1 do begin
     242    NewCell := TCell.Create;
     243    NewCell.Map := Self;
     244    PX := X;
     245    PY := Y;
     246    if (X and 1) = 1 then begin
     247      PY := PY + 0.5;
     248    end;
     249    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
     250      Trunc(PY * DefaultCellSize.Y / CellMulY));
     251    NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
     252    NewCell.Id := GetNewCellId;
     253    Cells[Y * Size.X + X] := NewCell;
     254  end;
     255
     256  // Generate neightbours
     257  for Y := 0 to Size.Y - 1 do
     258  for X := 0 to Size.X - 1 do
     259  with Cells[Y * Size.X + X] do begin
     260    GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]);
     261  end;
     262
     263  FPixelRect := CalculatePixelRect;
     264end;
     265
     266{ TIsometricMap }
     267
     268function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
     269begin
     270  SetLength(Result.Points, 4);
     271  Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5));
     272  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y);
     273  Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5));
     274  Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y);
     275end;
     276
     277procedure TIsometricMap.SetSize(AValue: TPoint);
     278begin
     279  inherited;
     280  if Cyclic then
     281    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
     282end;
     283
     284procedure TIsometricMap.Generate;
     285var
     286  X, Y: Integer;
     287  NewCell: TCell;
     288  PX, PY: Double;
     289  P: TPoint;
     290  Cell: TCell;
    292291begin
    293292  Clear;
    … …  
    304303      PX := PX + 0.5;
    305304      //Y := Y + 0.5;
     305    end;
     306    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
     307      Trunc(PY * DefaultCellSize.Y / CellMulY));
     308    NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize);
     309    NewCell.Id := GetNewCellId;
     310    Cells[Y * Size.X + X] := NewCell;
     311  end;
     312
     313  // Generate neightbours
     314  for Y := 0 to Size.Y - 1 do
     315  for X := 0 to Size.X - 1 do
     316  with Cells[Y * Size.X + X] do begin
     317    Cell := Cells[Y * Size.X + X];
     318    if Cyclic then begin
     319      P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
     320      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
     321      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     322      P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
     323      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
     324      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     325      P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
     326      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
     327      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     328      P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
     329      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
     330      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     331    end else begin
     332      P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
     333      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     334      P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
     335      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     336      P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
     337      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     338      P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
     339      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     340    end;
     341  end;
     342
     343  FPixelRect := CalculatePixelRect;
     344end;
     345
     346function TIsometricMap.CalculatePixelRect: TRect;
     347begin
     348  Result := inherited CalculatePixelRect;
     349  Result.P2 := Result.P2 - TPoint.Create(
     350    Trunc(0.5 * DefaultCellSize.X / CellMulX),
     351    Trunc(DefaultCellSize.Y / CellMulY)
     352  );
     353end;
     354
     355{ THexMapVertical }
     356
     357function THexMapVertical.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
     358var
     359  Shift: TPointF;
     360  Angle: Double;
     361begin
     362  Angle := 30 / 180 * Pi;
     363  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
     364  SetLength(Result.Points, 6);
     365  Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
     366  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
     367  Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
     368  Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
     369  Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
     370  Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
     371end;
     372
     373procedure THexMapVertical.SetSize(AValue: TPoint);
     374begin
     375  inherited;
     376  if Cyclic then
     377    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
     378end;
     379
     380function THexMapVertical.CalculatePixelRect: TRect;
     381var
     382  Shift: TPointF;
     383  Angle: Double;
     384begin
     385  Result := inherited CalculatePixelRect;
     386  Angle := 30 / 180 * Pi;
     387  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
     388  Result.P2 := Result.P2 - TPoint.Create(
     389    Trunc(0.5 * DefaultCellSize.X / CellMulX),
     390    Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY)
     391  );
     392end;
     393
     394function THexMapVertical.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
     395var
     396  DX: Integer;
     397  DY: Integer;
     398  MinY: Integer;
     399begin
     400  if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
     401    else MinY := CellPos2.Y;
     402  DX := CellPos2.X - CellPos1.X;
     403  DY := CellPos2.Y - CellPos1.Y;
     404  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
     405  ((((MinY mod 2) = 1) and
     406    not ((DX = 1) and (DY = -1)) and
     407    not ((DX = -1) and (DY = 1))) or
     408    (((MinY mod 2) = 0) and
     409    not ((DX = -1) and (DY = -1)) and
     410    not ((DX = 1) and (DY = 1))));
     411  Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
     412end;
     413
     414procedure THexMapVertical.LoadFromFile(FileName: string);
     415var
     416  Doc: TXMLDocument;
     417begin
     418  try
     419    ReadXMLFile(Doc, FileName);
     420    if Doc.DocumentElement.TagName <> 'Map' then
     421      raise Exception.Create('Invalid map format');
     422  finally
     423    Doc.Free;
     424  end;
     425  inherited LoadFromFile(FileName);
     426end;
     427
     428procedure THexMapVertical.SaveToFile(FileName: string);
     429var
     430  Doc: TXMLDocument;
     431  RootNode: TDOMNode;
     432begin
     433  try
     434    Doc := TXMLDocument.Create;
     435    RootNode := Doc.CreateElement('Map');
     436    Doc.Appendchild(RootNode);
     437    WriteXMLFile(Doc, FileName);
     438  finally
     439    Doc.Free;
     440  end;
     441  inherited SaveToFile(FileName);
     442end;
     443
     444procedure THexMapVertical.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
     445var
     446  X, Y: Integer;
     447  P: TPoint;
     448  PMod: TPoint;
     449begin
     450  for Y := -1 to 1 do
     451  for X := -1 to 1 do begin
     452    P := TPoint.Create(CellPos.X + X, CellPos.Y + Y);
     453    PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
     454    if Cyclic then begin
     455      if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin
     456        Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]);
     457      end;
     458    end else begin
     459      if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin
     460        Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
     461      end;
     462    end;
     463  end;
     464end;
     465
     466procedure THexMapVertical.Generate;
     467var
     468  X, Y: Integer;
     469  NewCell: TCell;
     470  PX, PY: Double;
     471begin
     472  Clear;
     473
     474  // Allocate and init new
     475  Cells.Count := Size.Y * Size.X;
     476  for Y := 0 to Size.Y - 1 do
     477  for X := 0 to Size.X - 1 do begin
     478    NewCell := TCell.Create;
     479    NewCell.Map := Self;
     480    PX := X;
     481    PY := Y;
     482    if (Y and 1) = 1 then begin
     483      PX := PX + 0.5;
    306484    end;
    307485    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
Note: See TracChangeset for help on using the changeset viewer.