source: trunk/MapType.pas

Last change on this file was 337, checked in by chronos, 14 months ago
  • Added: Game systems action in Tools menu.
  • Modified: TurnStats moved to separate unit.
File size: 22.5 KB
Line 
1unit MapType;
2
3interface
4
5uses
6 Classes, SysUtils, XMLRead, XMLWrite, DOM, Geometry, Map;
7
8type
9 TMapType = (mtNone, mtHexagonVertical, mtSquare, mtTriangle, mtRandom, mtIsometric,
10 mtHexagonHorizontal);
11
12 TCellsDistance = class
13 Cell1: TCell;
14 Cell2: TCell;
15 Distance: Double;
16 end;
17
18 { THexMapVertical }
19
20 THexMapVertical = class(TMap)
21 private
22 const
23 CellMulX = 1.12 * 1.028;
24 CellMulY = 1.292 * 1.03;
25 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
26 procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
27 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
28 protected
29 procedure SetSize(AValue: TPoint); override;
30 public
31 function CalculatePixelRect: TRect; override;
32 procedure LoadFromFile(FileName: string); override;
33 procedure SaveToFile(FileName: string); override;
34 procedure Generate; override;
35 end;
36
37 { THexMapHorizontal }
38
39 THexMapHorizontal = class(TMap)
40 private
41 const
42 CellMulX = 1.292 * 1.03;
43 CellMulY = 1.12 * 1.028;
44 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
45 procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
46 function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
47 protected
48 procedure SetSize(AValue: TPoint); override;
49 public
50 function CalculatePixelRect: TRect; override;
51 procedure LoadFromFile(FileName: string); override;
52 procedure SaveToFile(FileName: string); override;
53 procedure Generate; override;
54 end;
55
56 { TSquareMap }
57
58 TSquareMap = class(TMap)
59 private
60 function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPolygon;
61 public
62 procedure Generate; override;
63 end;
64
65 { TTriangleMap }
66
67 TTriangleMap = class(TMap)
68 private
69 const
70 CellMulX = 0.5;
71 CellMulY = 1;
72 function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPolygon;
73 protected
74 procedure SetSize(AValue: TPoint); override;
75 public
76 procedure Generate; override;
77 function CalculatePixelRect: TRect; override;
78 end;
79
80 { TVoronoiMap }
81
82 TVoronoiMap = class(TMap)
83 public
84 procedure Generate; override;
85 function CalculatePixelRect: TRect; override;
86 end;
87
88 { TIsometricMap }
89
90 TIsometricMap = class(TMap)
91 private
92 const
93 CellMulX = 1;
94 CellMulY = 3.5;
95 function GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
96 protected
97 procedure SetSize(AValue: TPoint); override;
98 public
99 procedure Generate; override;
100 function CalculatePixelRect: TRect; override;
101 end;
102
103resourcestring
104 SGridTypeNone = 'None';
105 SGridTypeHexagonVertical = 'Hexagonal vertical';
106 SGridTypeHexagonHorizontal = 'Hexagonal horizontal';
107 SGridTypeSquare = 'Square';
108 SGridTypeTriangle = 'Triangural';
109 SGridTypeRandom = 'Random';
110 SGridTypeIsometric = 'Isometric';
111
112
113implementation
114
115{ THexMapHorizontal }
116
117function THexMapHorizontal.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint
118 ): Boolean;
119var
120 DX: Integer;
121 DY: Integer;
122 MinY: Integer;
123begin
124 if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
125 else MinY := CellPos2.Y;
126 DX := CellPos2.X - CellPos1.X;
127 DY := CellPos2.Y - CellPos1.Y;
128 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
129 ((((MinY mod 2) = 1) and
130 not ((DX = 1) and (DY = -1)) and
131 not ((DX = -1) and (DY = 1))) or
132 (((MinY mod 2) = 0) and
133 not ((DX = -1) and (DY = -1)) and
134 not ((DX = 1) and (DY = 1))));
135 Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
136end;
137
138procedure THexMapHorizontal.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
139var
140 X, Y: Integer;
141 P: TPoint;
142 PMod: TPoint;
143begin
144 for Y := -1 to 1 do
145 for X := -1 to 1 do begin
146 P := TPoint.Create(CellPos.X + X, CellPos.Y + Y);
147 PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
148 if Cyclic then begin
149 if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin
150 Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]);
151 end;
152 end else begin
153 if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin
154 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
155 end;
156 end;
157 end;
158end;
159
160function THexMapHorizontal.GetHexagonPolygon(Pos: TPoint; Size: TPoint
161 ): TPolygon;
162var
163 Shift: TPointF;
164 Angle: Double;
165begin
166 Angle := 60 / 180 * Pi;
167 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
168 SetLength(Result.Points, 6);
169 Result.Points[0] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
170 Result.Points[1] := TPoint.Create(Trunc(Pos.X + 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
171 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
172 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
173 Result.Points[4] := TPoint.Create(Trunc(Pos.X - 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
174 Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
175end;
176
177procedure THexMapHorizontal.SetSize(AValue: TPoint);
178begin
179 inherited;
180 if Cyclic then
181 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
182end;
183
184function THexMapHorizontal.CalculatePixelRect: TRect;
185var
186 Shift: TPointF;
187 Angle: Double;
188begin
189 Result := inherited;
190 Angle := 60 / 180 * Pi;
191 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
192 Result.P2 := Result.P2 - TPoint.Create(
193 Trunc(1.35 * Shift.X * DefaultCellSize.X / CellMulX),
194 Trunc(0.5 * DefaultCellSize.Y / CellMulY)
195 );
196end;
197
198procedure THexMapHorizontal.LoadFromFile(FileName: string);
199var
200 Doc: TXMLDocument;
201begin
202 try
203 ReadXMLFile(Doc, FileName);
204 if Doc.DocumentElement.TagName <> 'Map' then
205 raise Exception.Create('Invalid map format');
206 finally
207 Doc.Free;
208 end;
209 inherited;
210end;
211
212procedure THexMapHorizontal.SaveToFile(FileName: string);
213var
214 Doc: TXMLDocument;
215 RootNode: TDOMNode;
216begin
217 try
218 Doc := TXMLDocument.Create;
219 RootNode := Doc.CreateElement('Map');
220 Doc.Appendchild(RootNode);
221 WriteXMLFile(Doc, FileName);
222 finally
223 Doc.Free;
224 end;
225 inherited;
226end;
227
228procedure THexMapHorizontal.Generate;
229var
230 X, Y: Integer;
231 NewCell: TCell;
232 PX, PY: Double;
233begin
234 Clear;
235
236 // Allocate and init new
237 Cells.Count := Size.Y * Size.X;
238 for Y := 0 to Size.Y - 1 do
239 for X := 0 to Size.X - 1 do begin
240 NewCell := TCell.Create;
241 NewCell.Map := Self;
242 PX := X;
243 PY := Y;
244 if (X and 1) = 1 then begin
245 PY := PY + 0.5;
246 end;
247 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
248 Trunc(PY * DefaultCellSize.Y / CellMulY));
249 NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
250 NewCell.Id := GetNewCellId;
251 Cells[Y * Size.X + X] := NewCell;
252 end;
253
254 // Generate neightbours
255 for Y := 0 to Size.Y - 1 do
256 for X := 0 to Size.X - 1 do
257 with Cells[Y * Size.X + X] do begin
258 GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]);
259 end;
260
261 FPixelRect := CalculatePixelRect;
262end;
263
264{ TIsometricMap }
265
266function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
267begin
268 SetLength(Result.Points, 4);
269 Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5));
270 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y);
271 Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5));
272 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y);
273end;
274
275procedure TIsometricMap.SetSize(AValue: TPoint);
276begin
277 inherited;
278 if Cyclic then
279 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
280end;
281
282procedure TIsometricMap.Generate;
283var
284 X, Y: Integer;
285 NewCell: TCell;
286 PX, PY: Double;
287 P: TPoint;
288 Cell: TCell;
289begin
290 Clear;
291
292 // Allocate and init new
293 Cells.Count := Size.Y * Size.X;
294 for Y := 0 to Size.Y - 1 do
295 for X := 0 to Size.X - 1 do begin
296 NewCell := TCell.Create;
297 NewCell.Map := Self;
298 PX := X;
299 PY := Y;
300 if (Y and 1) = 1 then begin
301 PX := PX + 0.5;
302 //Y := Y + 0.5;
303 end;
304 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
305 Trunc(PY * DefaultCellSize.Y / CellMulY));
306 NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize);
307 NewCell.Id := GetNewCellId;
308 Cells[Y * Size.X + X] := NewCell;
309 end;
310
311 // Generate neightbours
312 for Y := 0 to Size.Y - 1 do
313 for X := 0 to Size.X - 1 do
314 with Cells[Y * Size.X + X] do begin
315 Cell := Cells[Y * Size.X + X];
316 if Cyclic then begin
317 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
318 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
319 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
320 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
321 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
322 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
323 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
324 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
325 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
326 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
327 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
328 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
329 end else begin
330 P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
331 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
332 P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
333 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
334 P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
335 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
336 P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
337 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
338 end;
339 end;
340
341 FPixelRect := CalculatePixelRect;
342end;
343
344function TIsometricMap.CalculatePixelRect: TRect;
345begin
346 Result := inherited;
347 Result.P2 := Result.P2 - TPoint.Create(
348 Trunc(0.5 * DefaultCellSize.X / CellMulX),
349 Trunc(DefaultCellSize.Y / CellMulY)
350 );
351end;
352
353{ THexMapVertical }
354
355function THexMapVertical.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
356var
357 Shift: TPointF;
358 Angle: Double;
359begin
360 Angle := 30 / 180 * Pi;
361 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
362 SetLength(Result.Points, 6);
363 Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
364 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
365 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
366 Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
367 Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
368 Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
369end;
370
371procedure THexMapVertical.SetSize(AValue: TPoint);
372begin
373 inherited;
374 if Cyclic then
375 FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
376end;
377
378function THexMapVertical.CalculatePixelRect: TRect;
379var
380 Shift: TPointF;
381 Angle: Double;
382begin
383 Result := inherited;
384 Angle := 30 / 180 * Pi;
385 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
386 Result.P2 := Result.P2 - TPoint.Create(
387 Trunc(0.5 * DefaultCellSize.X / CellMulX),
388 Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY)
389 );
390end;
391
392function THexMapVertical.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
393var
394 DX: Integer;
395 DY: Integer;
396 MinY: Integer;
397begin
398 if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
399 else MinY := CellPos2.Y;
400 DX := CellPos2.X - CellPos1.X;
401 DY := CellPos2.Y - CellPos1.Y;
402 Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
403 ((((MinY mod 2) = 1) and
404 not ((DX = 1) and (DY = -1)) and
405 not ((DX = -1) and (DY = 1))) or
406 (((MinY mod 2) = 0) and
407 not ((DX = -1) and (DY = -1)) and
408 not ((DX = 1) and (DY = 1))));
409 Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
410end;
411
412procedure THexMapVertical.LoadFromFile(FileName: string);
413var
414 Doc: TXMLDocument;
415begin
416 try
417 ReadXMLFile(Doc, FileName);
418 if Doc.DocumentElement.TagName <> 'Map' then
419 raise Exception.Create('Invalid map format');
420 finally
421 Doc.Free;
422 end;
423 inherited;
424end;
425
426procedure THexMapVertical.SaveToFile(FileName: string);
427var
428 Doc: TXMLDocument;
429 RootNode: TDOMNode;
430begin
431 try
432 Doc := TXMLDocument.Create;
433 RootNode := Doc.CreateElement('Map');
434 Doc.Appendchild(RootNode);
435 WriteXMLFile(Doc, FileName);
436 finally
437 Doc.Free;
438 end;
439 inherited;
440end;
441
442procedure THexMapVertical.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
443var
444 X, Y: Integer;
445 P: TPoint;
446 PMod: TPoint;
447begin
448 for Y := -1 to 1 do
449 for X := -1 to 1 do begin
450 P := TPoint.Create(CellPos.X + X, CellPos.Y + Y);
451 PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
452 if Cyclic then begin
453 if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin
454 Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]);
455 end;
456 end else begin
457 if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin
458 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
459 end;
460 end;
461 end;
462end;
463
464procedure THexMapVertical.Generate;
465var
466 X, Y: Integer;
467 NewCell: TCell;
468 PX, PY: Double;
469begin
470 Clear;
471
472 // Allocate and init new
473 Cells.Count := Size.Y * Size.X;
474 for Y := 0 to Size.Y - 1 do
475 for X := 0 to Size.X - 1 do begin
476 NewCell := TCell.Create;
477 NewCell.Map := Self;
478 PX := X;
479 PY := Y;
480 if (Y and 1) = 1 then begin
481 PX := PX + 0.5;
482 end;
483 NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
484 Trunc(PY * DefaultCellSize.Y / CellMulY));
485 NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
486 NewCell.Id := GetNewCellId;
487 Cells[Y * Size.X + X] := NewCell;
488 end;
489
490 // Generate neightbours
491 for Y := 0 to Size.Y - 1 do
492 for X := 0 to Size.X - 1 do
493 with Cells[Y * Size.X + X] do begin
494 GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]);
495 end;
496
497 FPixelRect := CalculatePixelRect;
498end;
499
500
501{ TSquareMap }
502
503procedure TSquareMap.Generate;
504var
505 X, Y: Integer;
506 NewCell: TCell;
507 P: TPoint;
508 Cell: TCell;
509begin
510 Clear;
511
512 // Allocate and init new
513 Cells.Count := Size.Y * Size.X;
514 for Y := 0 to Size.Y - 1 do
515 for X := 0 to Size.X - 1 do begin
516 NewCell := TCell.Create;
517 NewCell.Map := Self;
518 NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X),
519 Trunc(Y * DefaultCellSize.Y));
520 NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize);
521 NewCell.Id := GetNewCellId;
522 Cells[Y * Size.X + X] := NewCell;
523 end;
524
525 // Generate neighbours
526 for Y := 0 to Size.Y - 1 do
527 for X := 0 to Size.X - 1 do
528 with Cells[Y * Size.X + X] do begin
529 Cell := Cells[Y * Size.X + X];
530 if Cyclic then begin
531 P := TPoint.Create(X + 1, Y + 0);
532 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
533 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
534 P := TPoint.Create(X + 0, Y + 1);
535 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
536 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
537 P := TPoint.Create(X - 1, Y + 0);
538 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
539 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
540 P := TPoint.Create(X + 0, Y - 1);
541 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
542 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
543 end else begin
544 P := TPoint.Create(X + 1, Y + 0);
545 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
546 P := TPoint.Create(X + 0, Y + 1);
547 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
548 P := TPoint.Create(X - 1, Y + 0);
549 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
550 P := TPoint.Create(X + 0, Y - 1);
551 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
552 end;
553 end;
554
555 FPixelRect := CalculatePixelRect;
556end;
557
558function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPolygon;
559begin
560 SetLength(Result.Points, 4);
561 Result.Points[0] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
562 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
563 Result.Points[2] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
564 Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
565end;
566
567{ TVoronoiMap }
568
569function CompareDistance(const C1, C2: TCellsDistance): Integer;
570begin
571 if C1.Distance > C2.Distance then Result := 1
572 else if C1.Distance < C2.Distance then Result := -1
573 else Result := 0;
574end;
575
576procedure TVoronoiMap.Generate;
577var
578 X, Y: Integer;
579 NewCell: TCell;
580 I, J: Integer;
581 Cell: TCell;
582 Cell2: TCell;
583 L1: TLine;
584 MP: TPoint;
585 LinkLine: TLine;
586 P: TPolygon;
587 AreaSize: TPoint;
588const
589 LinkTolerance = 8;
590begin
591 Clear;
592 //RandSeed := 1234;
593
594 // Allocate and init new cells
595 Cells.Count := Size.Y * Size.X;
596 for Y := 0 to Size.Y - 1 do
597 for X := 0 to Size.X - 1 do begin
598 NewCell := TCell.Create;
599 NewCell.Map := Self;
600 NewCell.PosPx := TPoint.Create(Trunc(Random * Size.X * DefaultCellSize.X),
601 Trunc(Random * Size.Y * DefaultCellSize.Y));
602 SetLength(NewCell.Polygon.Points, 1);
603 NewCell.Polygon.Points[0] := NewCell.PosPx;
604 NewCell.Id := GetNewCellId;
605 Cells[Y * Size.X + X] := NewCell;
606 end;
607
608 AreaSize := TPoint.Create(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);
609
610 // Compute polygon by cutting out map area by all other cells
611 if Cyclic then begin
612 for Cell in Cells do begin
613 Cell.Polygon := TPolygon.Create(TRect.Create(
614 TPoint.Create(-AreaSize.X, -AreaSize.Y),
615 TPoint.Create(2 * AreaSize.X, 2 * AreaSize.Y)));
616 for Y := -1 to 1 do
617 for X := -1 to 1 do
618 for Cell2 in Cells do
619 if Cell2 <> Cell then begin
620 LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx +
621 TPoint.Create(X * AreaSize.X, Y * AreaSize.Y));
622 LinkLine.Distance := LinkLine.Distance;
623 MP := LinkLine.GetMiddle;
624 // Create half plane vector
625 L1 := TLine.Create(MP, TPoint.Create(MP.X + LinkLine.GetSize.X,
626 MP.Y + LinkLine.GetSize.Y));
627
628 Cell.Polygon.CutLine(L1, Cell.PosPx);
629 end;
630 end;
631 end else begin
632 for Cell in Cells do begin
633 Cell.Polygon := TPolygon.Create(TRect.Create(TPoint.Create(0, 0),
634 AreaSize));
635 for Cell2 in Cells do
636 if Cell2 <> Cell then begin
637 LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx);
638 LinkLine.Distance := LinkLine.Distance;
639 MP := LinkLine.GetMiddle;
640 // Create half plane vector
641 L1 := TLine.Create(MP, TPoint.Create(MP.X + LinkLine.GetSize.X,
642 MP.Y + LinkLine.GetSize.Y));
643
644 Cell.Polygon.CutLine(L1, Cell.PosPx);
645 end;
646 end;
647 end;
648
649 // Link all cells with neighboring polygon edges
650 if Cyclic then begin
651 for I := 0 to Cells.Count - 1 do begin
652 for Y := -1 to 1 do
653 for X := -1 to 1 do
654 for J := 0 to Cells.Count - 1 do
655 if J <> I then begin
656 P := Cells[J].Polygon;
657 P.Move(TPoint.Create(X * AreaSize.X, Y * AreaSize.Y));
658 if Cells[I].Polygon.EdgeDistance(P) < LinkTolerance then
659 Cells[I].ConnectTo(Cells[J]);
660 end;
661 end;
662 end else begin
663 for I := 0 to Cells.Count - 1 do begin
664 for J := I + 1 to Cells.Count - 1 do begin
665 if Cells[I].Polygon.EdgeDistance(Cells[J].Polygon) < LinkTolerance then
666 Cells[I].ConnectTo(Cells[J]);
667 end;
668 end;
669 end;
670
671 // Adjust polygon centers
672 for I := 0 to Cells.Count - 1 do begin
673 Cells[I].PosPx := Cells[I].Polygon.GetCenter;
674 end;
675
676 FPixelRect := CalculatePixelRect;
677end;
678
679function TVoronoiMap.CalculatePixelRect: TRect;
680begin
681 Result.P1 := TPoint.Create(0, 0);
682 Result.P2 := TPoint.Create(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);
683end;
684
685{ TTriangleMap }
686
687function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
688 Reverse: Boolean): TPolygon;
689var
690 Rev: Integer;
691begin
692 if Reverse then Rev := -1
693 else Rev := 1;
694 SetLength(Result.Points, 3);
695 Result.Points[0] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
696 Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
697 Result.Points[2] := TPoint.Create(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev));
698end;
699
700procedure TTriangleMap.SetSize(AValue: TPoint);
701begin
702 inherited;
703 if Cyclic then
704 FSize := TPoint.Create(FSize.X + FSize.X mod 2, FSize.Y + FSize.Y mod 2);
705end;
706
707procedure TTriangleMap.Generate;
708var
709 X, Y: Integer;
710 Rev: Integer;
711 Reverse: Boolean;
712 NewCell: TCell;
713 P: TPoint;
714 Cell: TCell;
715begin
716 Clear;
717
718 // Allocate and init new
719 Cells.Count := Size.Y * Size.X;
720 for Y := 0 to Size.Y - 1 do
721 for X := 0 to Size.X - 1 do begin
722 NewCell := TCell.Create;
723 NewCell.Map := Self;
724 Reverse := Boolean(X mod 2) xor Boolean(Y mod 2);
725 if Reverse then Rev := -1
726 else Rev := 1;
727 NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X * CellMulX),
728 Trunc((Y * DefaultCellSize.Y * CellMulY) - (0.1 * Rev * DefaultCellSize.Y)));
729 NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse);
730 NewCell.Id := GetNewCellId;
731 Cells[Y * Size.X + X] := NewCell;
732 end;
733
734 // Generate neighbours
735 for Y := 0 to Self.Size.Y - 1 do
736 for X := 0 to Size.X - 1 do
737 with Cells[Y * Size.X + X] do begin
738 Cell := Cells[Y * Size.X + X];
739 if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1
740 else Rev := 1;
741 if Cyclic then begin
742 P := TPoint.Create(X + 1, Y + 0);
743 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
744 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
745 P := TPoint.Create(X + 0, Y - 1 * Rev);
746 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
747 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
748 P := TPoint.Create(X - 1, Y + 0);
749 P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
750 Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
751 end else begin
752 P := TPoint.Create(X + 1, Y + 0);
753 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
754 P := TPoint.Create(X + 0, Y - 1 * Rev);
755 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
756 P := TPoint.Create(X - 1, Y + 0);
757 if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
758 end;
759 end;
760
761 FPixelRect := CalculatePixelRect;
762end;
763
764function TTriangleMap.CalculatePixelRect: TRect;
765begin
766 Result := inherited;
767 Result.P2 := Result.P2 + TPoint.Create(
768 Trunc(- 0.25 * DefaultCellSize.X / CellMulX),
769 0
770 );
771end;
772
773end.
774
Note: See TracBrowser for help on using the repository browser.