source: tags/1.0.0/UMap.pas

Last change on this file was 101, checked in by chronos, 11 years ago
  • Modified: Map types moved to UMap unit.
File size: 9.1 KB
Line 
1unit UMap;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, UGame, XMLConf, XMLRead, XMLWrite, DOM;
9
10type
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
55implementation
56
57{ THexMap }
58
59function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
60var
61 Shift: TFloatPoint;
62begin
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));
71end;
72
73function THexMap.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
74var
75 DX: Integer;
76 DY: Integer;
77 MinY: Integer;
78begin
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));
91end;
92
93procedure THexMap.LoadFromFile(FileName: string);
94var
95 Doc: TXMLDocument;
96begin
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);
105end;
106
107procedure THexMap.SaveToFile(FileName: string);
108var
109 Doc: TXMLDocument;
110 RootNode: TDOMNode;
111begin
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);
121end;
122
123function THexMap.IsValidIndex(Index: TPoint): Boolean;
124begin
125 Result := (Index.X >= 0) and (Index.X < Size.X) and
126 (Index.Y >= 0) and (Index.Y < Size.Y);
127end;
128
129procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
130var
131 X, Y: Integer;
132begin
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;
140end;
141
142procedure THexMap.Generate;
143var
144 X, Y: Integer;
145 I: Integer;
146 NewCell: TCell;
147 PX, PY: Double;
148begin
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;
178end;
179
180
181{ TSquareMap }
182
183procedure TSquareMap.Generate;
184var
185 X, Y: Integer;
186 NewCell: TCell;
187begin
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;
217end;
218
219function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
220begin
221 Result := (Index.X >= 0) and (Index.X < Size.X) and
222 (Index.Y >= 0) and (Index.Y < Size.Y);
223end;
224
225function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPointArray;
226begin
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));
232end;
233
234{ TVoronoiMap }
235
236function TVoronoiMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
237 Reverse: Boolean): TPointArray;
238begin
239
240end;
241
242procedure TVoronoiMap.Generate;
243var
244 X, Y: Integer;
245 I, J, PI: Integer;
246 V, VN: Integer;
247 NewCell: TCell;
248 Pos: TPoint;
249begin
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;
266end;
267
268{ TTriangleMap }
269
270function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
271 Reverse: Boolean): TPointArray;
272var
273 Rev: Integer;
274begin
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));
281end;
282
283function TTriangleMap.IsValidIndex(Index: TPoint): Boolean;
284begin
285 Result := (Index.X >= 0) and (Index.X < Size.X) and
286 (Index.Y >= 0) and (Index.Y < Size.Y);
287end;
288
289procedure TTriangleMap.Generate;
290var
291 X, Y: Integer;
292 Rev: Integer;
293 Reverse: Boolean;
294 NewCell: TCell;
295begin
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;
328end;
329
330
331end.
332
Note: See TracBrowser for help on using the repository browser.