1 | unit UGame;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, ExtCtrls, Graphics, Contnrs, Math, Types;
|
---|
7 |
|
---|
8 | const
|
---|
9 | DefaultPlayerStartUnits = 5;
|
---|
10 | HexCellMulX = 1.12;
|
---|
11 | HexCellMulY = 1.292;
|
---|
12 | SquareCellMulX = 1.1;
|
---|
13 | SquareCellMulY = 1.1;
|
---|
14 | MaxPlayerCount = 8;
|
---|
15 |
|
---|
16 | type
|
---|
17 | TGame = class;
|
---|
18 | TPlayer = class;
|
---|
19 |
|
---|
20 | TFloatPoint = record
|
---|
21 | X, Y: Double;
|
---|
22 | end;
|
---|
23 |
|
---|
24 | TPointArray = array of TPoint;
|
---|
25 |
|
---|
26 | TTerrainType = (ttVoid, ttNormal, ttCity);
|
---|
27 |
|
---|
28 | { TCell }
|
---|
29 |
|
---|
30 | TCell = class
|
---|
31 | private
|
---|
32 | FPower: Integer;
|
---|
33 | procedure SetPower(AValue: Integer);
|
---|
34 | public
|
---|
35 | Pos: TPoint;
|
---|
36 | Terrain: TTerrainType;
|
---|
37 | Player: TPlayer;
|
---|
38 | MovesFrom: TObjectList;
|
---|
39 | MovesTo: TObjectList;
|
---|
40 | function GetColor: TColor;
|
---|
41 | function GetAvialPower: Integer;
|
---|
42 | constructor Create;
|
---|
43 | destructor Destroy; override;
|
---|
44 | property Power: Integer read FPower write SetPower;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | TCellArray = array of TCell;
|
---|
48 |
|
---|
49 | { TView }
|
---|
50 |
|
---|
51 | TView = class
|
---|
52 | private
|
---|
53 | FDestRect: TRect;
|
---|
54 | FZoom: Double;
|
---|
55 | procedure SetDestRect(AValue: TRect);
|
---|
56 | procedure SetZoom(AValue: Double);
|
---|
57 | public
|
---|
58 | Game: TGame;
|
---|
59 | SourceRect: TRect;
|
---|
60 | FocusedCell: TCell;
|
---|
61 | SelectedCell: TCell;
|
---|
62 | procedure Clear;
|
---|
63 | constructor Create;
|
---|
64 | destructor Destroy; override;
|
---|
65 | procedure SelectCell(Pos: TPoint; Player: TPlayer);
|
---|
66 | procedure CenterMap;
|
---|
67 | function CanvasToCellPos(Pos: TPoint): TPoint;
|
---|
68 | function CellToCanvasPos(Pos: TPoint): TPoint;
|
---|
69 | function CanvasToCellRect(Pos: TRect): TRect;
|
---|
70 | function CellToCanvasRect(Pos: TRect): TRect;
|
---|
71 | procedure Assign(Source: TView);
|
---|
72 | property DestRect: TRect read FDestRect write SetDestRect;
|
---|
73 | property Zoom: Double read FZoom write SetZoom;
|
---|
74 | end;
|
---|
75 |
|
---|
76 | { TMap }
|
---|
77 |
|
---|
78 | TMap = class
|
---|
79 | private
|
---|
80 | function GetSize: TPoint; virtual;
|
---|
81 | procedure SetSize(AValue: TPoint); virtual;
|
---|
82 | public
|
---|
83 | Game: TGame;
|
---|
84 | MaxPower: Integer;
|
---|
85 | DefaultCellSize: TPoint;
|
---|
86 | procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
|
---|
87 | function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
|
---|
88 | function IsValidIndex(Index: TPoint): Boolean; virtual;
|
---|
89 | procedure Assign(Source: TMap); virtual;
|
---|
90 | procedure LoadFromFile(FileName: string); virtual;
|
---|
91 | procedure SaveToFile(FileName: string); virtual;
|
---|
92 | function PosToCell(Pos: TPoint; View: TView): TCell; virtual;
|
---|
93 | function CellToPos(Cell: TCell): TPoint; virtual;
|
---|
94 | procedure Grow(APlayer: TPlayer); virtual;
|
---|
95 | procedure ComputePlayerStats; virtual;
|
---|
96 | constructor Create; virtual;
|
---|
97 | destructor Destroy; override;
|
---|
98 | function GetCellNeighbours(Cell: TCell): TCellArray; virtual;
|
---|
99 | procedure Paint(Canvas: TCanvas; View: TView); virtual;
|
---|
100 | function GetPixelRect: TRect; virtual;
|
---|
101 | function GetAllCells: TCellArray; virtual;
|
---|
102 | procedure ForEachCells(Method: TMethod); virtual;
|
---|
103 | property Size: TPoint read GetSize write SetSize;
|
---|
104 | end;
|
---|
105 |
|
---|
106 | { THexMap }
|
---|
107 |
|
---|
108 | THexMap = class(TMap)
|
---|
109 | private
|
---|
110 | FSize: TPoint;
|
---|
111 | function GetSize: TPoint; override;
|
---|
112 | procedure SetSize(AValue: TPoint); override;
|
---|
113 | public
|
---|
114 | Cells: array of array of TCell;
|
---|
115 | function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
|
---|
116 | procedure Assign(Source: TMap); virtual;
|
---|
117 | function IsValidIndex(Index: TPoint): Boolean; override;
|
---|
118 | function GetCellNeighbours(Cell: TCell): TCellArray; override;
|
---|
119 | function PosToCell(Pos: TPoint; View: TView): TCell; override;
|
---|
120 | function CellToPos(Cell: TCell): TPoint; override;
|
---|
121 | function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
|
---|
122 | procedure Paint(Canvas: TCanvas; View: TView); override;
|
---|
123 | constructor Create; override;
|
---|
124 | destructor Destroy; override;
|
---|
125 | function GetAllCells: TCellArray; override;
|
---|
126 | function GetPixelRect: TRect; override;
|
---|
127 | end;
|
---|
128 |
|
---|
129 | { TSquareMap }
|
---|
130 |
|
---|
131 | TSquareMap = class(TMap)
|
---|
132 | private
|
---|
133 | FSize: TPoint;
|
---|
134 | function GetSize: TPoint; override;
|
---|
135 | procedure SetSize(AValue: TPoint); override;
|
---|
136 | public
|
---|
137 | Cells: array of array of TCell;
|
---|
138 | function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
|
---|
139 | function IsValidIndex(Index: TPoint): Boolean; override;
|
---|
140 | function PosToCell(Pos: TPoint; View: TView): TCell; override;
|
---|
141 | function CellToPos(Cell: TCell): TPoint; override;
|
---|
142 | function GetCellNeighbours(Cell: TCell): TCellArray; override;
|
---|
143 | function GetAllCells: TCellArray; override;
|
---|
144 | function GetPixelRect: TRect; override;
|
---|
145 | procedure Paint(Canvas: TCanvas; View: TView); override;
|
---|
146 | constructor Create; override;
|
---|
147 | destructor Destroy; override;
|
---|
148 | property Size: TPoint read FSize write SetSize;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | TPlayerMode = (pmHuman, pmComputer);
|
---|
152 |
|
---|
153 | { TPlayer }
|
---|
154 |
|
---|
155 | TPlayer = class
|
---|
156 | private
|
---|
157 | FGame: TGame;
|
---|
158 | procedure SetGame(AValue: TGame);
|
---|
159 | public
|
---|
160 | Name: string;
|
---|
161 | Color: TColor;
|
---|
162 | View: TView;
|
---|
163 | Mode: TPlayerMode;
|
---|
164 | TotalUnits: Integer;
|
---|
165 | TotalCells: Integer;
|
---|
166 | StartUnits: Integer;
|
---|
167 | procedure ComputerTurn;
|
---|
168 | procedure Paint(PaintBox: TPaintBox);
|
---|
169 | constructor Create;
|
---|
170 | destructor Destroy; override;
|
---|
171 | procedure Assign(Source: TPlayer);
|
---|
172 | property Game: TGame read FGame write SetGame;
|
---|
173 | end;
|
---|
174 |
|
---|
175 | TPlayerArray = array of TPlayer;
|
---|
176 |
|
---|
177 | TPlayers = class(TObjectList)
|
---|
178 |
|
---|
179 | end;
|
---|
180 |
|
---|
181 | { TMove }
|
---|
182 |
|
---|
183 | TMove = class
|
---|
184 | private
|
---|
185 | FCellFrom: TCell;
|
---|
186 | FCellTo: TCell;
|
---|
187 | FDestroying: Boolean;
|
---|
188 | procedure SetCellFrom(AValue: TCell);
|
---|
189 | procedure SetCellTo(AValue: TCell);
|
---|
190 | public
|
---|
191 | List: TObjectList; // TList<TMove>
|
---|
192 | CountOnce: Integer;
|
---|
193 | CountRepeat: Integer;
|
---|
194 | constructor Create;
|
---|
195 | destructor Destroy; override;
|
---|
196 | property CellFrom: TCell read FCellFrom write SetCellFrom;
|
---|
197 | property CellTo: TCell read FCellTo write SetCellTo;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | { TGame }
|
---|
201 |
|
---|
202 | TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
|
---|
203 | Update: Boolean; var Confirm: Boolean) of object;
|
---|
204 | TWinEvent = procedure(Player: TPlayer) of object;
|
---|
205 | TGrowAmount = (gaByOne, gaBySquareRoot);
|
---|
206 | TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
|
---|
207 | TMapType = (mtNone, mtHexagon, mtSquare);
|
---|
208 |
|
---|
209 | TGame = class
|
---|
210 | private
|
---|
211 | FMapType: TMapType;
|
---|
212 | FOnMove: TMoveEvent;
|
---|
213 | FOnWin: TWinEvent;
|
---|
214 | FRunning: Boolean;
|
---|
215 | procedure Attack(var AttackPower, DefendPower: Integer);
|
---|
216 | procedure MoveAll(Player: TPlayer);
|
---|
217 | procedure ClearMovesFromCell(Cell: TCell);
|
---|
218 | procedure SetMapType(AValue: TMapType);
|
---|
219 | procedure SetMove(CellFrom, CellTo: TCell; Power: Integer);
|
---|
220 | procedure SetRunning(AValue: Boolean);
|
---|
221 | procedure UpdateRepeatMoves(Player: TPlayer);
|
---|
222 | public
|
---|
223 | Players: TPlayers;
|
---|
224 | Map: TMap;
|
---|
225 | VoidEnabled: Boolean;
|
---|
226 | VoidPercentage: Integer;
|
---|
227 | GrowCells: TGrowCells;
|
---|
228 | GrowAmount: TGrowAmount;
|
---|
229 | CityEnabled: Boolean;
|
---|
230 | CityPercentage: Integer;
|
---|
231 | CurrentPlayer: TPlayer;
|
---|
232 | Moves: TObjectList; // TList<TMove>
|
---|
233 | TurnCounter: Integer;
|
---|
234 | procedure ComputePlayerStats;
|
---|
235 | function GetAlivePlayers: TPlayerArray;
|
---|
236 | procedure NextTurn;
|
---|
237 | constructor Create;
|
---|
238 | destructor Destroy; override;
|
---|
239 | procedure New;
|
---|
240 | property Running: Boolean read FRunning write SetRunning;
|
---|
241 | property MapType: TMapType read FMapType write SetMapType;
|
---|
242 | published
|
---|
243 | property OnMove: TMoveEvent read FOnMove write FOnMove;
|
---|
244 | property OnWin: TWinEvent read FOnWin write FOnWin;
|
---|
245 | end;
|
---|
246 |
|
---|
247 | var
|
---|
248 | PlayerModeText: array[TPlayerMode] of string;
|
---|
249 |
|
---|
250 | const
|
---|
251 | clOrange = $009Aff;
|
---|
252 | PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange,
|
---|
253 | clPurple, clMaroon, clAqua, clFuchsia);
|
---|
254 |
|
---|
255 | procedure InitStrings;
|
---|
256 | function FloatPoint(AX, AY: Double): TFloatPoint;
|
---|
257 |
|
---|
258 |
|
---|
259 | implementation
|
---|
260 |
|
---|
261 | resourcestring
|
---|
262 | SMinimumPlayers = 'You need at least two players';
|
---|
263 | SHuman = 'Human';
|
---|
264 | SComputer = 'Computer';
|
---|
265 | SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
|
---|
266 | SUnfinishedBattle = 'Unfinished battle';
|
---|
267 |
|
---|
268 | procedure InitStrings;
|
---|
269 | begin
|
---|
270 | PlayerModeText[pmHuman] := SHuman;
|
---|
271 | PlayerModeText[pmComputer] := SComputer;
|
---|
272 | end;
|
---|
273 |
|
---|
274 | function FloatPoint(AX, AY: Double): TFloatPoint;
|
---|
275 | begin
|
---|
276 | Result.X := AX;
|
---|
277 | Result.Y := AY;
|
---|
278 | end;
|
---|
279 |
|
---|
280 | function RectEquals(A, B: TRect): Boolean;
|
---|
281 | begin
|
---|
282 | Result := (A.Left = B.Left) and (A.Top = B.Top) and
|
---|
283 | (A.Right = B.Right) and (A.Bottom = B.Bottom);
|
---|
284 | end;
|
---|
285 |
|
---|
286 | function PtInRect(const Rect: TRect; Pos: TPoint): Boolean;
|
---|
287 | begin
|
---|
288 | Result := (Pos.X >= Rect.Left) and (Pos.Y >= Rect.Top) and
|
---|
289 | (Pos.X <= Rect.Right) and (Pos.Y <= Rect.Bottom);
|
---|
290 | end;
|
---|
291 |
|
---|
292 | function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
|
---|
293 | var
|
---|
294 | Count, K, J : Integer;
|
---|
295 | begin
|
---|
296 | Result := False;
|
---|
297 | Count := Length(Points) ;
|
---|
298 | J := Count - 1;
|
---|
299 | for K := 0 to Count - 1 do begin
|
---|
300 | if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
|
---|
301 | ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
|
---|
302 | begin
|
---|
303 | if (Pos.X < (Points[j].X - Points[K].X) *
|
---|
304 | (Pos.Y - Points[K].Y) /
|
---|
305 | (Points[j].Y - Points[K].Y) + Points[K].X) then
|
---|
306 | Result := not Result;
|
---|
307 | end;
|
---|
308 | J := K;
|
---|
309 | end;
|
---|
310 | end;
|
---|
311 |
|
---|
312 | { TSquareMap }
|
---|
313 |
|
---|
314 | function TSquareMap.GetSize: TPoint;
|
---|
315 | begin
|
---|
316 | Result := FSize;
|
---|
317 | end;
|
---|
318 |
|
---|
319 | procedure TSquareMap.SetSize(AValue: TPoint);
|
---|
320 | var
|
---|
321 | X, Y: Integer;
|
---|
322 | NewCell: TCell;
|
---|
323 | C: Integer;
|
---|
324 | begin
|
---|
325 | if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
|
---|
326 | // Free previous
|
---|
327 | for Y := 0 to FSize.Y - 1 do
|
---|
328 | for X := 0 to FSize.X - 1 do begin
|
---|
329 | TCell(Cells[Y, X]).Destroy;
|
---|
330 | end;
|
---|
331 | FSize := AValue;
|
---|
332 | // Allocate and init new
|
---|
333 | SetLength(Cells, FSize.Y, FSize.X);
|
---|
334 | for Y := 0 to FSize.Y - 1 do
|
---|
335 | for X := 0 to FSize.X - 1 do begin
|
---|
336 | NewCell := TCell.Create;
|
---|
337 | NewCell.Pos := Point(X, Y);
|
---|
338 | Cells[Y, X] := NewCell;
|
---|
339 | end;
|
---|
340 | end;
|
---|
341 | end;
|
---|
342 |
|
---|
343 | function TSquareMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
|
---|
344 | var
|
---|
345 | DX: Integer;
|
---|
346 | DY: Integer;
|
---|
347 | MinY: Integer;
|
---|
348 | begin
|
---|
349 | if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y
|
---|
350 | else MinY := Cell2.Pos.Y;
|
---|
351 | DX := Cell2.Pos.X - Cell1.Pos.X;
|
---|
352 | DY := Cell2.Pos.Y - Cell1.Pos.Y;
|
---|
353 | Result := (Abs(DX) <= 1) and (Abs(DY) <= 1);
|
---|
354 | Result := Result and not (Cell1 = Cell2);
|
---|
355 | end;
|
---|
356 |
|
---|
357 | function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
358 | begin
|
---|
359 | Result := (Index.X >= 0) and (Index.X < Size.X) and
|
---|
360 | (Index.Y >= 0) and (Index.Y < Size.Y);
|
---|
361 | end;
|
---|
362 |
|
---|
363 | function TSquareMap.PosToCell(Pos: TPoint; View: TView): TCell;
|
---|
364 | var
|
---|
365 | CX, CY: Integer;
|
---|
366 | X, Y: Double;
|
---|
367 | HexSize: TFloatPoint;
|
---|
368 | CellSize: TFloatPoint;
|
---|
369 | Frame: TRect;
|
---|
370 | begin
|
---|
371 | // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
|
---|
372 | Result := nil;
|
---|
373 | CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
|
---|
374 | HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
|
---|
375 | with View do
|
---|
376 | for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
|
---|
377 | for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
|
---|
378 | X := CX;
|
---|
379 | Y := CY;
|
---|
380 | if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
|
---|
381 | if Cells[CY, CX].Terrain <> ttVoid then begin
|
---|
382 | Frame := Rect(Trunc(X * CellSize.X - HexSize.X / 2),
|
---|
383 | Trunc(Y * CellSize.Y - HexSize.Y / 2),
|
---|
384 | Trunc(X * CellSize.X + HexSize.X / 2),
|
---|
385 | Trunc(Y * CellSize.Y + HexSize.Y / 2));
|
---|
386 | if PtInRect(Frame, Pos) then begin
|
---|
387 | Result := Cells[CY, CX];
|
---|
388 | Exit;
|
---|
389 | end;
|
---|
390 | end;
|
---|
391 | end;
|
---|
392 | end;
|
---|
393 |
|
---|
394 | function TSquareMap.CellToPos(Cell: TCell): TPoint;
|
---|
395 | var
|
---|
396 | CX, CY: Integer;
|
---|
397 | X, Y: Double;
|
---|
398 | HexSize: TFloatPoint;
|
---|
399 | CellSize: TFloatPoint;
|
---|
400 | Points: array of TPoint;
|
---|
401 | begin
|
---|
402 | CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
|
---|
403 | HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
|
---|
404 | X := Cell.Pos.X;
|
---|
405 | Y := Cell.Pos.Y;
|
---|
406 |
|
---|
407 | Result.X := Trunc(X * CellSize.X);
|
---|
408 | Result.Y := Trunc(Y * CellSize.Y);
|
---|
409 | end;
|
---|
410 |
|
---|
411 | function TSquareMap.GetCellNeighbours(Cell: TCell): TCellArray;
|
---|
412 | var
|
---|
413 | X, Y: Integer;
|
---|
414 | begin
|
---|
415 | SetLength(Result, 0);
|
---|
416 | for Y := -1 to 1 do
|
---|
417 | for X := -1 to 1 do
|
---|
418 | if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and
|
---|
419 | IsCellsNeighbor(Cell, Cells[Cell.Pos.Y + Y, Cell.Pos.X + X]) then begin
|
---|
420 | SetLength(Result, Length(Result) + 1);
|
---|
421 | Result[Length(Result) - 1] := Cells[Cell.Pos.Y + Y, Cell.Pos.X + X];
|
---|
422 | end;
|
---|
423 | end;
|
---|
424 |
|
---|
425 | function TSquareMap.GetAllCells: TCellArray;
|
---|
426 | var
|
---|
427 | X: Integer;
|
---|
428 | Y: Integer;
|
---|
429 | I: Integer;
|
---|
430 | begin
|
---|
431 | SetLength(Result, Size.Y * Size.X);
|
---|
432 | for Y := 0 to Size.Y - 1 do
|
---|
433 | for X := 0 to Size.X - 1 do
|
---|
434 | Result[Y * Size.X + X] := Cells[Y, X];
|
---|
435 | end;
|
---|
436 |
|
---|
437 | function TSquareMap.GetPixelRect: TRect;
|
---|
438 | begin
|
---|
439 | Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
|
---|
440 | Trunc(-0.5 * DefaultCellSize.Y),
|
---|
441 | Trunc((Size.X + 0.5) * DefaultCellSize.X),
|
---|
442 | Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
|
---|
443 | end;
|
---|
444 |
|
---|
445 | procedure TSquareMap.Paint(Canvas: TCanvas; View: TView);
|
---|
446 | var
|
---|
447 | CX, CY: Integer;
|
---|
448 | X, Y: Double;
|
---|
449 | CellSizeZoomed: TFloatPoint;
|
---|
450 | CellSize: TFloatPoint;
|
---|
451 | HexSize: TFloatPoint;
|
---|
452 | I: Integer;
|
---|
453 | Points: array of TPoint;
|
---|
454 | Cell: TCell;
|
---|
455 | PosFrom, PosTo: TPoint;
|
---|
456 | Angle: Double;
|
---|
457 |
|
---|
458 | procedure PaintHexagon(Pos: TPoint; Text: string);
|
---|
459 | begin
|
---|
460 | with Canvas do begin
|
---|
461 | if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin
|
---|
462 | Pen.Color := clYellow;
|
---|
463 | Pen.Style := psSolid;
|
---|
464 | Pen.Width := 1;
|
---|
465 | end else
|
---|
466 | if TCell(Cells[CY, CX]).Terrain = ttCity then begin
|
---|
467 | // Cannot set clear border as it will display shifted on gtk2
|
---|
468 | //Pen.Style := psClear;
|
---|
469 | Pen.Color := clBlack;
|
---|
470 | Pen.Style := psSolid;
|
---|
471 | Pen.Width := 3;
|
---|
472 | end else begin
|
---|
473 | // Cannot set clear border as it will display shifted on gtk2
|
---|
474 | //Pen.Style := psClear;
|
---|
475 | Pen.Color := Brush.Color;
|
---|
476 | Pen.Style := psSolid;
|
---|
477 | Pen.Width := 0;
|
---|
478 | end;
|
---|
479 | Rectangle(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
|
---|
480 | //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
|
---|
481 | Pen.Style := psSolid;
|
---|
482 | Font.Color := clWhite;
|
---|
483 | Font.Size := Trunc(12 * View.Zoom);
|
---|
484 | TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
|
---|
485 | end;
|
---|
486 | end;
|
---|
487 |
|
---|
488 | begin
|
---|
489 | CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulY);
|
---|
490 | HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
|
---|
491 | CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
|
---|
492 | with Canvas, View do try
|
---|
493 | Lock;
|
---|
494 | for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
|
---|
495 | for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
|
---|
496 | X := CX;
|
---|
497 | Y := CY;
|
---|
498 | if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
|
---|
499 | Cell := Cells[CY, CX];
|
---|
500 | if Cell.Terrain <> ttVoid then begin
|
---|
501 | if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY, CX])) then Brush.Color := clGreen
|
---|
502 | else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY, CX])) then Brush.Color := clPurple
|
---|
503 | else Brush.Color := Cell.GetColor;
|
---|
504 | Pen.Color := clBlack;
|
---|
505 | PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
|
---|
506 | Trunc(Y * CellSize.Y))),
|
---|
507 | IntToStr(Cell.GetAvialPower));
|
---|
508 | // Draw arrows
|
---|
509 | Pen.Color := clCream;
|
---|
510 | for I := 0 to Cell.MovesFrom.Count - 1 do begin
|
---|
511 | PosFrom := CellToPos(Cell);
|
---|
512 | PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
|
---|
513 | if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
|
---|
514 | else Pen.Width := 1;
|
---|
515 | Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
|
---|
516 | if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
|
---|
517 | DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
|
---|
518 | Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
|
---|
519 | Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
|
---|
520 | Pen.Width := 1;
|
---|
521 | end;
|
---|
522 | end;
|
---|
523 | end;
|
---|
524 | end;
|
---|
525 | finally
|
---|
526 | Unlock;
|
---|
527 | end;
|
---|
528 | end;
|
---|
529 |
|
---|
530 | constructor TSquareMap.Create;
|
---|
531 | begin
|
---|
532 | inherited;
|
---|
533 | end;
|
---|
534 |
|
---|
535 | destructor TSquareMap.Destroy;
|
---|
536 | begin
|
---|
537 | inherited Destroy;
|
---|
538 | end;
|
---|
539 |
|
---|
540 | { TMap }
|
---|
541 |
|
---|
542 | function TMap.GetSize: TPoint;
|
---|
543 | begin
|
---|
544 | Result:= Point(0, 0);
|
---|
545 | end;
|
---|
546 |
|
---|
547 | procedure TMap.SetSize(AValue: TPoint);
|
---|
548 | begin
|
---|
549 |
|
---|
550 | end;
|
---|
551 |
|
---|
552 | procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
|
---|
553 | var
|
---|
554 | Points: array of TPoint;
|
---|
555 | FPoints: array of TFloatPoint;
|
---|
556 | I: Integer;
|
---|
557 | begin
|
---|
558 | Canvas.Brush.Color := clWhite;
|
---|
559 | Canvas.Pen.Color := clBlack;
|
---|
560 | SetLength(Points, 8);
|
---|
561 | SetLength(FPoints, 8);
|
---|
562 | FPoints[0] := FloatPoint(+0.5 * Size.X, +0 * Size.Y);
|
---|
563 | FPoints[1] := FloatPoint(+0 * Size.X, +0.5 * Size.Y);
|
---|
564 | FPoints[2] := FloatPoint(+0 * Size.X, +0.25 * Size.Y);
|
---|
565 | FPoints[3] := FloatPoint(-0.5 * Size.X, +0.25 * Size.Y);
|
---|
566 | FPoints[4] := FloatPoint(-0.5 * Size.X, -0.25 * Size.Y);
|
---|
567 | FPoints[5] := FloatPoint(+0 * Size.X, -0.25 * Size.Y);
|
---|
568 | FPoints[6] := FloatPoint(+0 * Size.X, -0.5 * Size.Y);
|
---|
569 | FPoints[7] := FloatPoint(+0.5 * Size.X, 0 * Size.Y);
|
---|
570 | // Rotate
|
---|
571 | for I := 0 to Length(Points) - 1 do
|
---|
572 | FPoints[I] := FloatPoint(FPoints[I].X * cos(Angle) - FPoints[I].Y * sin(Angle),
|
---|
573 | FPoints[I].X * sin(Angle) + FPoints[I].Y * cos(Angle));
|
---|
574 | // Shift
|
---|
575 | for I := 0 to Length(Points) - 1 do
|
---|
576 | Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));
|
---|
577 | Canvas.Polygon(Points);
|
---|
578 | end;
|
---|
579 |
|
---|
580 | function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
|
---|
581 | begin
|
---|
582 | Result := False;
|
---|
583 | end;
|
---|
584 |
|
---|
585 | function TMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
586 | begin
|
---|
587 | Result := False;
|
---|
588 | end;
|
---|
589 |
|
---|
590 | procedure TMap.Assign(Source: TMap);
|
---|
591 | begin
|
---|
592 | MaxPower := Source.MaxPower;
|
---|
593 | Game := Source.Game;
|
---|
594 | Size := Source.Size;
|
---|
595 | DefaultCellSize := Source.DefaultCellSize;
|
---|
596 | end;
|
---|
597 |
|
---|
598 | procedure TMap.LoadFromFile(FileName: string);
|
---|
599 | begin
|
---|
600 |
|
---|
601 | end;
|
---|
602 |
|
---|
603 | procedure TMap.SaveToFile(FileName: string);
|
---|
604 | begin
|
---|
605 |
|
---|
606 | end;
|
---|
607 |
|
---|
608 | function TMap.PosToCell(Pos: TPoint; View: TView): TCell;
|
---|
609 | begin
|
---|
610 | Result := nil;
|
---|
611 | end;
|
---|
612 |
|
---|
613 | function TMap.CellToPos(Cell: TCell): TPoint;
|
---|
614 | begin
|
---|
615 | Result := Point(0, 0);
|
---|
616 | end;
|
---|
617 |
|
---|
618 | procedure TMap.Grow(APlayer: TPlayer);
|
---|
619 | var
|
---|
620 | I: Integer;
|
---|
621 | Addition: Integer;
|
---|
622 | Cells: TCellArray;
|
---|
623 | begin
|
---|
624 | Cells := GetAllCells;
|
---|
625 | for I := 0 to Length(Cells) - 1 do
|
---|
626 | with TCell(Cells[I]) do begin
|
---|
627 | if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
|
---|
628 | ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
|
---|
629 | if Game.GrowAmount = gaByOne then Addition := 1
|
---|
630 | else if Game.GrowAmount = gaBySquareRoot then begin
|
---|
631 | Addition := Trunc(Sqrt(Power));
|
---|
632 | if Addition = 0 then Addition := 1;
|
---|
633 | end;
|
---|
634 | Power := Power + Addition;
|
---|
635 | if Power > MaxPower then Power := MaxPower;
|
---|
636 | end;
|
---|
637 | end;
|
---|
638 | end;
|
---|
639 |
|
---|
640 | procedure TMap.ComputePlayerStats;
|
---|
641 | var
|
---|
642 | Cells: TCellArray;
|
---|
643 | I: Integer;
|
---|
644 | begin
|
---|
645 | Cells := GetAllCells;
|
---|
646 | for I := 0 to Length(Cells) - 1 do
|
---|
647 | with Cells[I] do begin
|
---|
648 | if Assigned(Player) then begin
|
---|
649 | Player.TotalCells := Player.TotalCells + 1;
|
---|
650 | Player.TotalUnits := Player.TotalUnits + Power;
|
---|
651 | end;
|
---|
652 | end;
|
---|
653 | end;
|
---|
654 |
|
---|
655 | constructor TMap.Create;
|
---|
656 | begin
|
---|
657 | MaxPower := 99;
|
---|
658 | DefaultCellSize := Point(62, 62);
|
---|
659 | end;
|
---|
660 |
|
---|
661 | destructor TMap.Destroy;
|
---|
662 | begin
|
---|
663 | Size := Point(0, 0);
|
---|
664 | inherited Destroy;
|
---|
665 | end;
|
---|
666 |
|
---|
667 | function TMap.GetCellNeighbours(Cell: TCell): TCellArray;
|
---|
668 | begin
|
---|
669 |
|
---|
670 | end;
|
---|
671 |
|
---|
672 | procedure TMap.Paint(Canvas: TCanvas; View: TView);
|
---|
673 | begin
|
---|
674 |
|
---|
675 | end;
|
---|
676 |
|
---|
677 | function TMap.GetPixelRect: TRect;
|
---|
678 | var
|
---|
679 | Cells: TCellArray;
|
---|
680 | I: Integer;
|
---|
681 | CellPos: TPoint;
|
---|
682 | begin
|
---|
683 | Result := Rect(0, 0, 0, 0);
|
---|
684 | // This is generic iterative algorithm to determine map pixel size
|
---|
685 | Cells := GetAllCells;
|
---|
686 | for I := 0 to Length(Cells) - 1 do begin
|
---|
687 | CellPos := CellToPos(Cells[I]);
|
---|
688 | if I = 0 then Result := Rect(CellPos.X, CellPos.Y, CellPos.X, CellPos.Y)
|
---|
689 | else begin
|
---|
690 | if CellPos.X > Result.Right then Result.Right := CellPos.X;
|
---|
691 | if CellPos.Y > Result.Bottom then Result.Bottom := CellPos.Y;
|
---|
692 | if CellPos.X < Result.Left then Result.Left := CellPos.X;
|
---|
693 | if CellPos.Y < Result.Top then Result.Top := CellPos.Y;
|
---|
694 | end;
|
---|
695 | end;
|
---|
696 | end;
|
---|
697 |
|
---|
698 |
|
---|
699 | function TMap.GetAllCells: TCellArray;
|
---|
700 | begin
|
---|
701 |
|
---|
702 | end;
|
---|
703 |
|
---|
704 | procedure TMap.ForEachCells(Method: TMethod);
|
---|
705 | begin
|
---|
706 |
|
---|
707 | end;
|
---|
708 |
|
---|
709 | { TMove }
|
---|
710 |
|
---|
711 | procedure TMove.SetCellFrom(AValue: TCell);
|
---|
712 | begin
|
---|
713 | if FCellFrom = AValue then Exit;
|
---|
714 | if Assigned(AValue) and not Assigned(FCellFrom) then begin
|
---|
715 | AValue.MovesFrom.Add(Self);
|
---|
716 | end else
|
---|
717 | if not Assigned(AValue) and Assigned(FCellFrom) then begin
|
---|
718 | FCellFrom.MovesFrom.Remove(Self);
|
---|
719 | end;
|
---|
720 | FCellFrom := AValue;
|
---|
721 | end;
|
---|
722 |
|
---|
723 | procedure TMove.SetCellTo(AValue: TCell);
|
---|
724 | begin
|
---|
725 | if FCellTo = AValue then Exit;
|
---|
726 | if Assigned(AValue) and not Assigned(FCellTo) then begin
|
---|
727 | AValue.MovesTo.Add(Self);
|
---|
728 | end else
|
---|
729 | if not Assigned(AValue) and Assigned(FCellTo) then begin
|
---|
730 | FCellTo.MovesTo.Remove(Self);
|
---|
731 | end;
|
---|
732 | FCellTo := AValue;
|
---|
733 | end;
|
---|
734 |
|
---|
735 | constructor TMove.Create;
|
---|
736 | begin
|
---|
737 | FCellFrom := nil;
|
---|
738 | FCellTo := nil;
|
---|
739 | end;
|
---|
740 |
|
---|
741 | destructor TMove.Destroy;
|
---|
742 | var
|
---|
743 | LastState: Boolean;
|
---|
744 | begin
|
---|
745 | CellFrom := nil;
|
---|
746 | CellTo := nil;
|
---|
747 | if Assigned(List) then begin
|
---|
748 | // To remove itself from list we need disable owning to not be called twice
|
---|
749 | try
|
---|
750 | LastState := List.OwnsObjects;
|
---|
751 | List.OwnsObjects := False;
|
---|
752 | List.Remove(Self);
|
---|
753 | finally
|
---|
754 | List.OwnsObjects := LastState;
|
---|
755 | end;
|
---|
756 | end;
|
---|
757 | inherited Destroy;
|
---|
758 | end;
|
---|
759 |
|
---|
760 | { TView }
|
---|
761 |
|
---|
762 | procedure TView.SetZoom(AValue: Double);
|
---|
763 | var
|
---|
764 | OldSourceRect: TRect;
|
---|
765 | begin
|
---|
766 | if FZoom = AValue then Exit;
|
---|
767 | FZoom := AValue;
|
---|
768 | SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
|
---|
769 | Trunc(SourceRect.Top + (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
|
---|
770 | Trunc((DestRect.Right - DestRect.Left) / Zoom),
|
---|
771 | Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
|
---|
772 | end;
|
---|
773 |
|
---|
774 | procedure TView.Clear;
|
---|
775 | begin
|
---|
776 | FocusedCell := nil;
|
---|
777 | SelectedCell := nil;
|
---|
778 | end;
|
---|
779 |
|
---|
780 | procedure TView.SetDestRect(AValue: TRect);
|
---|
781 | var
|
---|
782 | Diff: TPoint;
|
---|
783 | begin
|
---|
784 | if RectEquals(FDestRect, AValue) then Exit;
|
---|
785 | Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
|
---|
786 | Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
|
---|
787 | FDestRect := AValue;
|
---|
788 | SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
|
---|
789 | Trunc((DestRect.Right - DestRect.Left) / Zoom),
|
---|
790 | Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
|
---|
791 | end;
|
---|
792 |
|
---|
793 | constructor TView.Create;
|
---|
794 | begin
|
---|
795 | Zoom := 1.5;
|
---|
796 | Clear;
|
---|
797 | end;
|
---|
798 |
|
---|
799 | destructor TView.Destroy;
|
---|
800 | begin
|
---|
801 | inherited Destroy;
|
---|
802 | end;
|
---|
803 |
|
---|
804 | { TCell }
|
---|
805 |
|
---|
806 | procedure TCell.SetPower(AValue: Integer);
|
---|
807 | begin
|
---|
808 | if FPower = AValue then Exit;
|
---|
809 | if AValue < 0 then
|
---|
810 | raise Exception.Create('Not allowed to substract power under zero do negative value');
|
---|
811 | FPower := AValue;
|
---|
812 | end;
|
---|
813 |
|
---|
814 | function TCell.GetColor: TColor;
|
---|
815 | begin
|
---|
816 | if Assigned(Player) then Result := Player.Color
|
---|
817 | else Result := clGray;
|
---|
818 | end;
|
---|
819 |
|
---|
820 | function TCell.GetAvialPower: Integer;
|
---|
821 | var
|
---|
822 | I: Integer;
|
---|
823 | begin
|
---|
824 | Result := Power;
|
---|
825 | for I := 0 to MovesFrom.Count - 1 do
|
---|
826 | Result := Result - TMove(MovesFrom[I]).CountOnce;
|
---|
827 | if Result < 0 then Result := 0;
|
---|
828 | end;
|
---|
829 |
|
---|
830 | constructor TCell.Create;
|
---|
831 | begin
|
---|
832 | Player := nil;
|
---|
833 | MovesFrom := TObjectList.Create;
|
---|
834 | MovesFrom.OwnsObjects := False;
|
---|
835 | MovesTo := TObjectList.Create;
|
---|
836 | MovesTo.OwnsObjects := False;
|
---|
837 | end;
|
---|
838 |
|
---|
839 | destructor TCell.Destroy;
|
---|
840 | var
|
---|
841 | I: Integer;
|
---|
842 | begin
|
---|
843 | for I := MovesFrom.Count - 1 downto 0 do
|
---|
844 | TMove(MovesFrom[I]).Free;
|
---|
845 | FreeAndNil(MovesFrom);
|
---|
846 | for I := MovesTo.Count - 1 downto 0 do
|
---|
847 | TMove(MovesTo[I]).Free;
|
---|
848 | FreeAndNil(MovesTo);
|
---|
849 | inherited Destroy;
|
---|
850 | end;
|
---|
851 |
|
---|
852 | { TPlayer }
|
---|
853 |
|
---|
854 | function TView.CanvasToCellPos(Pos: TPoint): TPoint;
|
---|
855 | begin
|
---|
856 | Result := Point(Trunc(Pos.X / Zoom + SourceRect.Left),
|
---|
857 | Trunc(Pos.Y / Zoom + SourceRect.Top));
|
---|
858 | end;
|
---|
859 |
|
---|
860 | function TView.CellToCanvasPos(Pos: TPoint): TPoint;
|
---|
861 | begin
|
---|
862 | Result := Point(Trunc((Pos.X - SourceRect.Left) * Zoom),
|
---|
863 | Trunc((Pos.Y - SourceRect.Top) * Zoom));
|
---|
864 | end;
|
---|
865 |
|
---|
866 | function TView.CanvasToCellRect(Pos: TRect): TRect;
|
---|
867 | begin
|
---|
868 | Result.TopLeft := CanvasToCellPos(Pos.TopLeft);
|
---|
869 | Result.BottomRight := CanvasToCellPos(Pos.BottomRight);
|
---|
870 | end;
|
---|
871 |
|
---|
872 | function TView.CellToCanvasRect(Pos: TRect): TRect;
|
---|
873 | begin
|
---|
874 | Result.TopLeft := CellToCanvasPos(Pos.TopLeft);
|
---|
875 | Result.BottomRight := CellToCanvasPos(Pos.BottomRight);
|
---|
876 | end;
|
---|
877 |
|
---|
878 | procedure TView.Assign(Source: TView);
|
---|
879 | begin
|
---|
880 | SourceRect := Source.SourceRect;
|
---|
881 | DestRect := Source.DestRect;
|
---|
882 | Zoom := Source.Zoom;
|
---|
883 | SelectedCell := Source.SelectedCell;
|
---|
884 | FocusedCell := Source.FocusedCell;
|
---|
885 | end;
|
---|
886 |
|
---|
887 | procedure TPlayer.SetGame(AValue: TGame);
|
---|
888 | begin
|
---|
889 | if FGame = AValue then Exit;
|
---|
890 | FGame := AValue;
|
---|
891 | View.Game := Game;
|
---|
892 | end;
|
---|
893 |
|
---|
894 | procedure TPlayer.ComputerTurn;
|
---|
895 | var
|
---|
896 | AllCells: TCellArray;
|
---|
897 | Cells: TCellArray;
|
---|
898 | X, Y: Integer;
|
---|
899 | TotalPower: Integer;
|
---|
900 | AttackPower: Integer;
|
---|
901 | TotalAttackPower: Integer;
|
---|
902 | I: Integer;
|
---|
903 | C: Integer;
|
---|
904 | CanAttack: Integer;
|
---|
905 | begin
|
---|
906 | AllCells := Game.Map.GetAllCells;
|
---|
907 | for C := 0 to Length(AllCells) - 1 do
|
---|
908 | with AllCells[C] do begin
|
---|
909 | if (Terrain <> ttVoid) and (Player <> Self) then begin
|
---|
910 | // Attack to not owned cell yet
|
---|
911 | // Count own possible power
|
---|
912 | Cells := Game.Map.GetCellNeighbours(AllCells[C]);
|
---|
913 | TotalPower := 0;
|
---|
914 | for I := 0 to Length(Cells) - 1 do
|
---|
915 | if (Cells[I].Player = Self) then begin
|
---|
916 | TotalPower := TotalPower + Cells[I].GetAvialPower;
|
---|
917 | end;
|
---|
918 | // Attack if target is weaker
|
---|
919 | if TotalPower >= Power then begin
|
---|
920 | TotalAttackPower := 0;
|
---|
921 | for I := 0 to Length(Cells) - 1 do
|
---|
922 | if (Cells[I].Player = Self) then begin
|
---|
923 | // Use only necessary power
|
---|
924 | AttackPower := Power - TotalAttackPower + 1;
|
---|
925 | if Cells[I].GetAvialPower < AttackPower then
|
---|
926 | AttackPower := Cells[I].GetAvialPower;
|
---|
927 | Game.SetMove(Cells[I], AllCells[C], AttackPower);
|
---|
928 | TotalAttackPower := TotalAttackPower + AttackPower;
|
---|
929 | end;
|
---|
930 | end;
|
---|
931 | end else
|
---|
932 | if (Terrain <> ttVoid) and (Player = Self) then begin
|
---|
933 | // Inner moves
|
---|
934 | // We need to move available power to borders to be available for attacks
|
---|
935 | // or defense
|
---|
936 | Cells := Game.Map.GetCellNeighbours(AllCells[C]);
|
---|
937 | CanAttack := 0;
|
---|
938 | for I := 0 to Length(Cells) - 1 do
|
---|
939 | if (Cells[I].Player <> Self) and (Cells[I].Terrain <> ttVoid) then begin
|
---|
940 | Inc(CanAttack);
|
---|
941 | end;
|
---|
942 | if CanAttack = 0 then begin
|
---|
943 | // We cannot attack and should do move
|
---|
944 | // For simplicty just try to balance inner area cells power
|
---|
945 | for I := 0 to Length(Cells) - 1 do
|
---|
946 | if (Cells[I].Player = Self) and (Cells[I].Power < AllCells[C].GetAvialPower) then begin
|
---|
947 | Game.SetMove(AllCells[C], Cells[I], (AllCells[C].GetAvialPower - Cells[I].Power) div 2);
|
---|
948 | end;
|
---|
949 | end;
|
---|
950 | end;
|
---|
951 | end;
|
---|
952 | end;
|
---|
953 |
|
---|
954 | procedure TView.SelectCell(Pos: TPoint; Player: TPlayer);
|
---|
955 | var
|
---|
956 | NewSelectedCell: TCell;
|
---|
957 | TopLeft: TPoint;
|
---|
958 | BottomRight: TPoint;
|
---|
959 | begin
|
---|
960 | NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self);
|
---|
961 | if Assigned(NewSelectedCell) then begin
|
---|
962 | if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
|
---|
963 | Game.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power);
|
---|
964 | SelectedCell := nil;
|
---|
965 | end else
|
---|
966 | if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.Player = Player) then
|
---|
967 | SelectedCell := NewSelectedCell
|
---|
968 | else
|
---|
969 | if (NewSelectedCell = SelectedCell) and (NewSelectedCell.Player = Player) then
|
---|
970 | SelectedCell := nil;
|
---|
971 | end;
|
---|
972 | end;
|
---|
973 |
|
---|
974 | procedure TView.CenterMap;
|
---|
975 | var
|
---|
976 | MapRect: TRect;
|
---|
977 | begin
|
---|
978 | MapRect := Game.Map.GetPixelRect;
|
---|
979 | SourceRect := Bounds(MapRect.Left + (MapRect.Right - MapRect.Left) div 2 - (SourceRect.Right - SourceRect.Left) div 2,
|
---|
980 | MapRect.Top + (MapRect.Bottom - MapRect.Top) div 2 - (SourceRect.Bottom - SourceRect.Top) div 2,
|
---|
981 | SourceRect.Right - SourceRect.Left,
|
---|
982 | SourceRect.Bottom - SourceRect.Top);
|
---|
983 | end;
|
---|
984 |
|
---|
985 | procedure TPlayer.Paint(PaintBox: TPaintBox);
|
---|
986 | begin
|
---|
987 | Game.Map.Paint(PaintBox.Canvas, View);
|
---|
988 | end;
|
---|
989 |
|
---|
990 | constructor TPlayer.Create;
|
---|
991 | begin
|
---|
992 | View := TView.Create;
|
---|
993 | StartUnits := DefaultPlayerStartUnits;
|
---|
994 | end;
|
---|
995 |
|
---|
996 | destructor TPlayer.Destroy;
|
---|
997 | begin
|
---|
998 | FreeAndNil(View);
|
---|
999 | inherited Destroy;
|
---|
1000 | end;
|
---|
1001 |
|
---|
1002 | procedure TPlayer.Assign(Source: TPlayer);
|
---|
1003 | begin
|
---|
1004 | Name := Source.Name;
|
---|
1005 | Color := Source.Color;
|
---|
1006 | Mode := Source.Mode;
|
---|
1007 | Game := Source.Game;
|
---|
1008 | TotalCells := Source.TotalCells;
|
---|
1009 | TotalUnits := Source.TotalUnits;
|
---|
1010 | StartUnits := Source.StartUnits;
|
---|
1011 | View.Assign(Source.View);
|
---|
1012 | end;
|
---|
1013 |
|
---|
1014 | { TGame }
|
---|
1015 |
|
---|
1016 | procedure TGame.Attack(var AttackPower, DefendPower: Integer);
|
---|
1017 | var
|
---|
1018 | AttackerRoll: Integer;
|
---|
1019 | DefenderRoll: Integer;
|
---|
1020 | begin
|
---|
1021 | if AttackPower < 1 then
|
---|
1022 | raise Exception.Create('Attacker power have to be higher then 0.');
|
---|
1023 | if DefendPower < 0 then
|
---|
1024 | raise Exception.Create('Defender power have to be higher then or equal to 0.');
|
---|
1025 | while (AttackPower > 0) and (DefendPower > 0) do begin
|
---|
1026 | // Earch side do dice roll and compare result. Defender wins tie
|
---|
1027 | AttackerRoll := Random(6);
|
---|
1028 | DefenderRoll := Random(6);
|
---|
1029 | if AttackerRoll > DefenderRoll then Dec(DefendPower)
|
---|
1030 | else Dec(AttackPower);
|
---|
1031 | end;
|
---|
1032 | end;
|
---|
1033 |
|
---|
1034 | procedure TGame.MoveAll(Player: TPlayer);
|
---|
1035 | var
|
---|
1036 | I: Integer;
|
---|
1037 | Remain: Integer;
|
---|
1038 | AttackerPower: Integer;
|
---|
1039 | DefenderPower: Integer;
|
---|
1040 | begin
|
---|
1041 | I := 0;
|
---|
1042 | while I < Moves.Count do
|
---|
1043 | with TMove(Moves[I]) do begin
|
---|
1044 | if CountOnce > 0 then begin
|
---|
1045 | if CellFrom.Player = Player then begin
|
---|
1046 | if CellTo.Player = Player then begin
|
---|
1047 | // Inner move
|
---|
1048 | CellTo.Power := CellTo.Power + CountOnce;
|
---|
1049 | end else begin
|
---|
1050 | AttackerPower := CountOnce;
|
---|
1051 | DefenderPower := CellTo.Power;
|
---|
1052 | Attack(AttackerPower, DefenderPower);
|
---|
1053 | if DefenderPower = 0 then begin
|
---|
1054 | // Attacker wins with possible loses
|
---|
1055 | ClearMovesFromCell(CellTo);
|
---|
1056 | CellTo.Player := Player;
|
---|
1057 | CellTo.Power := AttackerPower;
|
---|
1058 | end else
|
---|
1059 | if AttackerPower = 0 then begin
|
---|
1060 | // Defender wins with possible loses
|
---|
1061 | CellTo.Power := DefenderPower;
|
---|
1062 | end else
|
---|
1063 | raise Exception.Create(SUnfinishedBattle);
|
---|
1064 | end;
|
---|
1065 | CellFrom.Power := CellFrom.Power - CountOnce;
|
---|
1066 | CountOnce := 0;
|
---|
1067 | end;
|
---|
1068 | end;
|
---|
1069 | Inc(I);
|
---|
1070 | end;
|
---|
1071 | // Remove empty moves
|
---|
1072 | for I := Moves.Count - 1 downto 0 do
|
---|
1073 | if (TMove(Moves[I]).CellFrom.Player = Player) and
|
---|
1074 | (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then
|
---|
1075 | Moves.Delete(I);
|
---|
1076 | end;
|
---|
1077 |
|
---|
1078 | procedure TGame.ClearMovesFromCell(Cell: TCell);
|
---|
1079 | var
|
---|
1080 | I: Integer;
|
---|
1081 | begin
|
---|
1082 | for I := Moves.Count - 1 downto 0 do
|
---|
1083 | if TMove(Moves[I]).CellFrom = Cell then
|
---|
1084 | Moves.Delete(I);
|
---|
1085 | end;
|
---|
1086 |
|
---|
1087 | procedure TGame.SetMapType(AValue: TMapType);
|
---|
1088 | var
|
---|
1089 | OldMap: TMap;
|
---|
1090 | begin
|
---|
1091 | if FMapType = AValue then Exit;
|
---|
1092 | OldMap := Map;
|
---|
1093 | case AValue of
|
---|
1094 | mtNone: Map := TMap.Create;
|
---|
1095 | mtHexagon: Map := THexMap.Create;
|
---|
1096 | mtSquare: Map := TSquareMap.Create;
|
---|
1097 | end;
|
---|
1098 | Map.Assign(OldMap);
|
---|
1099 | OldMap.Free;
|
---|
1100 | FMapType := AValue;
|
---|
1101 | end;
|
---|
1102 |
|
---|
1103 | procedure TGame.SetMove(CellFrom, CellTo: TCell; Power: Integer);
|
---|
1104 | var
|
---|
1105 | NewMove: TMove;
|
---|
1106 | OldMove: TMove;
|
---|
1107 | I: Integer;
|
---|
1108 | CountOnce: Integer;
|
---|
1109 | CountRepeat: Integer;
|
---|
1110 | Confirm: Boolean;
|
---|
1111 | begin
|
---|
1112 | I := 0;
|
---|
1113 | while (I < Moves.Count) and ((TMove(Moves[I]).CellFrom <> CellFrom) or
|
---|
1114 | (TMove(Moves[I]).CellTo <> CellTo)) do Inc(I);
|
---|
1115 | if I < Moves.Count then OldMove := TMove(Moves[I])
|
---|
1116 | else OldMove := nil;
|
---|
1117 | if Assigned(OldMove) then begin
|
---|
1118 | CountOnce := OldMove.CountOnce;
|
---|
1119 | CountRepeat := OldMove.CountRepeat;
|
---|
1120 | if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
|
---|
1121 | Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
|
---|
1122 | end else begin
|
---|
1123 | CountOnce := Power;
|
---|
1124 | CountRepeat := 0;
|
---|
1125 | if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
|
---|
1126 | Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
|
---|
1127 | end;
|
---|
1128 | if Confirm then begin
|
---|
1129 | if Assigned(OldMove) then begin
|
---|
1130 | // Already have such move
|
---|
1131 | if (CountOnce = 0) and (CountRepeat = 0) then Moves.Delete(I)
|
---|
1132 | else begin
|
---|
1133 | TMove(Moves[I]).CountOnce := CountOnce;
|
---|
1134 | TMove(Moves[I]).CountRepeat := CountRepeat;
|
---|
1135 | end;
|
---|
1136 | end else begin
|
---|
1137 | // Add new move
|
---|
1138 | if (CountOnce > 0) or (CountRepeat > 0) then begin
|
---|
1139 | NewMove := TMove(Moves[Moves.Add(TMove.Create)]);
|
---|
1140 | NewMove.List := Moves;
|
---|
1141 | NewMove.CellFrom := CellFrom;
|
---|
1142 | NewMove.CellTo := CellTo;
|
---|
1143 | NewMove.CountOnce := CountOnce;
|
---|
1144 | NewMove.CountRepeat := CountRepeat;
|
---|
1145 | end;
|
---|
1146 | end;
|
---|
1147 | end;
|
---|
1148 | end;
|
---|
1149 |
|
---|
1150 | procedure TGame.SetRunning(AValue: Boolean);
|
---|
1151 | var
|
---|
1152 | I: Integer;
|
---|
1153 | begin
|
---|
1154 | if FRunning = AValue then Exit;
|
---|
1155 | if AValue then begin
|
---|
1156 | if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
|
---|
1157 | FRunning := AValue;
|
---|
1158 | end else begin
|
---|
1159 | FRunning := AValue;
|
---|
1160 | for I := 0 to Players.Count - 1 do
|
---|
1161 | with TPlayer(Players[I]) do begin
|
---|
1162 | View.Clear;
|
---|
1163 | end;
|
---|
1164 | end;
|
---|
1165 | end;
|
---|
1166 |
|
---|
1167 | procedure TGame.UpdateRepeatMoves(Player: TPlayer);
|
---|
1168 | var
|
---|
1169 | I: Integer;
|
---|
1170 | begin
|
---|
1171 | for I := 0 to Moves.Count - 1 do
|
---|
1172 | with TMove(Moves[I]) do begin
|
---|
1173 | if CellFrom.Player = Player then
|
---|
1174 | if CountRepeat <= CellFrom.GetAvialPower then
|
---|
1175 | CountOnce := CountRepeat
|
---|
1176 | else CountOnce := CellFrom.GetAvialPower;
|
---|
1177 | end;
|
---|
1178 | end;
|
---|
1179 |
|
---|
1180 |
|
---|
1181 | procedure TGame.ComputePlayerStats;
|
---|
1182 | var
|
---|
1183 | I: Integer;
|
---|
1184 | begin
|
---|
1185 | for I := 0 to Players.Count - 1 do
|
---|
1186 | with TPlayer(Players[I]) do begin
|
---|
1187 | TotalUnits := 0;
|
---|
1188 | TotalCells := 0;
|
---|
1189 | end;
|
---|
1190 | Map.ComputePlayerStats;
|
---|
1191 | end;
|
---|
1192 |
|
---|
1193 | function TGame.GetAlivePlayers: TPlayerArray;
|
---|
1194 | var
|
---|
1195 | I: Integer;
|
---|
1196 | begin
|
---|
1197 | SetLength(Result, 0);
|
---|
1198 | for I := 0 to Players.Count - 1 do
|
---|
1199 | if TPlayer(Players[I]).TotalCells > 0 then begin
|
---|
1200 | SetLength(Result, Length(Result) + 1);
|
---|
1201 | Result[Length(Result) - 1] := TPlayer(Players[I]);
|
---|
1202 | end;
|
---|
1203 | end;
|
---|
1204 |
|
---|
1205 | procedure TGame.NextTurn;
|
---|
1206 | var
|
---|
1207 | PrevPlayer: TPlayer;
|
---|
1208 | AlivePlayers: TPlayerArray;
|
---|
1209 | begin
|
---|
1210 | MoveAll(CurrentPlayer);
|
---|
1211 | Map.Grow(CurrentPlayer);
|
---|
1212 | ComputePlayerStats;
|
---|
1213 | PrevPlayer := CurrentPlayer;
|
---|
1214 | // Skip dead players
|
---|
1215 | repeat
|
---|
1216 | CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]);
|
---|
1217 | until CurrentPlayer.TotalCells > 0;
|
---|
1218 | if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then Inc(TurnCounter);
|
---|
1219 | AlivePlayers := GetAlivePlayers;
|
---|
1220 | if (Length(AlivePlayers) <= 1) then begin
|
---|
1221 | Running := False;
|
---|
1222 | if Assigned(OnWin) and (Length(AlivePlayers) > 0) then OnWin(TPlayer(AlivePlayers[0]));
|
---|
1223 | end;
|
---|
1224 | UpdateRepeatMoves(CurrentPlayer);
|
---|
1225 | // For computers take view from previous human
|
---|
1226 | if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);
|
---|
1227 | end;
|
---|
1228 |
|
---|
1229 | constructor TGame.Create;
|
---|
1230 | var
|
---|
1231 | Player: TPlayer;
|
---|
1232 | begin
|
---|
1233 | Moves := TObjectList.Create;
|
---|
1234 | Map := TMap.Create;
|
---|
1235 | Players := TPlayers.Create;
|
---|
1236 |
|
---|
1237 | Randomize;
|
---|
1238 |
|
---|
1239 | Player := TPlayer.Create;
|
---|
1240 | Player.Name := 'Player 1';
|
---|
1241 | Player.Game := Self;
|
---|
1242 | Player.Color := clBlue;
|
---|
1243 | Players.Add(Player);
|
---|
1244 | Player := TPlayer.Create;
|
---|
1245 | Player.Name := 'Player 2';
|
---|
1246 | Player.Game := Self;
|
---|
1247 | Player.Color := clRed;
|
---|
1248 | Player.Mode := pmComputer;
|
---|
1249 | Players.Add(Player);
|
---|
1250 |
|
---|
1251 | VoidEnabled := True;
|
---|
1252 | VoidPercentage := 20;
|
---|
1253 |
|
---|
1254 | Map.Game := Self;
|
---|
1255 | MapType := mtHexagon;
|
---|
1256 | Map.Size := Point(3, 3);
|
---|
1257 | end;
|
---|
1258 |
|
---|
1259 | destructor TGame.Destroy;
|
---|
1260 | begin
|
---|
1261 | FreeAndNil(Moves);
|
---|
1262 | FreeAndNil(Players);
|
---|
1263 | FreeAndNil(Map);
|
---|
1264 | inherited Destroy;
|
---|
1265 | end;
|
---|
1266 |
|
---|
1267 | procedure TGame.New;
|
---|
1268 | var
|
---|
1269 | X, Y: Integer;
|
---|
1270 | NewCell: TCell;
|
---|
1271 | I: Integer;
|
---|
1272 | StartCell: TCell;
|
---|
1273 | Counter: Integer;
|
---|
1274 | AllCells: TCellArray;
|
---|
1275 | C: Integer;
|
---|
1276 | begin
|
---|
1277 | TurnCounter := 1;
|
---|
1278 | Moves.Clear;
|
---|
1279 | AllCells := Map.GetAllCells;
|
---|
1280 | for C := 0 to Length(AllCells) - 1 do
|
---|
1281 | with AllCells[C] do begin
|
---|
1282 | if VoidEnabled and (Random < VoidPercentage / 100) then Terrain := ttVoid
|
---|
1283 | else begin
|
---|
1284 | if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
|
---|
1285 | else Terrain := ttNormal;
|
---|
1286 | end;
|
---|
1287 | Power := Random(4);
|
---|
1288 | Player := nil;
|
---|
1289 | end;
|
---|
1290 | for I := 0 to Players.Count - 1 do
|
---|
1291 | with TPlayer(Players[I]) do begin
|
---|
1292 | View.Clear;
|
---|
1293 | if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
|
---|
1294 | // Try to obtain start cell for each player
|
---|
1295 | StartCell := nil;
|
---|
1296 | Counter := 0;
|
---|
1297 | while not Assigned(StartCell) or Assigned(StartCell.Player) do begin
|
---|
1298 | StartCell := AllCells[Random(Length(AllCells))];
|
---|
1299 | Inc(Counter);
|
---|
1300 | if Counter > 100 then
|
---|
1301 | raise Exception.Create(SCannotSetPlayerStartCells);
|
---|
1302 | end;
|
---|
1303 | if CityEnabled then StartCell.Terrain := ttCity
|
---|
1304 | else StartCell.Terrain := ttNormal;
|
---|
1305 | StartCell.Player := TPlayer(Players[I]);
|
---|
1306 | StartCell.Power := TPlayer(Players[I]).StartUnits;
|
---|
1307 | end;
|
---|
1308 | View.Zoom := 1;
|
---|
1309 | View.CenterMap;
|
---|
1310 | end;
|
---|
1311 | CurrentPlayer := TPlayer(Players[0]);
|
---|
1312 | end;
|
---|
1313 |
|
---|
1314 | { THexMap }
|
---|
1315 |
|
---|
1316 | function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
|
---|
1317 | var
|
---|
1318 | HexShift: TFloatPoint;
|
---|
1319 | begin
|
---|
1320 | HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
|
---|
1321 | SetLength(Result, 6);
|
---|
1322 | Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
|
---|
1323 | Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
|
---|
1324 | Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
|
---|
1325 | Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
|
---|
1326 | Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
|
---|
1327 | Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
|
---|
1328 | end;
|
---|
1329 |
|
---|
1330 | function THexMap.GetSize: TPoint;
|
---|
1331 | begin
|
---|
1332 | Result := FSize;
|
---|
1333 | end;
|
---|
1334 |
|
---|
1335 | procedure THexMap.SetSize(AValue: TPoint);
|
---|
1336 | var
|
---|
1337 | X, Y: Integer;
|
---|
1338 | NewCell: TCell;
|
---|
1339 | C: Integer;
|
---|
1340 | begin
|
---|
1341 | if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
|
---|
1342 | // Free previous
|
---|
1343 | for Y := 0 to FSize.Y - 1 do
|
---|
1344 | for X := 0 to FSize.X - 1 do begin
|
---|
1345 | TCell(Cells[Y, X]).Destroy;
|
---|
1346 | end;
|
---|
1347 | FSize := AValue;
|
---|
1348 | // Allocate and init new
|
---|
1349 | SetLength(Cells, FSize.Y, FSize.X);
|
---|
1350 | for Y := 0 to FSize.Y - 1 do
|
---|
1351 | for X := 0 to FSize.X - 1 do begin
|
---|
1352 | NewCell := TCell.Create;
|
---|
1353 | NewCell.Pos := Point(X, Y);
|
---|
1354 | Cells[Y, X] := NewCell;
|
---|
1355 | end;
|
---|
1356 | end;
|
---|
1357 | end;
|
---|
1358 |
|
---|
1359 | function THexMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
|
---|
1360 | var
|
---|
1361 | DX: Integer;
|
---|
1362 | DY: Integer;
|
---|
1363 | MinY: Integer;
|
---|
1364 | begin
|
---|
1365 | if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y
|
---|
1366 | else MinY := Cell2.Pos.Y;
|
---|
1367 | DX := Cell2.Pos.X - Cell1.Pos.X;
|
---|
1368 | DY := Cell2.Pos.Y - Cell1.Pos.Y;
|
---|
1369 | Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
|
---|
1370 | ((((MinY mod 2) = 1) and
|
---|
1371 | not ((DX = 1) and (DY = -1)) and
|
---|
1372 | not ((DX = -1) and (DY = 1))) or
|
---|
1373 | (((MinY mod 2) = 0) and
|
---|
1374 | not ((DX = -1) and (DY = -1)) and
|
---|
1375 | not ((DX = 1) and (DY = 1))));
|
---|
1376 | Result := Result and not (Cell1 = Cell2);
|
---|
1377 | end;
|
---|
1378 |
|
---|
1379 | procedure THexMap.Assign(Source: TMap);
|
---|
1380 | begin
|
---|
1381 | end;
|
---|
1382 |
|
---|
1383 | function THexMap.IsValidIndex(Index: TPoint): Boolean;
|
---|
1384 | begin
|
---|
1385 | Result := (Index.X >= 0) and (Index.X < Size.X) and
|
---|
1386 | (Index.Y >= 0) and (Index.Y < Size.Y);
|
---|
1387 | end;
|
---|
1388 |
|
---|
1389 | function THexMap.GetCellNeighbours(Cell: TCell): TCellArray;
|
---|
1390 | var
|
---|
1391 | X, Y: Integer;
|
---|
1392 | begin
|
---|
1393 | SetLength(Result, 0);
|
---|
1394 | for Y := -1 to 1 do
|
---|
1395 | for X := -1 to 1 do
|
---|
1396 | if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and
|
---|
1397 | IsCellsNeighbor(Cell, Cells[Cell.Pos.Y + Y, Cell.Pos.X + X]) then begin
|
---|
1398 | SetLength(Result, Length(Result) + 1);
|
---|
1399 | Result[Length(Result) - 1] := Cells[Cell.Pos.Y + Y, Cell.Pos.X + X];
|
---|
1400 | end;
|
---|
1401 | end;
|
---|
1402 |
|
---|
1403 | function THexMap.PosToCell(Pos: TPoint; View: TView): TCell;
|
---|
1404 | var
|
---|
1405 | CX, CY: Integer;
|
---|
1406 | X, Y: Double;
|
---|
1407 | HexSize: TFloatPoint;
|
---|
1408 | CellSize: TFloatPoint;
|
---|
1409 | Points: TPointArray;
|
---|
1410 | begin
|
---|
1411 | // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
|
---|
1412 | Result := nil;
|
---|
1413 | CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
|
---|
1414 | HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
|
---|
1415 | with View do
|
---|
1416 | for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
|
---|
1417 | for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
|
---|
1418 | X := CX;
|
---|
1419 | Y := CY;
|
---|
1420 | if (CY and 1) = 1 then begin
|
---|
1421 | X := X + 0.5;
|
---|
1422 | //Y := Y + 0.5;
|
---|
1423 | end;
|
---|
1424 | if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
|
---|
1425 | if Cells[CY, CX].Terrain <> ttVoid then begin
|
---|
1426 | Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X),
|
---|
1427 | Trunc(Y * CellSize.Y)),
|
---|
1428 | Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
|
---|
1429 | if PtInPoly(Points, Pos) then begin
|
---|
1430 | Result := Cells[CY, CX];
|
---|
1431 | Exit;
|
---|
1432 | end;
|
---|
1433 | end;
|
---|
1434 | end;
|
---|
1435 | end;
|
---|
1436 |
|
---|
1437 | function THexMap.CellToPos(Cell: TCell): TPoint;
|
---|
1438 | var
|
---|
1439 | CX, CY: Integer;
|
---|
1440 | X, Y: Double;
|
---|
1441 | HexSize: TFloatPoint;
|
---|
1442 | CellSize: TFloatPoint;
|
---|
1443 | Points: array of TPoint;
|
---|
1444 | begin
|
---|
1445 | CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
|
---|
1446 | HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
|
---|
1447 | X := Cell.Pos.X;
|
---|
1448 | Y := Cell.Pos.Y;
|
---|
1449 | if (Cell.Pos.Y and 1) = 1 then begin
|
---|
1450 | X := X + 0.5;
|
---|
1451 | //Y := Y + 0.5;
|
---|
1452 | end;
|
---|
1453 |
|
---|
1454 | Result.X := Trunc(X * CellSize.X);
|
---|
1455 | Result.Y := Trunc(Y * CellSize.Y);
|
---|
1456 | end;
|
---|
1457 |
|
---|
1458 | procedure THexMap.Paint(Canvas: TCanvas; View: TView);
|
---|
1459 | var
|
---|
1460 | CX, CY: Integer;
|
---|
1461 | X, Y: Double;
|
---|
1462 | CellSizeZoomed: TFloatPoint;
|
---|
1463 | CellSize: TFloatPoint;
|
---|
1464 | HexSize: TFloatPoint;
|
---|
1465 | I: Integer;
|
---|
1466 | Points: array of TPoint;
|
---|
1467 | Cell: TCell;
|
---|
1468 | PosFrom, PosTo: TPoint;
|
---|
1469 | Angle: Double;
|
---|
1470 |
|
---|
1471 | procedure PaintHexagon(Pos: TPoint; Text: string);
|
---|
1472 | var
|
---|
1473 | Points: TPointArray;
|
---|
1474 | begin
|
---|
1475 | with Canvas do begin
|
---|
1476 | if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin
|
---|
1477 | Pen.Color := clYellow;
|
---|
1478 | Pen.Style := psSolid;
|
---|
1479 | Pen.Width := 1;
|
---|
1480 | end else
|
---|
1481 | if TCell(Cells[CY, CX]).Terrain = ttCity then begin
|
---|
1482 | // Cannot set clear border as it will display shifted on gtk2
|
---|
1483 | //Pen.Style := psClear;
|
---|
1484 | Pen.Color := clBlack;
|
---|
1485 | Pen.Style := psSolid;
|
---|
1486 | Pen.Width := 3;
|
---|
1487 | end else begin
|
---|
1488 | // Cannot set clear border as it will display shifted on gtk2
|
---|
1489 | //Pen.Style := psClear;
|
---|
1490 | Pen.Color := Brush.Color;
|
---|
1491 | Pen.Style := psSolid;
|
---|
1492 | Pen.Width := 0;
|
---|
1493 | end;
|
---|
1494 | Points := GetHexagonPolygon(Point(Trunc(Pos.X), Trunc(Pos.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
|
---|
1495 | Polygon(Points);
|
---|
1496 | //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
|
---|
1497 | Pen.Style := psSolid;
|
---|
1498 | Font.Color := clWhite;
|
---|
1499 | Font.Size := Trunc(12 * View.Zoom);
|
---|
1500 | TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
|
---|
1501 | end;
|
---|
1502 | end;
|
---|
1503 |
|
---|
1504 | begin
|
---|
1505 | CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
|
---|
1506 | HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
|
---|
1507 | CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
|
---|
1508 | with Canvas, View do
|
---|
1509 | try
|
---|
1510 | Lock;
|
---|
1511 | for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
|
---|
1512 | for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
|
---|
1513 | X := CX;
|
---|
1514 | Y := CY;
|
---|
1515 | if (CY and 1) = 1 then begin
|
---|
1516 | X := X + 0.5;
|
---|
1517 | //Y := Y + 0.5;
|
---|
1518 | end;
|
---|
1519 | if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
|
---|
1520 | Cell := Cells[CY, CX];
|
---|
1521 | if Cell.Terrain <> ttVoid then begin
|
---|
1522 | if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY, CX])) then Brush.Color := clGreen
|
---|
1523 | else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY, CX])) then Brush.Color := clPurple
|
---|
1524 | else Brush.Color := Cell.GetColor;
|
---|
1525 | Pen.Color := clBlack;
|
---|
1526 | PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
|
---|
1527 | Trunc(Y * CellSize.Y))),
|
---|
1528 | IntToStr(Cell.GetAvialPower));
|
---|
1529 | // Draw arrows
|
---|
1530 | Pen.Color := clCream;
|
---|
1531 | for I := 0 to Cell.MovesFrom.Count - 1 do begin
|
---|
1532 | PosFrom := CellToPos(Cell);
|
---|
1533 | PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
|
---|
1534 | if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
|
---|
1535 | else Pen.Width := 1;
|
---|
1536 | Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
|
---|
1537 | if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
|
---|
1538 | DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
|
---|
1539 | Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
|
---|
1540 | Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
|
---|
1541 | Pen.Width := 1;
|
---|
1542 | end;
|
---|
1543 | end;
|
---|
1544 | end;
|
---|
1545 | end;
|
---|
1546 | finally
|
---|
1547 | Unlock;
|
---|
1548 | end;
|
---|
1549 | end;
|
---|
1550 |
|
---|
1551 | constructor THexMap.Create;
|
---|
1552 | begin
|
---|
1553 | inherited;
|
---|
1554 | end;
|
---|
1555 |
|
---|
1556 | destructor THexMap.Destroy;
|
---|
1557 | begin
|
---|
1558 | inherited Destroy;
|
---|
1559 | end;
|
---|
1560 |
|
---|
1561 | function THexMap.GetAllCells: TCellArray;
|
---|
1562 | var
|
---|
1563 | X: Integer;
|
---|
1564 | Y: Integer;
|
---|
1565 | I: Integer;
|
---|
1566 | TempSize: TPoint;
|
---|
1567 | begin
|
---|
1568 | TempSize := Size;
|
---|
1569 | SetLength(Result, TempSize.Y * TempSize.X);
|
---|
1570 | for Y := 0 to TempSize.Y - 1 do
|
---|
1571 | for X := 0 to TempSize.X - 1 do
|
---|
1572 | Result[Y * TempSize.X + X] := Cells[Y, X];
|
---|
1573 | end;
|
---|
1574 |
|
---|
1575 | function THexMap.GetPixelRect: TRect;
|
---|
1576 | begin
|
---|
1577 | Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
|
---|
1578 | Trunc(-0.5 * DefaultCellSize.Y),
|
---|
1579 | Trunc((Size.X + 0.5) * DefaultCellSize.X),
|
---|
1580 | Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
|
---|
1581 | end;
|
---|
1582 |
|
---|
1583 | end.
|
---|
1584 |
|
---|