close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

Changeset 102


Ignore:
Timestamp:
Dec 26, 2014, 8:30:25 PM (9 years ago)
Author:
chronos
Message:
  • Added: Load/save map cell links points in game save file.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormNew.pas

    r100 r102  
    326326var
    327327  I: Integer;
    328   NewItem: TListItem;
    329328begin
    330329  CheckBoxSymetricMap.Checked := Game.SymetricMap;
  • trunk/UGame.pas

    r100 r102  
    8787  end;
    8888
     89  { TCellLink }
     90
    8991  TCellLink = class
    9092    Points: array of TPoint;
    9193    Cell1: TCell;
    9294    Cell2: TCell;
    93   end;
     95    procedure LoadFromNode(Node: TDOMNode);
     96    procedure SaveToNode(Node: TDOMNode);
     97  end;
     98
     99  { TCellLinks }
    94100
    95101  TCellLinks = class(TObjectList)
    96 
     102    Map: TMap;
     103    procedure LoadFromNode(Node: TDOMNode);
     104    procedure SaveToNode(Node: TDOMNode);
    97105  end;
    98106
     
    154162  private
    155163    FSize: TPoint;
    156     FNewCellId: Integer;
    157164    function GetSize: TPoint; virtual;
    158165    procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
     
    161168      Text: string);
    162169    procedure SetSize(AValue: TPoint); virtual;
     170  protected
     171    FNewCellId: Integer;
    163172    function GetNewCellId: Integer; virtual;
    164173  public
     
    190199    procedure ForEachCells(Method: TMethod); virtual;
    191200    property Size: TPoint read GetSize write SetSize;
    192   end;
    193 
    194   { THexMap }
    195 
    196   THexMap = class(TMap)
    197   private
    198     function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    199     procedure GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
    200     function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
    201   public
    202     procedure LoadFromFile(FileName: string); override;
    203     procedure SaveToFile(FileName: string); override;
    204     function IsValidIndex(Index: TPoint): Boolean; override;
    205     procedure Generate; override;
    206   end;
    207 
    208   { TSquareMap }
    209 
    210   TSquareMap = class(TMap)
    211   private
    212     function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
    213   public
    214     function IsValidIndex(Index: TPoint): Boolean; override;
    215     procedure Generate; override;
    216   end;
    217 
    218   { TTriangleMap }
    219 
    220   TTriangleMap = class(TMap)
    221   private
    222     function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;
    223   public
    224     function IsValidIndex(Index: TPoint): Boolean; override;
    225     procedure Generate; override;
    226   end;
    227 
    228   { TVoronoiMap }
    229 
    230   TVoronoiMap = class(TMap)
    231   private
    232     function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;
    233   public
    234     procedure Generate; override;
    235201  end;
    236202
     
    457423implementation
    458424
     425uses
     426  UMap;
     427
    459428resourcestring
    460429  SMinimumPlayers = 'You need at least two players';
     
    537506    ((((Color shr 16) and $ff) shr 1) shl 16) or
    538507    ((((Color shr 24) and $ff) shr 0) shl 24);
     508end;
     509
     510{ TCellLink }
     511
     512procedure TCellLink.LoadFromNode(Node: TDOMNode);
     513var
     514  Node2: TDOMNode;
     515  Node3: TDOMNode;
     516begin
     517  Node3 := Node.FindNode('Points');
     518  if Assigned(Node3) then begin
     519    SetLength(Points, 0);
     520    Node2 := Node3.FirstChild;
     521    while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
     522      SetLength(Points, Length(Points) + 1);
     523      Points[High(Points)].X := ReadInteger(Node2, 'X', 0);
     524      Points[High(Points)].Y := ReadInteger(Node2, 'Y', 0);
     525      Node2 := Node2.NextSibling;
     526    end;
     527  end;
     528end;
     529
     530procedure TCellLink.SaveToNode(Node: TDOMNode);
     531var
     532  NewNode: TDOMNode;
     533  NewNode2: TDOMNode;
     534  I: Integer;
     535begin
     536  NewNode := Node.OwnerDocument.CreateElement('Points');
     537  Node.AppendChild(NewNode);
     538  for I := 0 to Length(Points) - 1 do begin
     539    NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
     540    NewNode.AppendChild(NewNode2);
     541    WriteInteger(NewNode2, 'X', Points[I].X);
     542    WriteInteger(NewNode2, 'Y', Points[I].Y);
     543  end;
     544end;
     545
     546{ TCellLinks }
     547
     548procedure TCellLinks.LoadFromNode(Node: TDOMNode);
     549var
     550  Node2: TDOMNode;
     551  NewCell: TCellLink;
     552begin
     553  Count := 0;
     554  Node2 := Node.FirstChild;
     555  while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin
     556    NewCell := TCellLink.Create;
     557    //NewCell.Map := Map;
     558    NewCell.LoadFromNode(Node2);
     559    Add(NewCell);
     560    Node2 := Node2.NextSibling;
     561  end;
     562end;
     563
     564procedure TCellLinks.SaveToNode(Node: TDOMNode);
     565var
     566  I: Integer;
     567  NewNode2: TDOMNode;
     568begin
     569  for I := 0 to Count - 1 do
     570  with TCellLink(Items[I]) do begin
     571    NewNode2 := Node.OwnerDocument.CreateElement('CellLink');
     572    Node.AppendChild(NewNode2);
     573    SaveToNode(NewNode2);
     574  end;
    539575end;
    540576
     
    9761012    TUnitMove(Items[I]).SaveToNode(NewNode);
    9771013  end;
    978 end;
    979 
    980 { TVoronoiMap }
    981 
    982 function TVoronoiMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
    983   Reverse: Boolean): TPointArray;
    984 begin
    985 
    986 end;
    987 
    988 procedure TVoronoiMap.Generate;
    989 var
    990   X, Y: Integer;
    991   I, J, PI: Integer;
    992   V, VN: Integer;
    993   NewCell: TCell;
    994   Pos: TPoint;
    995 begin
    996   // Free previous
    997   Cells.Count := 0;
    998   FNewCellId := 1;
    999   // Allocate and init new
    1000   Cells.Count := FSize.Y * FSize.X;
    1001   for Y := 0 to FSize.Y - 1 do
    1002   for X := 0 to FSize.X - 1 do begin
    1003     NewCell := TCell.Create;
    1004     NewCell.Map := Self;
    1005     NewCell.PosPx := Point(Trunc(Random * FSize.X * DefaultCellSize.X), Trunc(Random * FSize.Y * DefaultCellSize.Y));
    1006     SetLength(NewCell.Polygon, 1);
    1007     NewCell.Polygon[0] := NewCell.PosPx;
    1008     NewCell.Id := GetNewCellId;
    1009     Cells[Y * FSize.X + X] := NewCell;
    1010   end;
    1011 end;
    1012 
    1013 { TTriangleMap }
    1014 
    1015 function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
    1016   Reverse: Boolean): TPointArray;
    1017 var
    1018   Rev: Integer;
    1019 begin
    1020   if Reverse then Rev := -1
    1021     else Rev := 1;
    1022   SetLength(Result, 3);
    1023   Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
    1024   Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
    1025   Result[2] := Point(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev));
    1026 end;
    1027 
    1028 function TTriangleMap.IsValidIndex(Index: TPoint): Boolean;
    1029 begin
    1030   Result := (Index.X >= 0) and (Index.X < Size.X) and
    1031     (Index.Y >= 0) and (Index.Y < Size.Y);
    1032 end;
    1033 
    1034 procedure TTriangleMap.Generate;
    1035 var
    1036   X, Y: Integer;
    1037   Rev: Integer;
    1038   Reverse: Boolean;
    1039   NewCell: TCell;
    1040 begin
    1041   // Free previous
    1042   Cells.Count := 0;
    1043   FNewCellId := 1;
    1044   // Allocate and init new
    1045   Cells.Count := FSize.Y * FSize.X;
    1046   for Y := 0 to FSize.Y - 1 do
    1047   for X := 0 to FSize.X - 1 do begin
    1048     NewCell := TCell.Create;
    1049     NewCell.Map := Self;
    1050     Reverse := Boolean(X mod 2) xor Boolean(Y mod 2);
    1051     if Reverse then Rev := -1
    1052       else Rev := 1;
    1053     NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * TriangleCellMulX),
    1054       Trunc((Y * DefaultCellSize.Y * TriangleCellMulY) - (0.1 * Rev * DefaultCellSize.Y)));
    1055     NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse);
    1056     NewCell.Id := GetNewCellId;
    1057     Cells[Y * FSize.X + X] := NewCell;
    1058   end;
    1059 
    1060   // Generate neighbours
    1061   for Y := 0 to Self.FSize.Y - 1 do
    1062   for X := 0 to FSize.X - 1 do
    1063   with TCell(Cells[Y * FSize.X + X]) do begin
    1064     if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1
    1065       else Rev := 1;
    1066     if IsValidIndex(Point(X + 1, Y + 0)) then
    1067       Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)]));
    1068     if IsValidIndex(Point(X + 0, Y - 1 * Rev)) then
    1069       Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * FSize.X + (X + 0)]));
    1070     if IsValidIndex(Point(X - 1, Y + 0)) then
    1071       Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)]));
    1072   end;
    1073 end;
    1074 
    1075 { TSquareMap }
    1076 
    1077 procedure TSquareMap.Generate;
    1078 var
    1079   X, Y: Integer;
    1080   NewCell: TCell;
    1081 begin
    1082   // Free previous
    1083   Cells.Count := 0;
    1084   FNewCellId := 1;
    1085   // Allocate and init new
    1086   Cells.Count := FSize.Y * FSize.X;
    1087   for Y := 0 to FSize.Y - 1 do
    1088   for X := 0 to FSize.X - 1 do begin
    1089     NewCell := TCell.Create;
    1090     NewCell.Map := Self;
    1091     NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * SquareCellMulX),
    1092       Trunc(Y * DefaultCellSize.Y * SquareCellMulY));
    1093     NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize);
    1094     NewCell.Id := GetNewCellId;
    1095     Cells[Y * FSize.X + X] := NewCell;
    1096   end;
    1097 
    1098   // Generate neighbours
    1099   for Y := 0 to FSize.Y - 1 do
    1100   for X := 0 to FSize.X - 1 do
    1101   with TCell(Cells[Y * FSize.X + X]) do begin
    1102     if IsValidIndex(Point(X + 1, Y + 0)) then
    1103       Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X + 1)]));
    1104     if IsValidIndex(Point(X + 0, Y + 1)) then
    1105       Neighbors.Add(TCell(Cells[(Y + 1) * FSize.X + (X + 0)]));
    1106     if IsValidIndex(Point(X - 1, Y + 0)) then
    1107       Neighbors.Add(TCell(Cells[(Y + 0) * FSize.X + (X - 1)]));
    1108     if IsValidIndex(Point(X + 0, Y - 1)) then
    1109       Neighbors.Add(TCell(Cells[(Y - 1) * FSize.X + (X + 0)]));
    1110   end;
    1111 end;
    1112 
    1113 function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
    1114 begin
    1115   Result := (Index.X >= 0) and (Index.X < Size.X) and
    1116     (Index.Y >= 0) and (Index.Y < Size.Y);
    1117 end;
    1118 
    1119 function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
    1120 begin
    1121   SetLength(Result, 4);
    1122   Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
    1123   Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
    1124   Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
    1125   Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
    11261014end;
    11271015
     
    12631151  if Assigned(Node2) then
    12641152    Cells.LoadFromNode(Node2);
     1153  Node2 := Node.FindNode('CellLinks');
     1154  if Assigned(Node2) then
     1155    CellLinks.LoadFromNode(Node2);
    12651156end;
    12661157
     
    12801171  Node.AppendChild(NewNode);
    12811172  Cells.SaveToNode(NewNode);
     1173  NewNode := Node.OwnerDocument.CreateElement('CellLinks');
     1174  Node.AppendChild(NewNode);
     1175  CellLinks.SaveToNode(NewNode);
    12821176end;
    12831177
     
    14151309  Image := TImage.Create(nil);
    14161310  CellLinks := TCellLinks.Create;
     1311  CellLinks.Map := Self;
    14171312  Areas := TMapAreas.Create;
    14181313end;
     
    29872882end;
    29882883
    2989 { THexMap }
    2990 
    2991 function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
    2992 var
    2993   Shift: TFloatPoint;
    2994 begin
    2995   Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
    2996   SetLength(Result, 6);
    2997   Result[0] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
    2998   Result[1] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
    2999   Result[2] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
    3000   Result[3] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
    3001   Result[4] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
    3002   Result[5] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
    3003 end;
    3004 
    3005 function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    3006 var
    3007   DX: Integer;
    3008   DY: Integer;
    3009   MinY: Integer;
    3010 begin
    3011   if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
    3012     else MinY := CellPos2.Y;
    3013   DX := CellPos2.X - CellPos1.X;
    3014   DY := CellPos2.Y - CellPos1.Y;
    3015   Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
    3016   ((((MinY mod 2) = 1) and
    3017     not ((DX = 1) and (DY = -1)) and
    3018     not ((DX = -1) and (DY = 1))) or
    3019     (((MinY mod 2) = 0) and
    3020     not ((DX = -1) and (DY = -1)) and
    3021     not ((DX = 1) and (DY = 1))));
    3022   Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
    3023 end;
    3024 
    3025 procedure THexMap.LoadFromFile(FileName: string);
    3026 var
    3027   Doc: TXMLDocument;
    3028 begin
    3029   try
    3030     ReadXMLFile(Doc, FileName);
    3031     if Doc.DocumentElement.TagName <> 'Map' then
    3032       raise Exception.Create('Invalid map format');
    3033   finally
    3034     Doc.Free;
    3035   end;
    3036   inherited LoadFromFile(FileName);
    3037 end;
    3038 
    3039 procedure THexMap.SaveToFile(FileName: string);
    3040 var
    3041   Doc: TXMLDocument;
    3042   RootNode: TDOMNode;
    3043 begin
    3044   try
    3045     Doc := TXMLDocument.Create;
    3046     RootNode := Doc.CreateElement('Map');
    3047     Doc.Appendchild(RootNode);
    3048     WriteXMLFile(Doc, FileName);
    3049   finally
    3050     Doc.Free;
    3051   end;
    3052   inherited SaveToFile(FileName);
    3053 end;
    3054 
    3055 function THexMap.IsValidIndex(Index: TPoint): Boolean;
    3056 begin
    3057   Result := (Index.X >= 0) and (Index.X < Size.X) and
    3058     (Index.Y >= 0) and (Index.Y < Size.Y);
    3059 end;
    3060 
    3061 procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
    3062 var
    3063   X, Y: Integer;
    3064 begin
    3065   Neighbours.Count := 0;
    3066   for Y := -1 to 1 do
    3067   for X := -1 to 1 do
    3068   if IsValidIndex(Point(CellPos.X + X, CellPos.Y + Y)) and
    3069   IsCellsPosNeighbor(CellPos, Point((CellPos.X + X), (CellPos.Y + Y))) then begin
    3070     Neighbours.Add(TCell(Cells[(CellPos.Y + Y) * FSize.X + (CellPos.X + X)]));
    3071   end;
    3072 end;
    3073 
    30742884procedure TMap.Paint(Canvas: TCanvas; View: TView);
    30752885var
     
    31342944end;
    31352945
    3136 procedure THexMap.Generate;
    3137 var
    3138   X, Y: Integer;
    3139   I: Integer;
    3140   NewCell: TCell;
    3141   PX, PY: Double;
    3142 begin
    3143   // Free previous
    3144   Cells.Count := 0;
    3145   FNewCellId := 1;
    3146   // Allocate and init new
    3147   Cells.Count := FSize.Y * FSize.X;
    3148   for Y := 0 to FSize.Y - 1 do
    3149   for X := 0 to FSize.X - 1 do begin
    3150     NewCell := TCell.Create;
    3151     NewCell.Map := Self;
    3152     PX := X;
    3153     PY := Y;
    3154     if (Y and 1) = 1 then begin
    3155       PX := PX + 0.5;
    3156       //Y := Y + 0.5;
    3157     end;
    3158     NewCell.PosPx := Point(Trunc(PX * DefaultCellSize.X / HexCellMulX),
    3159       Trunc(PY * DefaultCellSize.Y / HexCellMulY));
    3160     NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
    3161     NewCell.Id := GetNewCellId;
    3162     Cells[Y * FSize.X + X] := NewCell;
    3163   end;
    3164 
    3165   // Generate neightbours
    3166   for Y := 0 to FSize.Y - 1 do
    3167   for X := 0 to FSize.X - 1 do
    3168   with TCell(Cells[Y * FSize.X + X]) do begin
    3169     GetCellPosNeighbors(Point(X, Y), Neighbors);
    3170   end;
    3171 end;
    3172 
    31732946end.
  • trunk/xtactics.lpi

    r98 r102  
    8787      </Item5>
    8888    </RequiredPackages>
    89     <Units Count="10">
     89    <Units Count="11">
    9090      <Unit0>
    9191        <Filename Value="xtactics.lpr"/>
     
    161161        <UnitName Value="UFormHelp"/>
    162162      </Unit9>
     163      <Unit10>
     164        <Filename Value="UMap.pas"/>
     165        <IsPartOfProject Value="True"/>
     166        <UnitName Value="UMap"/>
     167      </Unit10>
    163168    </Units>
    164169  </ProjectOptions>
  • trunk/xtactics.lpr

    r97 r102  
    1212  { you can add units after this },
    1313  SysUtils, UFormSettings, UFormMain, UFormMove, UFormNew, UFormAbout,
    14   UFormHelp;
     14  UFormHelp, UMap;
    1515
    1616{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.