1 | unit UMap;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, UGame, XMLConf, XMLRead, XMLWrite, DOM;
|
---|
9 |
|
---|
10 | type
|
---|
11 | { THexMap }
|
---|
12 |
|
---|
13 | THexMap = class(TMap)
|
---|
14 | private
|
---|
15 | function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
|
---|
16 | procedure GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
|
---|
17 | function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
|
---|
18 | public
|
---|
19 | procedure LoadFromFile(FileName: string); override;
|
---|
20 | procedure SaveToFile(FileName: string); override;
|
---|
21 | function IsValidIndex(Index: TPoint): Boolean; override;
|
---|
22 | procedure Generate; override;
|
---|
23 | end;
|
---|
24 |
|
---|
25 | { TSquareMap }
|
---|
26 |
|
---|
27 | TSquareMap = class(TMap)
|
---|
28 | private
|
---|
29 | function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
|
---|
30 | public
|
---|
31 | function IsValidIndex(Index: TPoint): Boolean; override;
|
---|
32 | procedure Generate; override;
|
---|
33 | end;
|
---|
34 |
|
---|
35 | { TTriangleMap }
|
---|
36 |
|
---|
37 | TTriangleMap = class(TMap)
|
---|
38 | private
|
---|
39 | function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;
|
---|
40 | public
|
---|
41 | function IsValidIndex(Index: TPoint): Boolean; override;
|
---|
42 | procedure Generate; override;
|
---|
43 | end;
|
---|
44 |
|
---|
45 | { TVoronoiMap }
|
---|
46 |
|
---|
47 | TVoronoiMap = class(TMap)
|
---|
48 | private
|
---|
49 | function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;
|
---|
50 | public
|
---|
51 | procedure Generate; override;
|
---|
52 | end;
|
---|
53 |
|
---|
54 |
|
---|
55 | implementation
|
---|
56 |
|
---|
57 | { THexMap }
|
---|
58 |
|
---|
59 | function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
|
---|
60 | var
|
---|
61 | Shift: TFloatPoint;
|
---|
62 | begin
|
---|
63 | Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
|
---|
64 | SetLength(Result, 6);
|
---|
65 | Result[0] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
|
---|
66 | Result[1] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
|
---|
67 | Result[2] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
|
---|
68 | Result[3] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
|
---|
69 | Result[4] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
|
---|
70 | Result[5] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
|
---|
71 | end;
|
---|
72 |
|
---|
73 | function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
|
---|
74 | var
|
---|
75 | DX: Integer;
|
---|
76 | DY: Integer;
|
---|
77 | MinY: Integer;
|
---|
78 | begin
|
---|
79 | if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
|
---|
80 | else MinY := CellPos2.Y;
|
---|
81 | DX := CellPos2.X - CellPos1.X;
|
---|
82 | DY := CellPos2.Y - CellPos1.Y;
|
---|
83 | Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
|
---|
84 | ((((MinY mod 2) = 1) and
|
---|
85 | not ((DX = 1) and (DY = -1)) and
|
---|
86 | not ((DX = -1) and (DY = 1))) or
|
---|
87 | (((MinY mod 2) = 0) and
|
---|
88 | not ((DX = -1) and (DY = -1)) and
|
---|
89 | not ((DX = 1) and (DY = 1))));
|
---|
90 | Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
|
---|
91 | end;
|
---|
92 |
|
---|
93 | procedure THexMap.LoadFromFile(FileName: string);
|
---|
94 | var
|
---|
95 | Doc: TXMLDocument;
|
---|
96 | begin
|
---|
97 | try
|
---|
98 | ReadXMLFile(Doc, FileName);
|
---|
99 | if Doc.DocumentElement.TagName <> 'Map' then
|
---|
100 | raise Exception.Create('Invalid map format');
|
---|
101 | finally
|
---|
102 | Doc.Free;
|
---|
103 | end;
|
---|
104 | inherited LoadFromFile(FileName);
|
---|
105 | end;
|
---|
106 |
|
---|
107 | procedure THexMap.SaveToFile(FileName: string);
|
---|
108 | var
|
---|
109 | Doc: TXMLDocument;
|
---|
110 | RootNode: TDOMNode;
|
---|
111 | begin
|
---|
112 | try
|
---|
113 | Doc := TXMLDocument.Create;
|
---|
114 | RootNode := Doc.CreateElement('Map');
|
---|
115 | Doc.Appendchild(RootNode);
|
---|
116 | WriteXMLFile(Doc, FileName);
|
---|
117 | finally
|
---|
118 | Doc.Free;
|
---|
119 | end;
|
---|
120 | inherited SaveToFile(FileName);
|
---|
121 | end;
|
---|
122 |
|
---|
123 | function THexMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
124 | begin
|
---|
125 | Result := (Index.X >= 0) and (Index.X < Size.X) and
|
---|
126 | (Index.Y >= 0) and (Index.Y < Size.Y);
|
---|
127 | end;
|
---|
128 |
|
---|
129 | procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
|
---|
130 | var
|
---|
131 | X, Y: Integer;
|
---|
132 | begin
|
---|
133 | Neighbours.Count := 0;
|
---|
134 | for Y := -1 to 1 do
|
---|
135 | for X := -1 to 1 do
|
---|
136 | if IsValidIndex(Point(CellPos.X + X, CellPos.Y + Y)) and
|
---|
137 | IsCellsPosNeighbor(CellPos, Point((CellPos.X + X), (CellPos.Y + Y))) then begin
|
---|
138 | Neighbours.Add(TCell(Cells[(CellPos.Y + Y) * Size.X + (CellPos.X + X)]));
|
---|
139 | end;
|
---|
140 | end;
|
---|
141 |
|
---|
142 | procedure THexMap.Generate;
|
---|
143 | var
|
---|
144 | X, Y: Integer;
|
---|
145 | I: Integer;
|
---|
146 | NewCell: TCell;
|
---|
147 | PX, PY: Double;
|
---|
148 | begin
|
---|
149 | // Free previous
|
---|
150 | Cells.Count := 0;
|
---|
151 | FNewCellId := 1;
|
---|
152 |
|
---|
153 | // Allocate and init new
|
---|
154 | Cells.Count := Size.Y * Size.X;
|
---|
155 | for Y := 0 to Size.Y - 1 do
|
---|
156 | for X := 0 to Size.X - 1 do begin
|
---|
157 | NewCell := TCell.Create;
|
---|
158 | NewCell.Map := Self;
|
---|
159 | PX := X;
|
---|
160 | PY := Y;
|
---|
161 | if (Y and 1) = 1 then begin
|
---|
162 | PX := PX + 0.5;
|
---|
163 | //Y := Y + 0.5;
|
---|
164 | end;
|
---|
165 | NewCell.PosPx := Point(Trunc(PX * DefaultCellSize.X / HexCellMulX),
|
---|
166 | Trunc(PY * DefaultCellSize.Y / HexCellMulY));
|
---|
167 | NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
|
---|
168 | NewCell.Id := GetNewCellId;
|
---|
169 | Cells[Y * Size.X + X] := NewCell;
|
---|
170 | end;
|
---|
171 |
|
---|
172 | // Generate neightbours
|
---|
173 | for Y := 0 to Size.Y - 1 do
|
---|
174 | for X := 0 to Size.X - 1 do
|
---|
175 | with TCell(Cells[Y * Size.X + X]) do begin
|
---|
176 | GetCellPosNeighbors(Point(X, Y), Neighbors);
|
---|
177 | end;
|
---|
178 | end;
|
---|
179 |
|
---|
180 |
|
---|
181 | { TSquareMap }
|
---|
182 |
|
---|
183 | procedure TSquareMap.Generate;
|
---|
184 | var
|
---|
185 | X, Y: Integer;
|
---|
186 | NewCell: TCell;
|
---|
187 | begin
|
---|
188 | // Free previous
|
---|
189 | Cells.Count := 0;
|
---|
190 | FNewCellId := 1;
|
---|
191 | // Allocate and init new
|
---|
192 | Cells.Count := Size.Y * Size.X;
|
---|
193 | for Y := 0 to Size.Y - 1 do
|
---|
194 | for X := 0 to Size.X - 1 do begin
|
---|
195 | NewCell := TCell.Create;
|
---|
196 | NewCell.Map := Self;
|
---|
197 | NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * SquareCellMulX),
|
---|
198 | Trunc(Y * DefaultCellSize.Y * SquareCellMulY));
|
---|
199 | NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize);
|
---|
200 | NewCell.Id := GetNewCellId;
|
---|
201 | Cells[Y * Size.X + X] := NewCell;
|
---|
202 | end;
|
---|
203 |
|
---|
204 | // Generate neighbours
|
---|
205 | for Y := 0 to Size.Y - 1 do
|
---|
206 | for X := 0 to Size.X - 1 do
|
---|
207 | with TCell(Cells[Y * Size.X + X]) do begin
|
---|
208 | if IsValidIndex(Point(X + 1, Y + 0)) then
|
---|
209 | Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
|
---|
210 | if IsValidIndex(Point(X + 0, Y + 1)) then
|
---|
211 | Neighbors.Add(TCell(Cells[(Y + 1) * Size.X + (X + 0)]));
|
---|
212 | if IsValidIndex(Point(X - 1, Y + 0)) then
|
---|
213 | Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
|
---|
214 | if IsValidIndex(Point(X + 0, Y - 1)) then
|
---|
215 | Neighbors.Add(TCell(Cells[(Y - 1) * Size.X + (X + 0)]));
|
---|
216 | end;
|
---|
217 | end;
|
---|
218 |
|
---|
219 | function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
220 | begin
|
---|
221 | Result := (Index.X >= 0) and (Index.X < Size.X) and
|
---|
222 | (Index.Y >= 0) and (Index.Y < Size.Y);
|
---|
223 | end;
|
---|
224 |
|
---|
225 | function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
|
---|
226 | begin
|
---|
227 | SetLength(Result, 4);
|
---|
228 | Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
|
---|
229 | Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
|
---|
230 | Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
|
---|
231 | Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
|
---|
232 | end;
|
---|
233 |
|
---|
234 | { TVoronoiMap }
|
---|
235 |
|
---|
236 | function TVoronoiMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
|
---|
237 | Reverse: Boolean): TPointArray;
|
---|
238 | begin
|
---|
239 |
|
---|
240 | end;
|
---|
241 |
|
---|
242 | procedure TVoronoiMap.Generate;
|
---|
243 | var
|
---|
244 | X, Y: Integer;
|
---|
245 | I, J, PI: Integer;
|
---|
246 | V, VN: Integer;
|
---|
247 | NewCell: TCell;
|
---|
248 | Pos: TPoint;
|
---|
249 | begin
|
---|
250 | // Free previous
|
---|
251 | Cells.Count := 0;
|
---|
252 | FNewCellId := 1;
|
---|
253 | // Allocate and init new
|
---|
254 | Cells.Count := Size.Y * Size.X;
|
---|
255 | for Y := 0 to Size.Y - 1 do
|
---|
256 | for X := 0 to Size.X - 1 do begin
|
---|
257 | NewCell := TCell.Create;
|
---|
258 | NewCell.Map := Self;
|
---|
259 | NewCell.PosPx := Point(Trunc(Random * Size.X * DefaultCellSize.X),
|
---|
260 | Trunc(Random * Size.Y * DefaultCellSize.Y));
|
---|
261 | SetLength(NewCell.Polygon, 1);
|
---|
262 | NewCell.Polygon[0] := NewCell.PosPx;
|
---|
263 | NewCell.Id := GetNewCellId;
|
---|
264 | Cells[Y * Size.X + X] := NewCell;
|
---|
265 | end;
|
---|
266 | end;
|
---|
267 |
|
---|
268 | { TTriangleMap }
|
---|
269 |
|
---|
270 | function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
|
---|
271 | Reverse: Boolean): TPointArray;
|
---|
272 | var
|
---|
273 | Rev: Integer;
|
---|
274 | begin
|
---|
275 | if Reverse then Rev := -1
|
---|
276 | else Rev := 1;
|
---|
277 | SetLength(Result, 3);
|
---|
278 | Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
|
---|
279 | Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
|
---|
280 | Result[2] := Point(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev));
|
---|
281 | end;
|
---|
282 |
|
---|
283 | function TTriangleMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
284 | begin
|
---|
285 | Result := (Index.X >= 0) and (Index.X < Size.X) and
|
---|
286 | (Index.Y >= 0) and (Index.Y < Size.Y);
|
---|
287 | end;
|
---|
288 |
|
---|
289 | procedure TTriangleMap.Generate;
|
---|
290 | var
|
---|
291 | X, Y: Integer;
|
---|
292 | Rev: Integer;
|
---|
293 | Reverse: Boolean;
|
---|
294 | NewCell: TCell;
|
---|
295 | begin
|
---|
296 | // Free previous
|
---|
297 | Cells.Count := 0;
|
---|
298 | FNewCellId := 1;
|
---|
299 | // Allocate and init new
|
---|
300 | Cells.Count := Size.Y * Size.X;
|
---|
301 | for Y := 0 to Size.Y - 1 do
|
---|
302 | for X := 0 to Size.X - 1 do begin
|
---|
303 | NewCell := TCell.Create;
|
---|
304 | NewCell.Map := Self;
|
---|
305 | Reverse := Boolean(X mod 2) xor Boolean(Y mod 2);
|
---|
306 | if Reverse then Rev := -1
|
---|
307 | else Rev := 1;
|
---|
308 | NewCell.PosPx := Point(Trunc(X * DefaultCellSize.X * TriangleCellMulX),
|
---|
309 | Trunc((Y * DefaultCellSize.Y * TriangleCellMulY) - (0.1 * Rev * DefaultCellSize.Y)));
|
---|
310 | NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse);
|
---|
311 | NewCell.Id := GetNewCellId;
|
---|
312 | Cells[Y * Size.X + X] := NewCell;
|
---|
313 | end;
|
---|
314 |
|
---|
315 | // Generate neighbours
|
---|
316 | for Y := 0 to Self.Size.Y - 1 do
|
---|
317 | for X := 0 to Size.X - 1 do
|
---|
318 | with TCell(Cells[Y * Size.X + X]) do begin
|
---|
319 | if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1
|
---|
320 | else Rev := 1;
|
---|
321 | if IsValidIndex(Point(X + 1, Y + 0)) then
|
---|
322 | Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
|
---|
323 | if IsValidIndex(Point(X + 0, Y - 1 * Rev)) then
|
---|
324 | Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * Size.X + (X + 0)]));
|
---|
325 | if IsValidIndex(Point(X - 1, Y + 0)) then
|
---|
326 | Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
|
---|
327 | end;
|
---|
328 | end;
|
---|
329 |
|
---|
330 |
|
---|
331 | end.
|
---|
332 |
|
---|