1 | unit Engine;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, RegistryEx, Common,
|
---|
7 | IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, Rectangle,
|
---|
8 | Syncobjs, Threading, Forms, DateUtils, AudioSystem, Generics.Collections,
|
---|
9 | World, Matter, Sound;
|
---|
10 |
|
---|
11 | const
|
---|
12 | MaxBulletCount = 10;
|
---|
13 | EnergyDecreaseDig = 0;
|
---|
14 | EnergyDecreaseMove = 0.00025; // ~2.5 minutes of movement
|
---|
15 | EnergyDecreaseShoot = 0.005; // ~20 seconds of shooting
|
---|
16 | EnergyDecreaseOutside = 0.00003; // ~5 minutes of live
|
---|
17 | EnergyIncreaseHome = 0.001;
|
---|
18 | ShieldIncreaseHome = 0.001;
|
---|
19 | ShieldDecreaseHit = 0.15;
|
---|
20 | ExplosionBulletCount = 100;
|
---|
21 | ExplosionRange = 20;
|
---|
22 | ExplosionBulletMaxSpeed = 0.5;
|
---|
23 | ExplosionBulletMinSpeed = 0.2;
|
---|
24 | BulletExplosionRange = 4;
|
---|
25 | ShootDelay = 0.1; // seconds
|
---|
26 | DigDelay = 0.2; // seconds
|
---|
27 | ShootDigDelay = 0.05; // seconds
|
---|
28 | MoveDelay = 0.05; // seconds
|
---|
29 | PlayerFrameWidth = 80;
|
---|
30 | PlayerFrameHeight = 80;
|
---|
31 | PlayerHouseSize = 29;
|
---|
32 | PlayerHouseDoorSize = 7;
|
---|
33 | ExplosionDelay = 2;
|
---|
34 | NewRoundDelay = 2;
|
---|
35 | clTuna = $5555ff;
|
---|
36 | clPurple = $aa00aa;
|
---|
37 | clOrange = $0055aa;
|
---|
38 | clDarkOrange = $0000aa;
|
---|
39 | clDarkGreen = $00aa00;
|
---|
40 | clCyan = $ffff00;
|
---|
41 |
|
---|
42 | type
|
---|
43 | TEngine = class;
|
---|
44 | TPlayer = class;
|
---|
45 |
|
---|
46 | TRealPoint = record
|
---|
47 | X, Y: Real;
|
---|
48 | end;
|
---|
49 |
|
---|
50 | TPlayerKeys = record
|
---|
51 | Left: Word;
|
---|
52 | Right: Word;
|
---|
53 | Up: Word;
|
---|
54 | Down: Word;
|
---|
55 | Shoot: Word;
|
---|
56 | end;
|
---|
57 |
|
---|
58 | { TBullet }
|
---|
59 |
|
---|
60 | TBullet = class
|
---|
61 | Player: TPlayer;
|
---|
62 | Position: TRealPoint;
|
---|
63 | PositionTail: TRealPoint;
|
---|
64 | Direction: TRealPoint;
|
---|
65 | MaxDistance: Integer;
|
---|
66 | Distance: Real;
|
---|
67 | StopByDirt: Boolean;
|
---|
68 | CanKill: Boolean;
|
---|
69 | constructor Create;
|
---|
70 | end;
|
---|
71 |
|
---|
72 | { TBullets }
|
---|
73 |
|
---|
74 | TBullets = class(TObjectList<TBullet>)
|
---|
75 | procedure HideAll;
|
---|
76 | end;
|
---|
77 |
|
---|
78 | { TTank }
|
---|
79 |
|
---|
80 | TTank = class
|
---|
81 | Image: TMatrixByte;
|
---|
82 | Mask: TMatrixByte;
|
---|
83 | procedure Assign(Source: TTank);
|
---|
84 | constructor Create;
|
---|
85 | destructor Destroy; override;
|
---|
86 | end;
|
---|
87 |
|
---|
88 | { TTanks }
|
---|
89 |
|
---|
90 | TTanks = class(TObjectList<TTank>)
|
---|
91 | procedure Assign(Source: TTanks);
|
---|
92 | end;
|
---|
93 |
|
---|
94 | TColisionState = record
|
---|
95 | Blocking: Boolean;
|
---|
96 | Diggable: Boolean;
|
---|
97 | end;
|
---|
98 |
|
---|
99 | { TPlayer }
|
---|
100 |
|
---|
101 | TPlayer = class
|
---|
102 | private
|
---|
103 | FExploded: Boolean;
|
---|
104 | NewDirection: Integer;
|
---|
105 | NewPosition: TPoint;
|
---|
106 | Dig: Boolean;
|
---|
107 | LastPos: TPoint;
|
---|
108 | ExplosionPending: Boolean;
|
---|
109 | ExplosionTime: TDateTime;
|
---|
110 | procedure SetExploded(const AValue: Boolean);
|
---|
111 | function ShowTankProc(Item1, Item2: Byte): Byte;
|
---|
112 | function HideTankProc(Item1, Item2: Byte): Byte;
|
---|
113 | function DigProc(Item1, Item2: Byte): Byte;
|
---|
114 | public
|
---|
115 | Name: string;
|
---|
116 | Color1: TColor;
|
---|
117 | Color2: TColor;
|
---|
118 | Id: Integer;
|
---|
119 | Enabled: Boolean;
|
---|
120 | Engine: TEngine;
|
---|
121 | Position: TPoint;
|
---|
122 | StartPosition: TPoint;
|
---|
123 | Score: Integer;
|
---|
124 | Direction: Integer;
|
---|
125 | ScreenFrame: TRectangle;
|
---|
126 | Keys: TPlayerKeys;
|
---|
127 | Tanks: TTanks;
|
---|
128 | Bullets: TBullets;
|
---|
129 | LastShootTime: TDateTime;
|
---|
130 | LastDigTime: TDateTime;
|
---|
131 | LastMoveTime: TDateTime;
|
---|
132 | Energy: Real;
|
---|
133 | LastEnergy: Real;
|
---|
134 | Shield: Real;
|
---|
135 | LastShield: Real;
|
---|
136 | House: TRectangle;
|
---|
137 | ShotsCount: Integer;
|
---|
138 | ShotsHit: Integer;
|
---|
139 | MetersDug: Integer;
|
---|
140 | MetersTravelled: Integer;
|
---|
141 | procedure ResetTank;
|
---|
142 | procedure Init;
|
---|
143 | procedure Explosion(Position: TPoint; Distance: Integer);
|
---|
144 | procedure Control;
|
---|
145 | function CheckNewDestination: Boolean;
|
---|
146 | procedure Tick;
|
---|
147 | procedure Paint;
|
---|
148 | procedure PlaceHouse;
|
---|
149 | function CheckColision: TColisionState;
|
---|
150 | procedure ShowTank;
|
---|
151 | procedure HideTank;
|
---|
152 | procedure InitTanks;
|
---|
153 | constructor Create;
|
---|
154 | destructor Destroy; override;
|
---|
155 | procedure Assign(Source: TPlayer);
|
---|
156 | procedure LoadFromRegistry(Context: TRegistryContext);
|
---|
157 | procedure SaveToRegistry(Context: TRegistryContext);
|
---|
158 | property Exploded: Boolean read FExploded write SetExploded;
|
---|
159 | end;
|
---|
160 |
|
---|
161 | { TPlayers }
|
---|
162 |
|
---|
163 | TPlayers = class(TObjectList<TPlayer>)
|
---|
164 | Engine: TEngine;
|
---|
165 | function AddNew: TPlayer;
|
---|
166 | procedure Assign(Players: TPlayers);
|
---|
167 | procedure LoadFromRegistry(Context: TRegistryContext);
|
---|
168 | procedure SaveToRegistry(Context: TRegistryContext);
|
---|
169 | function GetAliveCount: Integer;
|
---|
170 | function GetWinner: TPlayer;
|
---|
171 | function GetEnabledCount: Integer;
|
---|
172 | procedure EnableMore;
|
---|
173 | procedure EnableLess;
|
---|
174 | end;
|
---|
175 |
|
---|
176 | { TKeyboard }
|
---|
177 |
|
---|
178 | TKeyboard = class
|
---|
179 | KeyState: array[0..High(Word)] of Boolean;
|
---|
180 | procedure ClearAll;
|
---|
181 | end;
|
---|
182 |
|
---|
183 | { TSystemThread }
|
---|
184 |
|
---|
185 | TSystemThread = class(TListedThread)
|
---|
186 | Engine: TEngine;
|
---|
187 | procedure Execute; override;
|
---|
188 | end;
|
---|
189 |
|
---|
190 | { TDrawThread }
|
---|
191 |
|
---|
192 | TDrawThread = class(TListedThread)
|
---|
193 | private
|
---|
194 | procedure DrawSync;
|
---|
195 | public
|
---|
196 | Engine: TEngine;
|
---|
197 | procedure Execute; override;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | TCanvasMethod = procedure (Canvas: TCanvas) of object;
|
---|
201 |
|
---|
202 | TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
|
---|
203 | gsInstructions, gsSettings);
|
---|
204 |
|
---|
205 | { TEngine }
|
---|
206 |
|
---|
207 | TEngine = class(TComponent)
|
---|
208 | private
|
---|
209 | FActive: Boolean;
|
---|
210 | FBitmap: TBitmap;
|
---|
211 | FBitmapLock: TCriticalSection;
|
---|
212 | FOnClose: TNotifyEvent;
|
---|
213 | FOnGameEnd: TNotifyEvent;
|
---|
214 | FRedrawPending: Boolean;
|
---|
215 | FBitmapLower: TBitmapTColor;
|
---|
216 | FDrawThread: TDrawThread;
|
---|
217 | FState: TGameState;
|
---|
218 | FSystemThread: TSystemThread;
|
---|
219 | FClearBackground: Boolean;
|
---|
220 | FStateTime: TDateTime;
|
---|
221 | FShowMenuStats: Boolean;
|
---|
222 | procedure InitDigMasks;
|
---|
223 | procedure SetActive(const AValue: Boolean);
|
---|
224 | procedure SetBitmap(const AValue: TBitmap);
|
---|
225 | function IsInsideHouses(Pos: TPoint): Boolean;
|
---|
226 | procedure InitPlayers;
|
---|
227 | procedure CheckGameEnd;
|
---|
228 | procedure ClearBackground;
|
---|
229 | procedure DrawMenu;
|
---|
230 | procedure DrawStats;
|
---|
231 | procedure DrawGamePrepare(Thread: TVirtualThread);
|
---|
232 | procedure DrawGame;
|
---|
233 | procedure DrawInformation;
|
---|
234 | procedure DrawInstructions;
|
---|
235 | procedure DrawSettings;
|
---|
236 | procedure DrawNewRound;
|
---|
237 | procedure DrawMap;
|
---|
238 | procedure SetState(AValue: TGameState);
|
---|
239 | procedure ShowMenuItem(Key, Text: string; X, Y: Integer; Canvas: TCanvas);
|
---|
240 | function TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
|
---|
241 | public
|
---|
242 | ThreadErrorMessage: string;
|
---|
243 | Keyboard: TKeyboard;
|
---|
244 | World: TWorld;
|
---|
245 | PlayerPool: TPlayers;
|
---|
246 | Players: TPlayers;
|
---|
247 | DigMasks: TObjectList<TMatrixByte>;
|
---|
248 | Lock: TCriticalSection;
|
---|
249 | CurrentRound: Integer;
|
---|
250 | MaxRound: Integer;
|
---|
251 | AudioShot: TSound;
|
---|
252 | AudioExplode: TSound;
|
---|
253 | DrawDuration: TDatetime;
|
---|
254 | constructor Create(AOwner: TComponent); override;
|
---|
255 | destructor Destroy; override;
|
---|
256 | procedure ResizePlayerFrames;
|
---|
257 | procedure Tick;
|
---|
258 | procedure Redraw;
|
---|
259 | procedure Draw;
|
---|
260 | procedure DrawThread(Thread: TVirtualThread);
|
---|
261 | procedure NewGame;
|
---|
262 | procedure NewRound;
|
---|
263 | procedure KeyUp(Key: Word);
|
---|
264 | procedure KeyDown(Key: Word);
|
---|
265 | procedure LoadFromRegistry(Context: TRegistryContext);
|
---|
266 | procedure SaveToRegistry(Context: TRegistryContext);
|
---|
267 | procedure InitPlayerPool;
|
---|
268 | property Bitmap: TBitmap read FBitmap write SetBitmap;
|
---|
269 | property Active: Boolean read FActive write SetActive;
|
---|
270 | property State: TGameState read FState write SetState;
|
---|
271 | property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
|
---|
272 | property OnClose: TNotifyEvent read FOnClose write FOnClose;
|
---|
273 | end;
|
---|
274 |
|
---|
275 | const
|
---|
276 | DirectionToDelta: array[0..7] of TPoint =
|
---|
277 | ((X: 0; Y: -1), (X: 1; Y: -1), (X: 1; Y: 0), (X: 1; Y: 1),
|
---|
278 | (X: 0; Y: 1), (X: -1; Y: 1), (X: -1; Y: 0), (X: -1; Y: -1));
|
---|
279 |
|
---|
280 |
|
---|
281 | implementation
|
---|
282 |
|
---|
283 | uses
|
---|
284 | Platform, FastPixel;
|
---|
285 |
|
---|
286 | resourcestring
|
---|
287 | SRound = 'Round';
|
---|
288 | SPressEsc = 'Press ESC to continue';
|
---|
289 | SStartGame = 'Start game';
|
---|
290 | SInstructions = 'Instructions';
|
---|
291 | SInstructionsDetails = 'Tunneler is a two player game. The objective of the game is to be the first to win three rounds. ' +
|
---|
292 | 'A round continues until one tank blows up (from being shot or simply running out of energy).';
|
---|
293 | SInstructionsDetails2 = 'The display: Each player has a view screen and an instrument panel with two meters. ' +
|
---|
294 | 'The view screen shows your surroundings from above (about 1% of the entire "worlds"). ' +
|
---|
295 | 'The two meters indicate the player''s energy and shield condition.';
|
---|
296 | SInstructionsDetails3 = 'The Game: Players can move in one of 8 directions. ' +
|
---|
297 | 'Movement in tunnels is three times as fast as normal digging. ' +
|
---|
298 | 'Fast digging can be accomplished by firing the tank''s cannon while moving. ' +
|
---|
299 | 'Various actions use up different amounts of energy : moving costs some energy, digging costs more, and shotting costs the most. ' +
|
---|
300 | 'Shields are damaged when hit by the other player''s cannon. ' +
|
---|
301 | 'Players can refuel at either base but can repair their shields only at their own bases.';
|
---|
302 | SInstructionsDetails4 = 'Controls: \n ' +
|
---|
303 | 'Blue: W - up, A - left, S - down, D - right, E - shoot \n ' +
|
---|
304 | 'Green: arrows key, CTRL - shoot';
|
---|
305 | SInformation = 'Information';
|
---|
306 | SInformationDetails = 'Tunneler is written from scratch in Lazarus/FPC. ' +
|
---|
307 | 'It is designed to be as similar as the original MS-DOS game (https://tunneler.org/) but also with some modern extensions. ' +
|
---|
308 | 'The program uses standard canvas drawing with combination of low resolution fast pixel matrix. ' +
|
---|
309 | 'It supports High DPI scaling. It supports up to eight players.';
|
---|
310 | SInformationDetails2 = 'This is a public domain open source program: feel free to copy it for friends and study the source code. \n ' +
|
---|
311 | 'Homepage: https://app.zdechov.net/Tunneler';
|
---|
312 | SSettings = 'Settings';
|
---|
313 | SWorldReady = 'World ready';
|
---|
314 | SExit = 'Exit';
|
---|
315 | SStatistics = 'Statistics';
|
---|
316 | SShotsFired = 'Shots fired';
|
---|
317 | SShotsHit = 'Shots hit';
|
---|
318 | SPercentHit = 'Percent hit';
|
---|
319 | SMetersDug = 'Meters dug';
|
---|
320 | SMetersTravelled = 'Meters travelled';
|
---|
321 | SWinnerIs = 'The winner is';
|
---|
322 | SGreen = 'Green';
|
---|
323 | SBlue = 'Blue';
|
---|
324 | SRed = 'Red';
|
---|
325 | SPink = 'Pink';
|
---|
326 | SCyan = 'Cyan';
|
---|
327 | SYellow = 'Yellow';
|
---|
328 | SOrange = 'Orange';
|
---|
329 | SGray = 'Gray';
|
---|
330 | SMorePlayers = 'More players';
|
---|
331 | SLessPlayers = 'Less players';
|
---|
332 | SBack = 'Back';
|
---|
333 | SPlayersCount = 'Players count';
|
---|
334 |
|
---|
335 | { TBullets }
|
---|
336 |
|
---|
337 | procedure TBullets.HideAll;
|
---|
338 | var
|
---|
339 | I: Integer;
|
---|
340 | begin
|
---|
341 | for I := 0 to Count - 1 do
|
---|
342 | with Items[I] do begin
|
---|
343 | Player.Engine.World.Surface.ItemsXY[Trunc(Position.X), Trunc(Position.Y)] := Byte(miSpace);
|
---|
344 | Player.Engine.World.Surface.ItemsXY[Trunc(PositionTail.X), Trunc(PositionTail.Y)] := Byte(miSpace);
|
---|
345 | end;
|
---|
346 | end;
|
---|
347 |
|
---|
348 | { TTanks }
|
---|
349 |
|
---|
350 | procedure TTanks.Assign(Source: TTanks);
|
---|
351 | var
|
---|
352 | I: Integer;
|
---|
353 | begin
|
---|
354 | Clear;
|
---|
355 | Count := Source.Count;
|
---|
356 | for I := 0 to Count - 1 do begin
|
---|
357 | Items[I] := TTank.Create;
|
---|
358 | Items[I].Assign(Source.Items[I]);
|
---|
359 | end;
|
---|
360 | end;
|
---|
361 |
|
---|
362 | { TPlayers }
|
---|
363 |
|
---|
364 | function TPlayers.AddNew: TPlayer;
|
---|
365 | begin
|
---|
366 | Result := TPlayer.Create;
|
---|
367 | Add(Result);
|
---|
368 | end;
|
---|
369 |
|
---|
370 | procedure TPlayers.Assign(Players: TPlayers);
|
---|
371 | var
|
---|
372 | I: Integer;
|
---|
373 | begin
|
---|
374 | while Count < Players.Count do Add(TPlayer.Create);
|
---|
375 | while Count > Players.Count do Delete(Count - 1);
|
---|
376 | for I := 0 to Count - 1 do
|
---|
377 | Items[I].Assign(Players[I]);
|
---|
378 | end;
|
---|
379 |
|
---|
380 | procedure TPlayers.LoadFromRegistry(Context: TRegistryContext);
|
---|
381 | var
|
---|
382 | Player: TPlayer;
|
---|
383 | begin
|
---|
384 | for Player in Self do begin
|
---|
385 | Player.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
|
---|
386 | end;
|
---|
387 | end;
|
---|
388 |
|
---|
389 | procedure TPlayers.SaveToRegistry(Context: TRegistryContext);
|
---|
390 | var
|
---|
391 | Player: TPlayer;
|
---|
392 | begin
|
---|
393 | for Player in Self do begin
|
---|
394 | Player.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + IntToStr(Player.Id)));
|
---|
395 | end;
|
---|
396 | end;
|
---|
397 |
|
---|
398 | function TPlayers.GetAliveCount: Integer;
|
---|
399 | var
|
---|
400 | I: Integer;
|
---|
401 | begin
|
---|
402 | Result := 0;
|
---|
403 | for I := 0 to Count - 1 do
|
---|
404 | with Items[I] do
|
---|
405 | if not Exploded then Inc(Result);
|
---|
406 | end;
|
---|
407 |
|
---|
408 | function TPlayers.GetWinner: TPlayer;
|
---|
409 | var
|
---|
410 | I: Integer;
|
---|
411 | TopScore: Integer;
|
---|
412 | begin
|
---|
413 | Result := nil;
|
---|
414 | TopScore := 0;
|
---|
415 | for I := 0 to Count - 1 do
|
---|
416 | with Items[I] do
|
---|
417 | if Enabled and (Score > TopScore) then begin
|
---|
418 | TopScore := Score;
|
---|
419 | Result := Items[I];
|
---|
420 | end;
|
---|
421 | end;
|
---|
422 |
|
---|
423 | function TPlayers.GetEnabledCount: Integer;
|
---|
424 | var
|
---|
425 | I: Integer;
|
---|
426 | begin
|
---|
427 | Result := 0;
|
---|
428 | for I := 0 to Count - 1 do begin
|
---|
429 | if Items[I].Enabled then Inc(Result);
|
---|
430 | end;
|
---|
431 | end;
|
---|
432 |
|
---|
433 | procedure TPlayers.EnableMore;
|
---|
434 | var
|
---|
435 | I: Integer;
|
---|
436 | begin
|
---|
437 | for I := 0 to Count - 1 do begin
|
---|
438 | if not Items[I].Enabled then begin
|
---|
439 | Items[I].Enabled := True;
|
---|
440 | Break;
|
---|
441 | end;
|
---|
442 | end;
|
---|
443 | end;
|
---|
444 |
|
---|
445 | procedure TPlayers.EnableLess;
|
---|
446 | var
|
---|
447 | I: Integer;
|
---|
448 | begin
|
---|
449 | if GetEnabledCount > 2 then
|
---|
450 | for I := Count - 1 downto 0 do begin
|
---|
451 | if Items[I].Enabled then begin
|
---|
452 | Items[I].Enabled := False;
|
---|
453 | Break;
|
---|
454 | end;
|
---|
455 | end;
|
---|
456 | end;
|
---|
457 |
|
---|
458 | { TSystemThread }
|
---|
459 |
|
---|
460 | procedure TSystemThread.Execute;
|
---|
461 | begin
|
---|
462 | try
|
---|
463 | repeat
|
---|
464 | Engine.Tick;
|
---|
465 | Sleep(10);
|
---|
466 | until Terminated;
|
---|
467 | except
|
---|
468 | on E: Exception do
|
---|
469 | Engine.ThreadErrorMessage := E.Message;
|
---|
470 | end;
|
---|
471 | end;
|
---|
472 |
|
---|
473 | { TDrawThread }
|
---|
474 |
|
---|
475 | procedure TDrawThread.DrawSync;
|
---|
476 | begin
|
---|
477 | with Engine do
|
---|
478 | if Assigned(Bitmap) then begin
|
---|
479 | Lock.Acquire;
|
---|
480 | Bitmap.BeginUpdate(True);
|
---|
481 | try
|
---|
482 | Draw;
|
---|
483 | finally
|
---|
484 | Bitmap.EndUpdate;
|
---|
485 | Lock.Release;
|
---|
486 | end;
|
---|
487 | end;
|
---|
488 | end;
|
---|
489 |
|
---|
490 | procedure TDrawThread.Execute;
|
---|
491 | begin
|
---|
492 | try
|
---|
493 | repeat
|
---|
494 | Engine.DrawThread(Self);
|
---|
495 | if not Terminated then Synchronize(DrawSync);
|
---|
496 | Sleep(50);
|
---|
497 | until Terminated;
|
---|
498 | except
|
---|
499 | on E: Exception do
|
---|
500 | Engine.ThreadErrorMessage := E.Message;
|
---|
501 | end;
|
---|
502 | end;
|
---|
503 |
|
---|
504 | { TKeyboard }
|
---|
505 |
|
---|
506 | procedure TKeyboard.ClearAll;
|
---|
507 | var
|
---|
508 | I: Integer;
|
---|
509 | begin
|
---|
510 | for I := 0 to High(KeyState) do
|
---|
511 | KeyState[I] := False;
|
---|
512 | end;
|
---|
513 |
|
---|
514 | { TBullet }
|
---|
515 |
|
---|
516 | constructor TBullet.Create;
|
---|
517 | begin
|
---|
518 | MaxDistance := -1;
|
---|
519 | Distance := 0;
|
---|
520 | CanKill := True;
|
---|
521 | end;
|
---|
522 |
|
---|
523 | { TTank }
|
---|
524 |
|
---|
525 | procedure TTank.Assign(Source: TTank);
|
---|
526 | begin
|
---|
527 | Image.Assign(Source.Image);
|
---|
528 | Mask.Assign(Source.Mask);
|
---|
529 | end;
|
---|
530 |
|
---|
531 | constructor TTank.Create;
|
---|
532 | begin
|
---|
533 | Mask := TMatrixByte.Create;
|
---|
534 | Image := TMatrixByte.Create;
|
---|
535 | end;
|
---|
536 |
|
---|
537 | destructor TTank.Destroy;
|
---|
538 | begin
|
---|
539 | FreeAndNil(Mask);
|
---|
540 | FreeAndNil(Image);
|
---|
541 | inherited;
|
---|
542 | end;
|
---|
543 |
|
---|
544 | { TPlayer }
|
---|
545 |
|
---|
546 | procedure TPlayer.Control;
|
---|
547 | var
|
---|
548 | Delta: TPoint;
|
---|
549 | NewBullet: TBullet;
|
---|
550 | begin
|
---|
551 | if Exploded then Exit;
|
---|
552 |
|
---|
553 | Delta.X := 0;
|
---|
554 | Delta.Y := 0;
|
---|
555 | if Engine.KeyBoard.KeyState[Ord(Keys.Down)] then Delta.Y := Delta.Y + 1;
|
---|
556 | if Engine.KeyBoard.KeyState[Ord(Keys.Up)] then Delta.Y := Delta.Y - 1;
|
---|
557 | if Engine.KeyBoard.KeyState[Ord(Keys.Right)] then Delta.X := Delta.X + 1;
|
---|
558 | if Engine.KeyBoard.KeyState[Ord(Keys.Left)] then Delta.X := Delta.X - 1;
|
---|
559 |
|
---|
560 | NewDirection := Direction;
|
---|
561 | if (Delta.X <> 0) or (Delta.Y <> 0) then begin
|
---|
562 | if (Delta.X = 0) and (Delta.Y = -1) then NewDirection := 0
|
---|
563 | else if (Delta.X = 1) and (Delta.Y = -1) then NewDirection := 1
|
---|
564 | else if (Delta.X = 1) and (Delta.Y = 0) then NewDirection := 2
|
---|
565 | else if (Delta.X = 1) and (Delta.Y = 1) then NewDirection := 3
|
---|
566 | else if (Delta.X = 0) and (Delta.Y = 1) then NewDirection := 4
|
---|
567 | else if (Delta.X = -1) and (Delta.Y = 1) then NewDirection := 5
|
---|
568 | else if (Delta.X = -1) and (Delta.Y = 0) then NewDirection := 6
|
---|
569 | else if (Delta.X = -1) and (Delta.Y = -1) then NewDirection := 7;
|
---|
570 |
|
---|
571 | if NewDirection = Direction then begin
|
---|
572 | NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
|
---|
573 | CheckNewDestination;
|
---|
574 | end else begin
|
---|
575 | NewPosition := Position;
|
---|
576 | if not CheckNewDestination then begin
|
---|
577 | // if direction is changed then try to check movement plus one step
|
---|
578 | // to prevent tank block
|
---|
579 | NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
|
---|
580 | CheckNewDestination;
|
---|
581 | end;
|
---|
582 | end;
|
---|
583 | end;
|
---|
584 |
|
---|
585 | if Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] then
|
---|
586 | if (Bullets.Count < MaxBulletCount) and
|
---|
587 | ((Now - LastShootTime) > ShootDelay * OneSecond) then begin
|
---|
588 | Inc(ShotsCount);
|
---|
589 | NewBullet := TBullet.Create;
|
---|
590 | NewBullet.Player := Self;
|
---|
591 | NewBullet.Position.X := Position.X + DirectionToDelta[Direction].X * 3;
|
---|
592 | NewBullet.Position.Y := Position.Y + DirectionToDelta[Direction].Y * 3;
|
---|
593 | NewBullet.Direction.X := DirectionToDelta[Direction].X;
|
---|
594 | NewBullet.Direction.Y := DirectionToDelta[Direction].Y;
|
---|
595 | NewBullet.StopByDirt := True;
|
---|
596 | Bullets.Add(NewBullet);
|
---|
597 | LastShootTime := Now;
|
---|
598 |
|
---|
599 | Energy := Energy - EnergyDecreaseShoot;
|
---|
600 | if Energy < 0 then Energy := 0;
|
---|
601 |
|
---|
602 | // Do not imedietelly clear dirt by bullet in front of tank
|
---|
603 | //with Engine, World do
|
---|
604 | //if TMatter(Matter[Surface.Items[Position]]).Diggable ;
|
---|
605 | Engine.AudioShot.Play;
|
---|
606 | end;
|
---|
607 | end;
|
---|
608 |
|
---|
609 | function TPlayer.CheckNewDestination: Boolean;
|
---|
610 | var
|
---|
611 | ColisionState: TColisionState;
|
---|
612 | begin
|
---|
613 | Result := False;
|
---|
614 | HideTank;
|
---|
615 | ColisionState := CheckColision;
|
---|
616 | if not ColisionState.Blocking then begin
|
---|
617 | if ColisionState.Diggable then begin
|
---|
618 | if (Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] and
|
---|
619 | ((Now - LastDigTime) > ShootDigDelay * OneSecond)) or
|
---|
620 | (not Engine.KeyBoard.KeyState[Ord(Keys.Shoot)] and
|
---|
621 | ((Now - LastDigTime) > DigDelay * OneSecond)) then begin
|
---|
622 | Dig := not Dig;
|
---|
623 | with Engine, World do
|
---|
624 | Surface.Merge(Surface.CreateIndex(
|
---|
625 | Position.X - TMatrixByte(DigMasks[Direction]).Count.X div 2,
|
---|
626 | Position.Y - TMatrixByte(DigMasks[Direction]).Count.Y div 2),
|
---|
627 | TMatrixByte(DigMasks[Direction]), DigProc);
|
---|
628 | Energy := Energy - EnergyDecreaseDig;
|
---|
629 | if Energy < 0 then Energy := 0;
|
---|
630 | Engine.Redraw;
|
---|
631 | LastDigTime := Now;
|
---|
632 | Direction := NewDirection;
|
---|
633 | Result := True;
|
---|
634 | Inc(MetersDug);
|
---|
635 | end;
|
---|
636 | end else begin
|
---|
637 | if ((Now - LastMoveTime) > MoveDelay * OneSecond) then begin
|
---|
638 | Position := NewPosition;
|
---|
639 | Direction := NewDirection;
|
---|
640 | Result := True;
|
---|
641 | Engine.Redraw;
|
---|
642 | LastMoveTime := Now;
|
---|
643 | Energy := Energy - EnergyDecreaseMove;
|
---|
644 | Inc(MetersTravelled);
|
---|
645 | end;
|
---|
646 | end;
|
---|
647 | end;
|
---|
648 | ShowTank;
|
---|
649 | end;
|
---|
650 |
|
---|
651 | procedure TPlayer.Tick;
|
---|
652 | var
|
---|
653 | I: Integer;
|
---|
654 | P: Integer;
|
---|
655 | Pos: TPoint;
|
---|
656 | begin
|
---|
657 | // Check energy
|
---|
658 | if not ExplosionPending then begin
|
---|
659 | if not Engine.IsInsideHouses(Position) then begin
|
---|
660 | Energy := Energy - EnergyDecreaseOutside;
|
---|
661 | end else begin
|
---|
662 | if not Exploded then
|
---|
663 | Energy := Energy + EnergyIncreaseHome;
|
---|
664 | if Energy > 1 then Energy := 1;
|
---|
665 | end;
|
---|
666 | if Energy <= 0 then begin
|
---|
667 | Energy := 0;
|
---|
668 | Explosion(Position, ExplosionRange);
|
---|
669 | Exploded := True;
|
---|
670 | ExplosionPending := True;
|
---|
671 | ExplosionTime := Now;
|
---|
672 | Engine.AudioExplode.Play;
|
---|
673 | end;
|
---|
674 | end;
|
---|
675 | if ExplosionPending and (SecondOf(Now - ExplosionTime) > ExplosionDelay) then begin
|
---|
676 | ExplosionPending := False;
|
---|
677 | Engine.CheckGameEnd;
|
---|
678 | end;
|
---|
679 | if LastEnergy <> Energy then begin
|
---|
680 | LastEnergy := Energy;
|
---|
681 | Engine.Redraw;
|
---|
682 | end;
|
---|
683 |
|
---|
684 | // Check shield
|
---|
685 | if House.IsInside(Position) then begin
|
---|
686 | if not Exploded then
|
---|
687 | Shield := Shield + ShieldIncreaseHome;
|
---|
688 | if Shield > 1 then Shield := 1;
|
---|
689 | end;
|
---|
690 | if LastShield <> Shield then begin
|
---|
691 | LastShield := Shield;
|
---|
692 | Engine.Redraw;
|
---|
693 | end;
|
---|
694 | if (Shield <= 0) and not Exploded then begin
|
---|
695 | Shield := 0;
|
---|
696 | Explosion(Position, ExplosionRange);
|
---|
697 | Exploded := True;
|
---|
698 | Engine.AudioExplode.Play;
|
---|
699 | end;
|
---|
700 |
|
---|
701 | // Bullet movement
|
---|
702 | for I := Bullets.Count - 1 downto 0 do
|
---|
703 | with Bullets[I], Engine.World.Surface do begin
|
---|
704 | Pos := Point(Trunc(Position.X), Trunc(Position.Y));
|
---|
705 | if (ItemsXY[LastPos.X, LastPos.Y] = Byte(miBullet1)) or
|
---|
706 | (ItemsXY[LastPos.X, LastPos.Y] = Byte(miBullet2)) then
|
---|
707 | ItemsXY[LastPos.X, LastPos.Y] := Byte(miSpace);
|
---|
708 | LastPos := Pos;
|
---|
709 | P := Trunc(Direction.Y);
|
---|
710 |
|
---|
711 | PositionTail := Position;
|
---|
712 | Position.X := Position.X + Direction.X;
|
---|
713 | Position.Y := Position.Y + Direction.Y;
|
---|
714 | Distance := Distance + Sqrt(Sqr(Direction.X) + Sqr(Direction.Y));
|
---|
715 | //ShowMessage(FloatToStr(Distance));
|
---|
716 | if (Distance > MaxDistance) and (MaxDistance >= 0) then begin
|
---|
717 | Bullets.Delete(I);
|
---|
718 | Engine.Redraw;
|
---|
719 | Continue;
|
---|
720 | end;
|
---|
721 |
|
---|
722 | Pos := Point(Trunc(Position.X), Trunc(Position.Y));
|
---|
723 |
|
---|
724 | if (ItemsXY[Pos.X, Pos.Y] <> Byte(miSpace)) and
|
---|
725 | (ItemsXY[Pos.X, Pos.Y] <> Byte(miBullet1)) and
|
---|
726 | (ItemsXY[Pos.X, Pos.Y] <> Byte(miBullet2)) then begin
|
---|
727 | if (ItemsXY[Pos.X, Pos.Y] = Byte(miDirt1)) or
|
---|
728 | (ItemsXY[Pos.X, Pos.Y] = Byte(miDirt2)) then begin
|
---|
729 | //ItemsXY[Pos.X, Pos.Y] := Byte(miSpace);
|
---|
730 | if StopByDirt then begin
|
---|
731 | Explosion(LastPos, BulletExplosionRange);
|
---|
732 | Bullets.Delete(I);
|
---|
733 | Engine.Redraw;
|
---|
734 | Continue;
|
---|
735 | end;
|
---|
736 | end else begin
|
---|
737 | for P := 0 to Engine.Players.Count - 1 do
|
---|
738 | with Engine.Players[P] do
|
---|
739 | if (Self.Id <> P) and
|
---|
740 | (Engine.World.Matters[ItemsXY[Pos.X, Pos.Y]].Kind = mkTankBody) and
|
---|
741 | (Engine.World.Matters[ItemsXY[Pos.X, Pos.Y]].Player = P) and CanKill then begin
|
---|
742 | Shield := Shield - ShieldDecreaseHit;
|
---|
743 | Inc(Self.ShotsHit);
|
---|
744 | end;
|
---|
745 | if StopByDirt then Explosion(LastPos, BulletExplosionRange);
|
---|
746 | Bullets.Delete(I);
|
---|
747 | Engine.Redraw;
|
---|
748 | Continue;
|
---|
749 | end;
|
---|
750 | end;
|
---|
751 |
|
---|
752 | // Max position limit checking
|
---|
753 | with Engine.World.Surface do
|
---|
754 | if (Pos.X >= Count.X) or (Pos.X < 0) or
|
---|
755 | (Pos.Y >= Count.Y) or (Pos.Y < 0) then begin
|
---|
756 | Bullets.Delete(I);
|
---|
757 | Engine.Redraw;
|
---|
758 | Continue;
|
---|
759 | end;
|
---|
760 | ItemsXY[Pos.X, Pos.Y] := Byte(miBullet1);
|
---|
761 | ItemsXY[LastPos.X, LastPos.Y] := Byte(miBullet2);
|
---|
762 | Engine.Redraw;
|
---|
763 | end;
|
---|
764 |
|
---|
765 | if (Engine.State = gsGame) and not Exploded then ShowTank;
|
---|
766 | end;
|
---|
767 |
|
---|
768 | procedure TPlayer.Paint;
|
---|
769 | var
|
---|
770 | X, Y: Integer;
|
---|
771 | XX, YY: Integer;
|
---|
772 | I: Integer;
|
---|
773 | B: TColor;
|
---|
774 | begin
|
---|
775 | with Engine.FBitmapLower do begin
|
---|
776 | Fill(CreateIndex(ScreenFrame.Left, ScreenFrame.Top),
|
---|
777 | CreateIndex(ScreenFrame.Width, ScreenFrame.Height),
|
---|
778 | Engine.World.Matters[Integer(miRock)].Color);
|
---|
779 |
|
---|
780 | with Engine.World do
|
---|
781 | for Y := ScreenFrame.Top to ScreenFrame.Bottom - 1 do
|
---|
782 | for X := ScreenFrame.Left to ScreenFrame.Right - 1 do begin
|
---|
783 | XX := X - ScreenFrame.Left - ((ScreenFrame.Right - ScreenFrame.Left) div 2) + Position.X;
|
---|
784 | YY := Y - ScreenFrame.Top - ((ScreenFrame.Bottom - ScreenFrame.Top) div 2) + Position.Y;
|
---|
785 | if (YY >= 0) and (YY < Surface.Count.Y) and
|
---|
786 | (XX >= 0) and (XX < Surface.Count.X) then begin
|
---|
787 | B := Engine.World.Matters[Surface.ItemsXY[XX, YY]].Color;
|
---|
788 | ItemsXY[X, Y] := B;
|
---|
789 | end;
|
---|
790 | end;
|
---|
791 |
|
---|
792 | // Energy bar
|
---|
793 | for I := 1 to ScreenFrame.Width - 2 do
|
---|
794 | if Energy < I / (ScreenFrame.Width - 2) then
|
---|
795 | ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 2] := clBlack
|
---|
796 | else ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 2] := clYellow;
|
---|
797 |
|
---|
798 | // Shield bar
|
---|
799 | for I := 1 to ScreenFrame.Width - 2 do
|
---|
800 | if Shield < I / (ScreenFrame.Width - 2) then
|
---|
801 | ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 1] := clBlack
|
---|
802 | else ItemsXY[ScreenFrame.Left + I, ScreenFrame.Bottom - 1] := clAqua;
|
---|
803 | end;
|
---|
804 | end;
|
---|
805 |
|
---|
806 | procedure TPlayer.PlaceHouse;
|
---|
807 | var
|
---|
808 | X, Y: Integer;
|
---|
809 | Matter: Byte;
|
---|
810 | begin
|
---|
811 | House.AsTRect := Rect(Position.X - PlayerHouseSize div 2, Position.Y - PlayerHouseSize div 2,
|
---|
812 | Position.X + PlayerHouseSize div 2, Position.Y + PlayerHouseSize div 2);
|
---|
813 | for Y := 0 to PlayerHouseSize - 1 do
|
---|
814 | for X := 0 to PlayerHouseSize - 1 do begin
|
---|
815 | if ((Y = 0) or (Y = (PlayerHouseSize - 1)) or (X = 0) or (X = (PlayerHouseSize - 1))) and
|
---|
816 | not (((Y = 0) or (Y = (PlayerHouseSize - 1))) and
|
---|
817 | (X >= ((PlayerHouseSize - PlayerHouseDoorSize) div 2)) and
|
---|
818 | (X <= ((PlayerHouseSize - 1 + PlayerHouseDoorSize) div 2)))
|
---|
819 | then Matter := Byte(miPlayer1Home) + Id * 4
|
---|
820 | else Matter := Byte(miSpace);
|
---|
821 | Engine.World.Surface.ItemsXY[House.Left + X,
|
---|
822 | House.Top + Y] := Matter;
|
---|
823 | end;
|
---|
824 | end;
|
---|
825 |
|
---|
826 | function TPlayer.CheckColision: TColisionState;
|
---|
827 | var
|
---|
828 | X, Y: Integer;
|
---|
829 | XX, YY: Integer;
|
---|
830 | begin
|
---|
831 | Result.Diggable := False;
|
---|
832 | Result.Blocking := False;
|
---|
833 | with Engine, World, TTank(Tanks[NewDirection]) do
|
---|
834 | for Y := 0 to Image.Count.Y - 1 do
|
---|
835 | for X := 0 to Image.Count.X - 1 do begin
|
---|
836 | XX := X + NewPosition.X - Image.Count.X div 2;
|
---|
837 | YY := Y + NewPosition.Y - Image.Count.Y div 2;
|
---|
838 | if Image.ItemsXY[X, Y] > 0 then begin
|
---|
839 | if TMatter(Matters[Surface.ItemsXY[XX, YY]]).Blocking then
|
---|
840 | Result.Blocking := True;
|
---|
841 | if TMatter(Matters[Surface.ItemsXY[XX, YY]]).Diggable then
|
---|
842 | Result.Diggable := True;
|
---|
843 | end;
|
---|
844 | end;
|
---|
845 | end;
|
---|
846 |
|
---|
847 | function TPlayer.ShowTankProc(Item1, Item2: Byte): Byte;
|
---|
848 | begin
|
---|
849 | if Item2 > 0 then Result := Item2
|
---|
850 | else Result := Item1;
|
---|
851 | end;
|
---|
852 |
|
---|
853 | procedure TPlayer.SetExploded(const AValue: Boolean);
|
---|
854 | begin
|
---|
855 | if FExploded = AValue then Exit;
|
---|
856 | FExploded := AValue;
|
---|
857 | if FExploded then begin
|
---|
858 | HideTank;
|
---|
859 | Energy := 0;
|
---|
860 | Shield := 0;
|
---|
861 | end else ShowTank;
|
---|
862 | end;
|
---|
863 |
|
---|
864 | procedure TPlayer.ShowTank;
|
---|
865 | begin
|
---|
866 | with Engine.World do begin
|
---|
867 | Surface.Merge(Surface.CreateIndex(
|
---|
868 | Position.X - Tanks[Direction].Image.Count.X div 2,
|
---|
869 | Position.Y - Tanks[Direction].Image.Count.Y div 2),
|
---|
870 | Tanks[Direction].Image, ShowTankProc);
|
---|
871 | end;
|
---|
872 | end;
|
---|
873 |
|
---|
874 | function TPlayer.HideTankProc(Item1, Item2: Byte): Byte;
|
---|
875 | begin
|
---|
876 | if Item2 > 0 then Result := 0 else Result := Item1;
|
---|
877 | end;
|
---|
878 |
|
---|
879 | function TPlayer.DigProc(Item1, Item2: Byte): Byte;
|
---|
880 | begin
|
---|
881 | if ((Item1 = Integer(miDirt1)) or (Item1 = Integer(miDirt2))) and (Item2 = 1) then
|
---|
882 | Result := Integer(miSpace) else Result := Item1;
|
---|
883 | end;
|
---|
884 |
|
---|
885 | procedure TPlayer.ResetTank;
|
---|
886 | begin
|
---|
887 | HideTank;
|
---|
888 | Position := StartPosition;
|
---|
889 | ExplosionPending := False;
|
---|
890 | Bullets.HideAll;
|
---|
891 | Bullets.Clear;
|
---|
892 | Energy := 1;
|
---|
893 | Shield := 1;
|
---|
894 | Direction := 0;
|
---|
895 | ShowTank;
|
---|
896 | Exploded := False;
|
---|
897 | end;
|
---|
898 |
|
---|
899 | procedure TPlayer.Init;
|
---|
900 | begin
|
---|
901 | with Engine do
|
---|
902 | StartPosition := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)),
|
---|
903 | Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6)));
|
---|
904 | Position := StartPosition;
|
---|
905 | PlaceHouse;
|
---|
906 | ShotsCount := 0;
|
---|
907 | ShotsHit := 0;
|
---|
908 | MetersDug := 0;
|
---|
909 | MetersTravelled := 0;
|
---|
910 | end;
|
---|
911 |
|
---|
912 | procedure TPlayer.Explosion(Position: TPoint; Distance: Integer);
|
---|
913 | var
|
---|
914 | NewBullet: TBullet;
|
---|
915 | I: Integer;
|
---|
916 | Speed: Real;
|
---|
917 | Angle: Real;
|
---|
918 | begin
|
---|
919 | if not Exploded then begin
|
---|
920 | for I := 0 to Distance * 2 - 1 do begin
|
---|
921 | NewBullet := TBullet.Create;
|
---|
922 | NewBullet.Player := Self;
|
---|
923 | Speed := ExplosionBulletMinSpeed + (ExplosionBulletMaxSpeed - ExplosionBulletMinSpeed) * Random;
|
---|
924 | Angle := Random * 2 * Pi;
|
---|
925 | NewBullet.Direction.X := Sin(Angle) * Speed;
|
---|
926 | NewBullet.Direction.Y := Cos(Angle) * Speed;
|
---|
927 | NewBullet.Position.X := Position.X; // + NewBullet.Direction.X * 3;
|
---|
928 | NewBullet.Position.Y := Position.Y; // + NewBullet.Direction.Y * 3;
|
---|
929 | NewBullet.MaxDistance := Random(Distance);
|
---|
930 | NewBullet.CanKill := False;
|
---|
931 | Bullets.Add(NewBullet);
|
---|
932 | end;
|
---|
933 | end;
|
---|
934 | end;
|
---|
935 |
|
---|
936 | procedure TPlayer.HideTank;
|
---|
937 | begin
|
---|
938 | with Engine.World do begin
|
---|
939 | Surface.Merge(Surface.CreateIndex(
|
---|
940 | Position.X - Tanks[Direction].Image.Count.X div 2,
|
---|
941 | Position.Y - Tanks[Direction].Image.Count.Y div 2),
|
---|
942 | Tanks[Direction].Image, HideTankProc);
|
---|
943 | end;
|
---|
944 | end;
|
---|
945 |
|
---|
946 | procedure TPlayer.InitTanks;
|
---|
947 | var
|
---|
948 | NewTank: TTank;
|
---|
949 | I: Integer;
|
---|
950 | X, Y: Integer;
|
---|
951 | begin
|
---|
952 | Tanks.Clear;
|
---|
953 |
|
---|
954 | NewTank := TTank.Create;
|
---|
955 | with NewTank do begin
|
---|
956 | Image.Count := Image.CreateIndex(7, 7);
|
---|
957 | for I := 0 to 3 do
|
---|
958 | Image[3, I] := Byte(miPlayer1Cannon) + Id * 4;
|
---|
959 | for I := 1 to 6 do begin
|
---|
960 | Image[1, I] := Byte(miPlayer1TankBody) + Id * 4;
|
---|
961 | Image[5, I] := Byte(miPlayer1TankBody) + Id * 4;
|
---|
962 | end;
|
---|
963 | for I := 2 to 5 do begin
|
---|
964 | Image[2, I] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
965 | Image[4, I] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
966 | end;
|
---|
967 | Image[3, 4] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
968 | Image[3, 5] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
969 | end;
|
---|
970 | Tanks.Add(NewTank);
|
---|
971 |
|
---|
972 | NewTank := TTank.Create;
|
---|
973 | with NewTank do begin
|
---|
974 | Image.Count := Image.CreateIndex(7, 7);
|
---|
975 | for I := 0 to 2 do
|
---|
976 | Image[3 + I, 3 - I] := Byte(miPlayer1Cannon) + Id * 4;
|
---|
977 | for I := 0 to 3 do begin
|
---|
978 | Image[I, 3 - I] := Byte(miPlayer1TankBody) + Id * 4;
|
---|
979 | Image[3 + I, 6 - I] := Byte(miPlayer1TankBody) + Id * 4;
|
---|
980 | end;
|
---|
981 | for I := 0 to 2 do begin
|
---|
982 | Image[1 + I, 3 - I] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
983 | Image[3 + I, 5 - I] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
984 | end;
|
---|
985 | Image[3, 2] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
986 | Image[2, 3] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
987 | Image[2, 4] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
988 | Image[3, 4] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
989 | Image[4, 3] := Byte(miPlayer1TankBody2) + Id * 4;
|
---|
990 | end;
|
---|
991 | Tanks.Add(NewTank);
|
---|
992 |
|
---|
993 | NewTank := TTank.Create;
|
---|
994 | NewTank.Image.Assign(Tanks[0].Image);
|
---|
995 | NewTank.Image.Reverse;
|
---|
996 | NewTank.Image.ReverseHorizontal;
|
---|
997 | Tanks.Add(NewTank);
|
---|
998 |
|
---|
999 | NewTank := TTank.Create;
|
---|
1000 | NewTank.Image.Assign(Tanks[1].Image);
|
---|
1001 | NewTank.Image.ReverseVertical;
|
---|
1002 | Tanks.Add(NewTank);
|
---|
1003 |
|
---|
1004 | NewTank := TTank.Create;
|
---|
1005 | NewTank.Image.Assign(Tanks[0].Image);
|
---|
1006 | NewTank.Image.ReverseVertical;
|
---|
1007 | Tanks.Add(NewTank);
|
---|
1008 |
|
---|
1009 | NewTank := TTank.Create;
|
---|
1010 | NewTank.Image.Assign(Tanks[1].Image);
|
---|
1011 | NewTank.Image.ReverseVertical;
|
---|
1012 | NewTank.Image.ReverseHorizontal;
|
---|
1013 | Tanks.Add(NewTank);
|
---|
1014 |
|
---|
1015 | NewTank := TTank.Create;
|
---|
1016 | NewTank.Image.Assign(Tanks[0].Image);
|
---|
1017 | NewTank.Image.Reverse;
|
---|
1018 | Tanks.Add(NewTank);
|
---|
1019 |
|
---|
1020 | NewTank := TTank.Create;
|
---|
1021 | NewTank.Image.Assign(Tanks[1].Image);
|
---|
1022 | NewTank.Image.ReverseHorizontal;
|
---|
1023 | Tanks.Add(NewTank);
|
---|
1024 |
|
---|
1025 | for I := 0 to Tanks.Count - 1 do
|
---|
1026 | with Tanks[I] do begin
|
---|
1027 | Mask.Assign(Image);
|
---|
1028 | for Y := 0 to Mask.Count.Y - 1 do
|
---|
1029 | for X := 0 to Mask.Count.X - 1 do
|
---|
1030 | if Mask.ItemsXY[X, Y] > 0 then Mask.ItemsXY[X, Y] := 1;
|
---|
1031 | end;
|
---|
1032 | end;
|
---|
1033 |
|
---|
1034 | constructor TPlayer.Create;
|
---|
1035 | begin
|
---|
1036 | Tanks := TTanks.Create;
|
---|
1037 | Bullets := TBullets.Create;
|
---|
1038 | House := TRectangle.Create;
|
---|
1039 | ScreenFrame := TRectangle.Create;
|
---|
1040 | end;
|
---|
1041 |
|
---|
1042 | destructor TPlayer.Destroy;
|
---|
1043 | begin
|
---|
1044 | FreeAndNil(ScreenFrame);
|
---|
1045 | FreeAndNil(House);
|
---|
1046 | FreeAndNil(Bullets);
|
---|
1047 | FreeAndNil(Tanks);
|
---|
1048 | inherited;
|
---|
1049 | end;
|
---|
1050 |
|
---|
1051 | procedure TPlayer.Assign(Source: TPlayer);
|
---|
1052 | begin
|
---|
1053 | Engine := Source.Engine;
|
---|
1054 | Id := Source.Id;
|
---|
1055 | Keys := Source.Keys;
|
---|
1056 | Color1 := Source.Color1;
|
---|
1057 | Color2 := Source.Color2;
|
---|
1058 | Energy := Source.Energy;
|
---|
1059 | Shield := Source.Shield;
|
---|
1060 | Name := Source.Name;
|
---|
1061 | Enabled := Source.Enabled;
|
---|
1062 | Position := Source.Position;
|
---|
1063 | StartPosition := Source.StartPosition;
|
---|
1064 | Score := Source.Score;
|
---|
1065 | ShotsCount := Source.ShotsCount;
|
---|
1066 | ShotsHit := Source.ShotsHit;
|
---|
1067 | MetersDug := Source.MetersDug;
|
---|
1068 | MetersTravelled := Source.MetersTravelled;
|
---|
1069 | FExploded := Source.FExploded;
|
---|
1070 | Tanks.Assign(Source.Tanks);
|
---|
1071 | end;
|
---|
1072 |
|
---|
1073 | procedure TPlayer.LoadFromRegistry(Context: TRegistryContext);
|
---|
1074 | begin
|
---|
1075 | with TRegistryEx.Create do
|
---|
1076 | try
|
---|
1077 | CurrentContext := Context;
|
---|
1078 | Name := ReadStringWithDefault('Name', Name);
|
---|
1079 | Color1 := ReadIntegerWithDefault('Color1', Color1);
|
---|
1080 | Color2 := ReadIntegerWithDefault('Color2', Color2);
|
---|
1081 | Enabled := ReadBoolWithDefault('Enabled', Enabled);
|
---|
1082 | Keys.Left := ReadIntegerWithDefault('KeysLeft', Keys.Left);
|
---|
1083 | Keys.Right := ReadIntegerWithDefault('KeyRight', Keys.Right);
|
---|
1084 | Keys.Down := ReadIntegerWithDefault('KeyDown', Keys.Down);
|
---|
1085 | Keys.Up := ReadIntegerWithDefault('KeyUp', Keys.Up);
|
---|
1086 | Keys.Shoot := ReadIntegerWithDefault('KeyShoot', Keys.Shoot);
|
---|
1087 | finally
|
---|
1088 | Free;
|
---|
1089 | end;
|
---|
1090 | end;
|
---|
1091 |
|
---|
1092 | procedure TPlayer.SaveToRegistry(Context: TRegistryContext);
|
---|
1093 | begin
|
---|
1094 | with TRegistryEx.Create do
|
---|
1095 | try
|
---|
1096 | CurrentContext := Context;
|
---|
1097 | WriteString('Name', Name);
|
---|
1098 | WriteInteger('Color1', Color1);
|
---|
1099 | WriteInteger('Color2', Color2);
|
---|
1100 | WriteBool('Enabled', Enabled);
|
---|
1101 | WriteInteger('KeysLeft', Keys.Left);
|
---|
1102 | WriteInteger('KeyRight', Keys.Right);
|
---|
1103 | WriteInteger('KeyDown', Keys.Down);
|
---|
1104 | WriteInteger('KeyUp', Keys.Up);
|
---|
1105 | WriteInteger('KeyShoot', Keys.Shoot);
|
---|
1106 | finally
|
---|
1107 | Free;
|
---|
1108 | end;
|
---|
1109 | end;
|
---|
1110 |
|
---|
1111 | { TEngine }
|
---|
1112 |
|
---|
1113 | procedure TEngine.SetActive(const AValue: Boolean);
|
---|
1114 | begin
|
---|
1115 | if FActive = AValue then Exit;
|
---|
1116 | FActive := AValue;
|
---|
1117 | if AValue then begin
|
---|
1118 | FDrawThread := TDrawThread.Create(True);
|
---|
1119 | FDrawThread.Engine := Self;
|
---|
1120 | FDrawThread.FreeOnTerminate := False;
|
---|
1121 | FDrawThread.Name := 'Draw';
|
---|
1122 | FDrawThread.Start;
|
---|
1123 | FSystemThread := TSystemThread.Create(True);
|
---|
1124 | FSystemThread.Engine := Self;
|
---|
1125 | FSystemThread.FreeOnTerminate := False;
|
---|
1126 | FSystemThread.Name := 'Engine';
|
---|
1127 | FSystemThread.Start;
|
---|
1128 | end else begin
|
---|
1129 | FDrawThread.Terminate;
|
---|
1130 | Application.ProcessMessages;
|
---|
1131 | FreeAndNil(FDrawThread);
|
---|
1132 | FreeAndNil(FSystemThread);
|
---|
1133 | end;
|
---|
1134 | end;
|
---|
1135 |
|
---|
1136 | procedure TEngine.SetBitmap(const AValue: TBitmap);
|
---|
1137 | begin
|
---|
1138 | FBitmap := AValue;
|
---|
1139 | ResizePlayerFrames;
|
---|
1140 | end;
|
---|
1141 |
|
---|
1142 | procedure TEngine.Redraw;
|
---|
1143 | begin
|
---|
1144 | FRedrawPending := True;
|
---|
1145 | end;
|
---|
1146 |
|
---|
1147 | function TEngine.IsInsideHouses(Pos: TPoint): Boolean;
|
---|
1148 | var
|
---|
1149 | I: Integer;
|
---|
1150 | begin
|
---|
1151 | Result := False;
|
---|
1152 | for I := 0 to Players.Count - 1 do
|
---|
1153 | if Players[I].House.IsInside(Pos) then begin
|
---|
1154 | Result := True;
|
---|
1155 | end;
|
---|
1156 | end;
|
---|
1157 |
|
---|
1158 | procedure TEngine.DrawGame;
|
---|
1159 | var
|
---|
1160 | X, Y: Integer;
|
---|
1161 | PixelX, PixelY: Integer;
|
---|
1162 | SubPixelPtr: PInteger;
|
---|
1163 | SubPixelRowPtr: PInteger;
|
---|
1164 | SubPixelSizeX: Integer;
|
---|
1165 | SubPixelSizeY: Integer;
|
---|
1166 | PixelPtr: PInteger;
|
---|
1167 | PixelRowPtr: PInteger;
|
---|
1168 | BytePerPixel: Integer;
|
---|
1169 | BytePerRow: Integer;
|
---|
1170 | RawImage: TRawImage;
|
---|
1171 | Color: Int64;
|
---|
1172 | Shift: TPoint;
|
---|
1173 | XDiv, XMod, XAcc: Integer;
|
---|
1174 | YDiv, YMod, YAcc: Integer;
|
---|
1175 | Ratio: Real;
|
---|
1176 | TargetHeight: Integer;
|
---|
1177 | TargetWidth: Integer;
|
---|
1178 | BgColor: Cardinal;
|
---|
1179 | begin
|
---|
1180 | // TODO: To be able to draw into Bitmap not just through Canvas
|
---|
1181 | Bitmap.EndUpdate;
|
---|
1182 | Bitmap.BeginUpdate;
|
---|
1183 |
|
---|
1184 | {$IFDEF WINDOWS}
|
---|
1185 | Bitmap.PixelFormat := pf32bit;
|
---|
1186 | {$ENDIF}
|
---|
1187 | RawImage := Bitmap.RawImage;
|
---|
1188 | BytePerPixel := RawImage.Description.BitsPerPixel div 8;
|
---|
1189 | BytePerRow := RawImage.Description.BytesPerLine;
|
---|
1190 | if FClearBackground then begin
|
---|
1191 | BgColor := World.Matters[Integer(miBorder)].Color;
|
---|
1192 | BgColor := SwapBRComponent(BgColor);
|
---|
1193 | FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
|
---|
1194 | FClearBackground := False;
|
---|
1195 | end;
|
---|
1196 |
|
---|
1197 | if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
|
---|
1198 | Ratio := FBitmap.Width / FBitmapLower.Width
|
---|
1199 | else Ratio := FBitmap.Height / FBitmapLower.Height;
|
---|
1200 |
|
---|
1201 | // Preserve aspect ratio
|
---|
1202 | TargetWidth := Trunc(FBitmapLower.Width * Ratio);
|
---|
1203 | TargetHeight := Trunc(FBitmapLower.Height * Ratio);
|
---|
1204 |
|
---|
1205 | Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
|
---|
1206 | Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);
|
---|
1207 |
|
---|
1208 | XDiv := TargetWidth div FBitmapLower.Width;
|
---|
1209 | XMod := TargetWidth mod FBitmapLower.Width;
|
---|
1210 | YDiv := TargetHeight div FBitmapLower.Height;
|
---|
1211 | YMod := TargetHeight mod FBitmapLower.Height;
|
---|
1212 |
|
---|
1213 | PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
|
---|
1214 | YAcc := FBitmapLower.Height div 2;
|
---|
1215 | for Y := 0 to FBitmapLower.Height - 1 do begin
|
---|
1216 | SubPixelSizeY := YDiv;
|
---|
1217 | Inc(YAcc, YMod);
|
---|
1218 | if YAcc >= FBitmapLower.Height then begin
|
---|
1219 | Dec(YAcc, FBitmapLower.Height);
|
---|
1220 | Inc(SubPixelSizeY);
|
---|
1221 | end;
|
---|
1222 |
|
---|
1223 | PixelPtr := PixelRowPtr + Shift.X;
|
---|
1224 | XAcc := FBitmapLower.Width div 2;
|
---|
1225 | for X := 0 to FBitmapLower.Width - 1 do begin
|
---|
1226 | SubPixelSizeX := XDiv;
|
---|
1227 | Inc(XAcc, XMod);
|
---|
1228 | if XAcc >= FBitmapLower.Width then begin
|
---|
1229 | Dec(XAcc, FBitmapLower.Width);
|
---|
1230 | Inc(SubPixelSizeX);
|
---|
1231 | end;
|
---|
1232 | Color := FBitmapLower.Pixels[X, Y] and $ffffff;
|
---|
1233 |
|
---|
1234 | Color := SwapBRComponent(Color);
|
---|
1235 |
|
---|
1236 | // Draw large pixel
|
---|
1237 | SubPixelRowPtr := PixelPtr;
|
---|
1238 | for PixelY := 0 to SubPixelSizeY - 1 do begin
|
---|
1239 | SubPixelPtr := SubPixelRowPtr;
|
---|
1240 | for PixelX := 0 to SubPixelSizeX - 1 do begin
|
---|
1241 | SubPixelPtr^ := Color;
|
---|
1242 | Inc(PByte(SubPixelPtr), BytePerPixel);
|
---|
1243 | end;
|
---|
1244 | Inc(PByte(SubPixelRowPtr), BytePerRow);
|
---|
1245 | end;
|
---|
1246 | Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
|
---|
1247 | end;
|
---|
1248 | Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
|
---|
1249 | end;
|
---|
1250 | end;
|
---|
1251 |
|
---|
1252 | procedure TEngine.DrawInformation;
|
---|
1253 | var
|
---|
1254 | Text: string;
|
---|
1255 | X: Integer;
|
---|
1256 | Y: Integer;
|
---|
1257 | const
|
---|
1258 | LineHeight = 60;
|
---|
1259 | begin
|
---|
1260 | with Bitmap.Canvas do begin
|
---|
1261 | ClearBackground;
|
---|
1262 |
|
---|
1263 | X := Bitmap.Width div 2;
|
---|
1264 | Y := Bitmap.Height div 20;
|
---|
1265 |
|
---|
1266 | Brush.Style := bsClear;
|
---|
1267 | Pen.Style := psSolid;
|
---|
1268 | Pen.Color := clWhite;
|
---|
1269 | Font.Color := clGreen;
|
---|
1270 | Font.Size := 30;
|
---|
1271 | Text := SInformation;
|
---|
1272 | TextOut(X - TextWidth(Text) div 2, Y, Text);
|
---|
1273 | Inc(Y, 2 * LineHeight);
|
---|
1274 |
|
---|
1275 | X := 30;
|
---|
1276 |
|
---|
1277 | Font.Color := clYellow;
|
---|
1278 | Font.Size := 20;
|
---|
1279 | Text := SInformationDetails;
|
---|
1280 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1281 | Inc(Y, LineHeight);
|
---|
1282 |
|
---|
1283 | Text := SInformationDetails2;
|
---|
1284 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1285 | Inc(Y, LineHeight);
|
---|
1286 |
|
---|
1287 | X := Bitmap.Width div 2;
|
---|
1288 |
|
---|
1289 | Font.Color := clGreen;
|
---|
1290 | Font.Size := 30;
|
---|
1291 | Text := SPressEsc;
|
---|
1292 | TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
|
---|
1293 | end;
|
---|
1294 | end;
|
---|
1295 |
|
---|
1296 | procedure TEngine.DrawInstructions;
|
---|
1297 | var
|
---|
1298 | Text: string;
|
---|
1299 | X: Integer;
|
---|
1300 | Y: Integer;
|
---|
1301 | const
|
---|
1302 | LineHeight = 60;
|
---|
1303 | begin
|
---|
1304 | with Bitmap.Canvas do begin
|
---|
1305 | ClearBackground;
|
---|
1306 |
|
---|
1307 | X := Bitmap.Width div 2;
|
---|
1308 | Y := Bitmap.Height div 20;
|
---|
1309 |
|
---|
1310 | Brush.Style := bsClear;
|
---|
1311 | Pen.Style := psSolid;
|
---|
1312 | Pen.Color := clWhite;
|
---|
1313 | Font.Color := clTuna;
|
---|
1314 | Font.Size := 30;
|
---|
1315 | Text := SInstructions;
|
---|
1316 | TextOut(X - TextWidth(Text) div 2, Y, Text);
|
---|
1317 | Inc(Y, 2 * LineHeight);
|
---|
1318 |
|
---|
1319 | X := 30;
|
---|
1320 |
|
---|
1321 | Font.Color := clTeal;
|
---|
1322 | Font.Size := 20;
|
---|
1323 | Text := SInstructionsDetails;
|
---|
1324 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1325 | Inc(Y, LineHeight);
|
---|
1326 |
|
---|
1327 | Text := SInstructionsDetails2;
|
---|
1328 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1329 | Inc(Y, LineHeight);
|
---|
1330 |
|
---|
1331 | Text := SInstructionsDetails3;
|
---|
1332 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1333 | Inc(Y, LineHeight);
|
---|
1334 |
|
---|
1335 | Text := SInstructionsDetails4;
|
---|
1336 | Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60));
|
---|
1337 | Inc(Y, LineHeight);
|
---|
1338 |
|
---|
1339 | X := Bitmap.Width div 2;
|
---|
1340 | Font.Color := clGreen;
|
---|
1341 | Font.Size := 30;
|
---|
1342 | Text := SPressEsc;
|
---|
1343 | TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
|
---|
1344 | end;
|
---|
1345 | end;
|
---|
1346 |
|
---|
1347 | procedure TEngine.DrawSettings;
|
---|
1348 | var
|
---|
1349 | Text: string;
|
---|
1350 | MenuWidth: Integer;
|
---|
1351 | begin
|
---|
1352 | with Bitmap.Canvas do begin
|
---|
1353 | ClearBackground;
|
---|
1354 |
|
---|
1355 | if FShowMenuStats then begin
|
---|
1356 | MenuWidth := Bitmap.Width div 2;
|
---|
1357 | DrawStats;
|
---|
1358 | end else MenuWidth := Bitmap.Width;
|
---|
1359 |
|
---|
1360 | Brush.Style := bsClear;
|
---|
1361 | Pen.Style := psSolid;
|
---|
1362 | Pen.Color := clWhite;
|
---|
1363 | Font.Color := clTuna;
|
---|
1364 | Font.Size := 30;
|
---|
1365 | Text := SSettings;
|
---|
1366 | TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
|
---|
1367 |
|
---|
1368 | Pen.Color := clPurple;
|
---|
1369 | Pen.Width := 6;
|
---|
1370 | Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
|
---|
1371 | (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);
|
---|
1372 |
|
---|
1373 | Font.Color := clPurple;
|
---|
1374 | Font.Size := 20;
|
---|
1375 |
|
---|
1376 | ShowMenuItem('F1', SMorePlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas);
|
---|
1377 | ShowMenuItem('F2', SLessPlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas);
|
---|
1378 | ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas);
|
---|
1379 |
|
---|
1380 | Font.Color := clDarkGreen;
|
---|
1381 | Font.Size := 20;
|
---|
1382 | Text := SPlayersCount + ': ' + IntToStr(PlayerPool.GetEnabledCount);
|
---|
1383 | TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 6, Text);
|
---|
1384 | end;
|
---|
1385 | end;
|
---|
1386 |
|
---|
1387 | procedure TEngine.DrawNewRound;
|
---|
1388 | var
|
---|
1389 | Text: string;
|
---|
1390 | I: Integer;
|
---|
1391 | Y: Integer;
|
---|
1392 | begin
|
---|
1393 | with Bitmap.Canvas do begin
|
---|
1394 | ClearBackground;
|
---|
1395 |
|
---|
1396 | Brush.Style := bsClear;
|
---|
1397 | Pen.Style := psSolid;
|
---|
1398 | Pen.Color := clWhite;
|
---|
1399 | Font.Color := clTuna;
|
---|
1400 | Font.Size := 30;
|
---|
1401 | Text := SRound + ' ' + IntToStr(CurrentRound);
|
---|
1402 | TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text);
|
---|
1403 |
|
---|
1404 | Y := 0;
|
---|
1405 | for I := 0 to Players.Count - 1 do
|
---|
1406 | with TPlayer(Players[I]) do begin
|
---|
1407 | if Enabled then begin
|
---|
1408 | Font.Color := Color1;
|
---|
1409 | Text := Name + ': ' + IntToStr(Score);
|
---|
1410 | TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text);
|
---|
1411 | Inc(Y, 60);
|
---|
1412 | end;
|
---|
1413 | end;
|
---|
1414 | end;
|
---|
1415 | end;
|
---|
1416 |
|
---|
1417 | procedure TEngine.DrawMap;
|
---|
1418 | var
|
---|
1419 | Text: string;
|
---|
1420 | begin
|
---|
1421 | Bitmap.EndUpdate;
|
---|
1422 | Bitmap.BeginUpdate;
|
---|
1423 |
|
---|
1424 | World.DrawToBitmap(Bitmap);
|
---|
1425 |
|
---|
1426 | Bitmap.EndUpdate;
|
---|
1427 | Bitmap.BeginUpdate(True);
|
---|
1428 | with Bitmap.Canvas do begin
|
---|
1429 | Brush.Style := bsClear;
|
---|
1430 | Pen.Style := psSolid;
|
---|
1431 | Font.Color := clGreen;
|
---|
1432 | Font.Size := 30;
|
---|
1433 | Text := SPressEsc;
|
---|
1434 | TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
|
---|
1435 | end;
|
---|
1436 | end;
|
---|
1437 |
|
---|
1438 | procedure TEngine.SetState(AValue: TGameState);
|
---|
1439 | begin
|
---|
1440 | if FState = AValue then Exit;
|
---|
1441 | FState := AValue;
|
---|
1442 | FRedrawPending := True;
|
---|
1443 | FStateTime := Now;
|
---|
1444 | end;
|
---|
1445 |
|
---|
1446 | function TEngine.TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
|
---|
1447 | var
|
---|
1448 | Parts: TStringArray;
|
---|
1449 | I: Integer;
|
---|
1450 | XX: Integer;
|
---|
1451 | begin
|
---|
1452 | Result := 1;
|
---|
1453 | XX := 0;
|
---|
1454 | Parts := Explode(' ', Text);
|
---|
1455 | for I := 0 to Length(Parts) - 1 do begin
|
---|
1456 | if (X + XX + Canvas.TextWidth(Parts[I]) > Width) or (Parts[I] = '\n') then begin
|
---|
1457 | Y := Y + Canvas.TextHeight(Parts[I]);
|
---|
1458 | XX := 0;
|
---|
1459 | Inc(Result);
|
---|
1460 | end;
|
---|
1461 | if Parts[I] = '\n' then Continue;
|
---|
1462 | Canvas.TextOut(X + XX, Y, Parts[I]);
|
---|
1463 | XX := XX + Canvas.TextWidth(Parts[I]) + Canvas.TextWidth(' ');
|
---|
1464 | end;
|
---|
1465 | end;
|
---|
1466 |
|
---|
1467 | procedure TEngine.InitDigMasks;
|
---|
1468 | var
|
---|
1469 | NewMask: TMatrixByte;
|
---|
1470 | I: Integer;
|
---|
1471 | begin
|
---|
1472 | DigMasks.Clear;
|
---|
1473 |
|
---|
1474 | // 001111100
|
---|
1475 | // 0111A1110
|
---|
1476 | // 00z1A1z00
|
---|
1477 | // 00zxAxz00
|
---|
1478 | // 00zxAxz00
|
---|
1479 | // 00zxxxz00
|
---|
1480 | // 00z000z00
|
---|
1481 | // 000000000
|
---|
1482 | // 000000000
|
---|
1483 |
|
---|
1484 | NewMask := TMatrixByte.Create;
|
---|
1485 | with NewMask do begin
|
---|
1486 | Count := CreateIndex(9, 9);
|
---|
1487 | for I := 0 to 4 do ItemsXY[2 + I, 0] := 1;
|
---|
1488 | for I := 0 to 2 do begin
|
---|
1489 | ItemsXY[1 + I, 1] := 1;
|
---|
1490 | ItemsXY[5 + I, 1] := 1;
|
---|
1491 | end;
|
---|
1492 | ItemsXY[3, 2] := 1;
|
---|
1493 | ItemsXY[5, 2] := 1;
|
---|
1494 | end;
|
---|
1495 | DigMasks.Add(NewMask);
|
---|
1496 |
|
---|
1497 | // 000011110
|
---|
1498 | // 0000z1111
|
---|
1499 | // 000zx1A11
|
---|
1500 | // 00zxxA111
|
---|
1501 | // 0zxxAxxz1
|
---|
1502 | // 000xxxz00
|
---|
1503 | // 0000xz000
|
---|
1504 | // 0000z0000
|
---|
1505 | // 000000000
|
---|
1506 |
|
---|
1507 | NewMask := TMatrixByte.Create;
|
---|
1508 | with NewMask do begin
|
---|
1509 | Count := CreateIndex(9, 9);
|
---|
1510 | for I := 0 to 3 do begin
|
---|
1511 | ItemsXY[4 + I, 0] := 1;
|
---|
1512 | ItemsXY[5 + I, 1] := 1;
|
---|
1513 | end;
|
---|
1514 | ItemsXY[5, 2] := 1;
|
---|
1515 | ItemsXY[7, 2] := 1;
|
---|
1516 | ItemsXY[8, 2] := 1;
|
---|
1517 | for I := 0 to 2 do
|
---|
1518 | ItemsXY[6 + I, 3] := 1;
|
---|
1519 | ItemsXY[8, 4] := 1;
|
---|
1520 | end;
|
---|
1521 | DigMasks.Add(NewMask);
|
---|
1522 |
|
---|
1523 | NewMask := TMatrixByte.Create;
|
---|
1524 | NewMask.Assign(DigMasks[0]);
|
---|
1525 | NewMask.Reverse;
|
---|
1526 | NewMask.ReverseHorizontal;
|
---|
1527 | DigMasks.Add(NewMask);
|
---|
1528 |
|
---|
1529 | NewMask := TMatrixByte.Create;
|
---|
1530 | NewMask.Assign(DigMasks[1]);
|
---|
1531 | NewMask.ReverseVertical;
|
---|
1532 | DigMasks.Add(NewMask);
|
---|
1533 |
|
---|
1534 | NewMask := TMatrixByte.Create;
|
---|
1535 | NewMask.Assign(DigMasks[0]);
|
---|
1536 | NewMask.ReverseVertical;
|
---|
1537 | DigMasks.Add(NewMask);
|
---|
1538 |
|
---|
1539 | NewMask := TMatrixByte.Create;
|
---|
1540 | NewMask.Assign(DigMasks[1]);
|
---|
1541 | NewMask.ReverseVertical;
|
---|
1542 | NewMask.ReverseHorizontal;
|
---|
1543 | DigMasks.Add(NewMask);
|
---|
1544 |
|
---|
1545 | NewMask := TMatrixByte.Create;
|
---|
1546 | NewMask.Assign(DigMasks[0]);
|
---|
1547 | NewMask.Reverse;
|
---|
1548 | DigMasks.Add(NewMask);
|
---|
1549 |
|
---|
1550 | NewMask := TMatrixByte.Create;
|
---|
1551 | NewMask.Assign(DigMasks[1]);
|
---|
1552 | NewMask.ReverseHorizontal;
|
---|
1553 | DigMasks.Add(NewMask);
|
---|
1554 | end;
|
---|
1555 |
|
---|
1556 | procedure TEngine.InitPlayerPool;
|
---|
1557 | var
|
---|
1558 | I: Integer;
|
---|
1559 | begin
|
---|
1560 | PlayerPool.Clear;
|
---|
1561 | with PlayerPool.AddNew do begin
|
---|
1562 | Name := SGreen;
|
---|
1563 | Keys.Left := 65;
|
---|
1564 | Keys.Down := 83;
|
---|
1565 | Keys.Right := 68;
|
---|
1566 | Keys.Up := 87;
|
---|
1567 | Keys.Shoot := 69;
|
---|
1568 | Color1 := $00ff00;
|
---|
1569 | Color2 := $00a000;
|
---|
1570 | Enabled := True;
|
---|
1571 | end;
|
---|
1572 | with PlayerPool.AddNew do begin
|
---|
1573 | Name := SBlue;
|
---|
1574 | Keys.Left := 37;
|
---|
1575 | Keys.Down := 40;
|
---|
1576 | Keys.Right := 39;
|
---|
1577 | Keys.Up := 38;
|
---|
1578 | Keys.Shoot := 17;
|
---|
1579 | Color1 := $ff2c2c;
|
---|
1580 | Color2 := $b60000;
|
---|
1581 | Enabled := True;
|
---|
1582 | end;
|
---|
1583 | with PlayerPool.AddNew do begin
|
---|
1584 | Name := SRed;
|
---|
1585 | Keys.Left := 76;
|
---|
1586 | Keys.Down := 147;
|
---|
1587 | Keys.Right := 222;
|
---|
1588 | Keys.Up := 80;
|
---|
1589 | Keys.Shoot := 191;
|
---|
1590 | Color1 := $0000ff;
|
---|
1591 | Color2 := $0000a0;
|
---|
1592 | end;
|
---|
1593 | with PlayerPool.AddNew do begin
|
---|
1594 | Name := SPink;
|
---|
1595 | Keys.Left := 100;
|
---|
1596 | Keys.Down := 98;
|
---|
1597 | Keys.Right := 102;
|
---|
1598 | Keys.Up := 104;
|
---|
1599 | Keys.Shoot := 105;
|
---|
1600 | Color1 := $ff2cff;
|
---|
1601 | Color2 := $b600b6;
|
---|
1602 | end;
|
---|
1603 | with PlayerPool.AddNew do begin
|
---|
1604 | Name := SCyan;
|
---|
1605 | Keys.Left := 0;
|
---|
1606 | Keys.Down := 0;
|
---|
1607 | Keys.Right := 0;
|
---|
1608 | Keys.Up := 0;
|
---|
1609 | Keys.Shoot := 0;
|
---|
1610 | Color1 := $ffff2c;
|
---|
1611 | Color2 := $b6b600;
|
---|
1612 | end;
|
---|
1613 | with PlayerPool.AddNew do begin
|
---|
1614 | Name := SYellow;
|
---|
1615 | Keys.Left := 0;
|
---|
1616 | Keys.Down := 0;
|
---|
1617 | Keys.Right := 0;
|
---|
1618 | Keys.Up := 0;
|
---|
1619 | Keys.Shoot := 0;
|
---|
1620 | Color1 := $2cffff;
|
---|
1621 | Color2 := $00b6b6;
|
---|
1622 | end;
|
---|
1623 | with PlayerPool.AddNew do begin
|
---|
1624 | Name := SOrange;
|
---|
1625 | Keys.Left := 0;
|
---|
1626 | Keys.Down := 0;
|
---|
1627 | Keys.Right := 0;
|
---|
1628 | Keys.Up := 0;
|
---|
1629 | Keys.Shoot := 0;
|
---|
1630 | Color1 := $008cff;
|
---|
1631 | Color2 := $002da0;
|
---|
1632 | end;
|
---|
1633 | with PlayerPool.AddNew do begin
|
---|
1634 | Name := SGray;
|
---|
1635 | Keys.Left := 0;
|
---|
1636 | Keys.Down := 0;
|
---|
1637 | Keys.Right := 0;
|
---|
1638 | Keys.Up := 0;
|
---|
1639 | Keys.Shoot := 0;
|
---|
1640 | Color1 := $d0d0d0;
|
---|
1641 | Color2 := $707070;
|
---|
1642 | end;
|
---|
1643 | for I := 0 to PlayerPool.Count - 1 do
|
---|
1644 | with PlayerPool[I] do begin
|
---|
1645 | Engine := Self;
|
---|
1646 | Id := I;
|
---|
1647 | InitTanks;
|
---|
1648 | if I < 2 then Enabled := True;
|
---|
1649 | end;
|
---|
1650 | end;
|
---|
1651 |
|
---|
1652 | procedure TEngine.InitPlayers;
|
---|
1653 | var
|
---|
1654 | I: Integer;
|
---|
1655 | NewPlayer: TPlayer;
|
---|
1656 | begin
|
---|
1657 | Players.Clear;
|
---|
1658 | for I := 0 to PlayerPool.Count - 1 do
|
---|
1659 | with PlayerPool[I] do
|
---|
1660 | if Enabled then begin
|
---|
1661 | NewPlayer := TPlayer.Create;
|
---|
1662 | NewPlayer.Assign(PlayerPool[I]);
|
---|
1663 | Players.Add(NewPlayer);
|
---|
1664 | Score := 0;
|
---|
1665 | World.Matters[Integer(miPlayer1Cannon) + I * 4].Color := clYellow;
|
---|
1666 | World.Matters[Integer(miPlayer1Home) + I * 4].Color := Color1;
|
---|
1667 | World.Matters[Integer(miPlayer1TankBody) + I * 4].Color := Color1;
|
---|
1668 | World.Matters[Integer(miPlayer1TankBody2) + I * 4].Color := Color2;
|
---|
1669 | end;
|
---|
1670 | end;
|
---|
1671 |
|
---|
1672 | procedure TEngine.CheckGameEnd;
|
---|
1673 | var
|
---|
1674 | I: Integer;
|
---|
1675 | begin
|
---|
1676 | if Players.GetAliveCount <= 1 then begin
|
---|
1677 | for I := 0 to Players.Count - 1 do
|
---|
1678 | with Players[I] do
|
---|
1679 | if not Exploded then Inc(Score);
|
---|
1680 | if CurrentRound < MaxRound then begin
|
---|
1681 | Inc(CurrentRound);
|
---|
1682 | NewRound;
|
---|
1683 | State := gsNewRound;
|
---|
1684 | end else
|
---|
1685 | State := gsMap;
|
---|
1686 | if Assigned(FOnGameEnd) then
|
---|
1687 | FOnGameEnd(Self);
|
---|
1688 | end;
|
---|
1689 | end;
|
---|
1690 |
|
---|
1691 | procedure TEngine.ClearBackground;
|
---|
1692 | begin
|
---|
1693 | with Bitmap.Canvas do begin
|
---|
1694 | Brush.Style := bsSolid;
|
---|
1695 | Brush.Color := clBlack;
|
---|
1696 | FillRect(0, 0, Bitmap.Width, Bitmap.Height);
|
---|
1697 | end;
|
---|
1698 | end;
|
---|
1699 |
|
---|
1700 | procedure TEngine.ShowMenuItem(Key, Text: string; X, Y: Integer; Canvas: TCanvas);
|
---|
1701 | begin
|
---|
1702 | Canvas.TextOut(X, Y, '<' + Key + '>');
|
---|
1703 | Canvas.TextOut(X + 140, Y, Text);
|
---|
1704 | end;
|
---|
1705 |
|
---|
1706 | procedure TEngine.DrawMenu;
|
---|
1707 | var
|
---|
1708 | Text: string;
|
---|
1709 | MenuWidth: Integer;
|
---|
1710 | begin
|
---|
1711 | with Bitmap.Canvas do begin
|
---|
1712 | ClearBackground;
|
---|
1713 |
|
---|
1714 | if FShowMenuStats then begin
|
---|
1715 | MenuWidth := Bitmap.Width div 2;
|
---|
1716 | DrawStats;
|
---|
1717 | end else MenuWidth := Bitmap.Width;
|
---|
1718 |
|
---|
1719 | Brush.Style := bsClear;
|
---|
1720 | Pen.Style := psSolid;
|
---|
1721 | Pen.Color := clWhite;
|
---|
1722 | Font.Color := clTuna;
|
---|
1723 | Font.Size := 30;
|
---|
1724 | Text := 'TUNNELER';
|
---|
1725 | TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
|
---|
1726 |
|
---|
1727 | Font.Color := clDarkOrange;
|
---|
1728 | Font.Size := 20;
|
---|
1729 | Text := 'by Chronosoft';
|
---|
1730 | TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text);
|
---|
1731 |
|
---|
1732 | Pen.Color := clPurple;
|
---|
1733 | Pen.Width := 6;
|
---|
1734 | Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
|
---|
1735 | (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);
|
---|
1736 |
|
---|
1737 | Font.Color := clPurple;
|
---|
1738 | Font.Size := 20;
|
---|
1739 |
|
---|
1740 | ShowMenuItem('F1', SStartGame, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas);
|
---|
1741 | ShowMenuItem('F2', SInstructions, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas);
|
---|
1742 | ShowMenuItem('F3', SInformation, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas);
|
---|
1743 | ShowMenuItem('F4', SSettings, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas);
|
---|
1744 | ShowMenuItem('F10', SExit, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 160, Bitmap.Canvas);
|
---|
1745 |
|
---|
1746 | Font.Color := clDarkGreen;
|
---|
1747 | Font.Size := 20;
|
---|
1748 | Text := '(' + SWorldReady + ')';
|
---|
1749 | TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
|
---|
1750 | end;
|
---|
1751 | end;
|
---|
1752 |
|
---|
1753 | procedure TEngine.DrawStats;
|
---|
1754 | var
|
---|
1755 | X: Integer;
|
---|
1756 | Y: Integer;
|
---|
1757 | Text: string;
|
---|
1758 | Winner: TPlayer;
|
---|
1759 | I: Integer;
|
---|
1760 | ShotsPercent: Integer;
|
---|
1761 | const
|
---|
1762 | LineHeight = 40;
|
---|
1763 | begin
|
---|
1764 | with Bitmap.Canvas do begin
|
---|
1765 | X := Bitmap.Width div 4 * 3;
|
---|
1766 |
|
---|
1767 | Brush.Style := bsClear;
|
---|
1768 | Pen.Style := psSolid;
|
---|
1769 |
|
---|
1770 | Pen.Color := clWhite;
|
---|
1771 | MoveTo(Bitmap.Width div 2, 0);
|
---|
1772 | LineTo(Bitmap.Width div 2, Bitmap.Height);
|
---|
1773 |
|
---|
1774 | Font.Color := clCyan;
|
---|
1775 | Font.Size := 20;
|
---|
1776 | Text := SStatistics;
|
---|
1777 | TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
|
---|
1778 |
|
---|
1779 | Font.Color := clOrange;
|
---|
1780 | Font.Size := 20;
|
---|
1781 |
|
---|
1782 | Y := Bitmap.Height div 10 + 3 * LineHeight;
|
---|
1783 | X := Bitmap.Width div 2 + 50;
|
---|
1784 | Inc(Y, LineHeight);
|
---|
1785 | Text := SShotsFired;
|
---|
1786 | TextOut(X, Y, Text);
|
---|
1787 | Inc(Y, LineHeight);
|
---|
1788 | Text := SShotsHit;
|
---|
1789 | TextOut(X, Y, Text);
|
---|
1790 | Inc(Y, LineHeight);
|
---|
1791 | Text := SPercentHit;
|
---|
1792 | TextOut(X, Y, Text);
|
---|
1793 | Inc(Y, LineHeight);
|
---|
1794 | Inc(Y, LineHeight);
|
---|
1795 | Text := SMetersDug;
|
---|
1796 | TextOut(X, Y, Text);
|
---|
1797 | Inc(Y, LineHeight);
|
---|
1798 | Text := SMetersTravelled;
|
---|
1799 | TextOut(X, Y, Text);
|
---|
1800 | Inc(Y, LineHeight);
|
---|
1801 |
|
---|
1802 | for I := 0 to Players.Count - 1 do
|
---|
1803 | with Players[I] do begin
|
---|
1804 | Y := Bitmap.Height div 10 + 3 * LineHeight;
|
---|
1805 | X := Bitmap.Width div 2 + 50 + 500 + 200 * I;
|
---|
1806 | Font.Color := Color1;
|
---|
1807 | Text := Name;
|
---|
1808 | TextOut(X - TextWidth(Text) , Y, Text);
|
---|
1809 | Inc(Y, LineHeight);
|
---|
1810 | Text := IntToStr(ShotsCount);
|
---|
1811 | TextOut(X - TextWidth(Text), Y, Text);
|
---|
1812 | Inc(Y, LineHeight);
|
---|
1813 | Text := IntToStr(ShotsHit);
|
---|
1814 | TextOut(X - TextWidth(Text), Y, Text);
|
---|
1815 | Inc(Y, LineHeight);
|
---|
1816 | if ShotsCount > 0 then
|
---|
1817 | ShotsPercent := Round(ShotsHit / ShotsCount * 100)
|
---|
1818 | else ShotsPercent := 0;
|
---|
1819 | Text := IntToStr(ShotsPercent) + '%';
|
---|
1820 | TextOut(X - TextWidth(Text), Y, Text);
|
---|
1821 | Inc(Y, LineHeight);
|
---|
1822 | Inc(Y, LineHeight);
|
---|
1823 | Text := IntToStr(MetersDug);
|
---|
1824 | TextOut(X - TextWidth(Text), Y, Text);
|
---|
1825 | Inc(Y, LineHeight);
|
---|
1826 | Text := IntToStr(MetersTravelled);
|
---|
1827 | TextOut(X - TextWidth(Text), Y, Text);
|
---|
1828 | Inc(Y, LineHeight);
|
---|
1829 | end;
|
---|
1830 |
|
---|
1831 | Inc(Y, 3 * LineHeight);
|
---|
1832 |
|
---|
1833 | X := Bitmap.Width div 2 + 50;
|
---|
1834 | Font.Color := clOrange;
|
---|
1835 | Winner := Players.GetWinner;
|
---|
1836 | if Assigned(Winner) then begin
|
---|
1837 | Text := SWinnerIs;
|
---|
1838 | TextOut(X, Y, Text);
|
---|
1839 | X := X + TextWidth(Text) + 20;
|
---|
1840 | Font.Color := Winner.Color1;
|
---|
1841 | Text := Winner.Name;
|
---|
1842 | TextOut(X, Y, Text);
|
---|
1843 | end;
|
---|
1844 | end;
|
---|
1845 | end;
|
---|
1846 |
|
---|
1847 | procedure TEngine.DrawGamePrepare(Thread: TVirtualThread);
|
---|
1848 | var
|
---|
1849 | I: Integer;
|
---|
1850 | OldCount: TBitmapTColorIndex;
|
---|
1851 | begin
|
---|
1852 | Lock.Acquire;
|
---|
1853 | try
|
---|
1854 | // TODO: Without this (re)initialization we get range error
|
---|
1855 | OldCount := FBitmapLower.Count;
|
---|
1856 | FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
|
---|
1857 | FBitmapLower.Count := OldCount;
|
---|
1858 |
|
---|
1859 | if FClearBackground then FBitmapLower.FillAll(World.Matters[Integer(miBorder)].Color);
|
---|
1860 | for I := 0 to Players.Count - 1 do
|
---|
1861 | if Players[I].Enabled then begin
|
---|
1862 | Players[I].Paint;
|
---|
1863 | end;
|
---|
1864 | finally
|
---|
1865 | Lock.Release;
|
---|
1866 | end;
|
---|
1867 | end;
|
---|
1868 |
|
---|
1869 | procedure TEngine.ResizePlayerFrames;
|
---|
1870 | var
|
---|
1871 | HorizFrameCount: Integer;
|
---|
1872 | VertFrameCount: Integer;
|
---|
1873 | I: Integer;
|
---|
1874 | begin
|
---|
1875 | if Assigned(FBitmapLower) then begin
|
---|
1876 | if Players.Count > 1 then begin
|
---|
1877 | if Players.Count > 2 then VertFrameCount := 2
|
---|
1878 | else VertFrameCount := 1;
|
---|
1879 | HorizFrameCount := Round(Players.Count / VertFrameCount);
|
---|
1880 | end else begin
|
---|
1881 | VertFrameCount := 1;
|
---|
1882 | HorizFrameCount := 1;
|
---|
1883 | end;
|
---|
1884 | FBitmapLower.Count := FBitmapLower.CreateIndex(PlayerFrameWidth * HorizFrameCount,
|
---|
1885 | PlayerFrameHeight * VertFrameCount);
|
---|
1886 | for I := 0 to Players.Count - 1 do begin
|
---|
1887 | Players[I].ScreenFrame.AsTRect := Rect(
|
---|
1888 | (I mod HorizFrameCount) * (FBitmapLower.Count.X div HorizFrameCount) + 1,
|
---|
1889 | (I div HorizFrameCount) * (FBitmapLower.Count.Y div VertFrameCount) + 1,
|
---|
1890 | ((I mod HorizFrameCount) + 1) * (FBitmapLower.Width div HorizFrameCount),
|
---|
1891 | ((I div HorizFrameCount) + 1) * (FBitmapLower.Height div VertFrameCount));
|
---|
1892 | end;
|
---|
1893 | end;
|
---|
1894 | FClearBackground := True;
|
---|
1895 | Redraw;
|
---|
1896 | end;
|
---|
1897 |
|
---|
1898 | constructor TEngine.Create(AOwner: TComponent);
|
---|
1899 | begin
|
---|
1900 | inherited;
|
---|
1901 | Lock := TCriticalSection.Create;
|
---|
1902 | FBitmapLower := TBitmapTColor.Create;
|
---|
1903 | FBitmapLock := TCriticalSection.Create;
|
---|
1904 | PlayerPool := TPlayers.Create;
|
---|
1905 | PlayerPool.Engine := Self;
|
---|
1906 | Players := TPlayers.Create;
|
---|
1907 | Players.Engine := Self;
|
---|
1908 | Keyboard := TKeyboard.Create;
|
---|
1909 | World := TWorld.Create;
|
---|
1910 | //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);
|
---|
1911 | AudioShot := TSound.Create(nil);
|
---|
1912 | AudioShot.FileName := GetCurrentDir + '/Audio/GE_KF7_Soviet.wav';
|
---|
1913 | AudioExplode := TSound.Create(nil);
|
---|
1914 | AudioExplode.FileName := GetCurrentDir + '/Audio/bomb.wav';
|
---|
1915 | InitPlayerPool;
|
---|
1916 | DigMasks := TObjectList<TMatrixByte>.Create;
|
---|
1917 | InitDigMasks;
|
---|
1918 | Redraw;
|
---|
1919 | MaxRound := 5;
|
---|
1920 | end;
|
---|
1921 |
|
---|
1922 | destructor TEngine.Destroy;
|
---|
1923 | begin
|
---|
1924 | Active := False;
|
---|
1925 | FreeAndNil(DigMasks);
|
---|
1926 | FreeAndNil(FBitmapLower);
|
---|
1927 | FreeAndNil(FBitmapLock);
|
---|
1928 | FreeAndNil(PlayerPool);
|
---|
1929 | FreeAndNil(Players);
|
---|
1930 | FreeAndNil(Keyboard);
|
---|
1931 | FreeAndNil(World);
|
---|
1932 | FreeAndNil(Lock);
|
---|
1933 | FreeAndNil(AudioShot);
|
---|
1934 | FreeAndNil(AudioExplode);
|
---|
1935 | inherited;
|
---|
1936 | end;
|
---|
1937 |
|
---|
1938 | procedure TEngine.Tick;
|
---|
1939 | var
|
---|
1940 | I: Integer;
|
---|
1941 | begin
|
---|
1942 | if State = gsGame then begin
|
---|
1943 | Lock.Acquire;
|
---|
1944 | try
|
---|
1945 | for I := 0 to Players.Count - 1 do begin
|
---|
1946 | Players[I].Control;
|
---|
1947 | Players[I].Tick;
|
---|
1948 | end;
|
---|
1949 | finally
|
---|
1950 | Lock.Release;
|
---|
1951 | end;
|
---|
1952 | end else
|
---|
1953 | if State = gsNewRound then begin
|
---|
1954 | if SecondOf(Now - FStateTime) > NewRoundDelay then begin
|
---|
1955 | State := gsGame;
|
---|
1956 | end;
|
---|
1957 | end;
|
---|
1958 | end;
|
---|
1959 |
|
---|
1960 | procedure TEngine.Draw;
|
---|
1961 | var
|
---|
1962 | DrawStart: TDateTime;
|
---|
1963 | begin
|
---|
1964 | if FRedrawPending then begin
|
---|
1965 | DrawStart := NowPrecise;
|
---|
1966 | FRedrawPending := False;
|
---|
1967 | case State of
|
---|
1968 | gsGame: DrawGame;
|
---|
1969 | gsMenu: DrawMenu;
|
---|
1970 | gsInformation: DrawInformation;
|
---|
1971 | gsInstructions: DrawInstructions;
|
---|
1972 | gsSettings: DrawSettings;
|
---|
1973 | gsMap: DrawMap;
|
---|
1974 | gsNewRound: DrawNewRound;
|
---|
1975 | end;
|
---|
1976 |
|
---|
1977 | DrawDuration := NowPrecise - DrawStart;
|
---|
1978 | end;
|
---|
1979 | end;
|
---|
1980 |
|
---|
1981 | procedure TEngine.DrawThread(Thread: TVirtualThread);
|
---|
1982 | begin
|
---|
1983 | if State = gsGame then DrawGamePrepare(Thread);
|
---|
1984 | end;
|
---|
1985 |
|
---|
1986 | procedure TEngine.NewGame;
|
---|
1987 | var
|
---|
1988 | I: Integer;
|
---|
1989 | begin
|
---|
1990 | Active := False;
|
---|
1991 | InitPlayers;
|
---|
1992 | ResizePlayerFrames;
|
---|
1993 | CurrentRound := 1;
|
---|
1994 | World.Generate;
|
---|
1995 | for I := 0 to Players.Count - 1 do
|
---|
1996 | Players[I].Init;
|
---|
1997 | NewRound;
|
---|
1998 |
|
---|
1999 | Active := True;
|
---|
2000 | end;
|
---|
2001 |
|
---|
2002 | procedure TEngine.NewRound;
|
---|
2003 | var
|
---|
2004 | I: Integer;
|
---|
2005 | begin
|
---|
2006 | for I := 0 to Players.Count - 1 do
|
---|
2007 | Players[I].ResetTank;
|
---|
2008 | FClearBackground := True;
|
---|
2009 | Redraw;
|
---|
2010 | end;
|
---|
2011 |
|
---|
2012 | procedure TEngine.LoadFromRegistry(Context: TRegistryContext);
|
---|
2013 | begin
|
---|
2014 | with TRegistryEx.Create do
|
---|
2015 | try
|
---|
2016 | CurrentContext := Context;
|
---|
2017 | PlayerPool.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
|
---|
2018 | finally
|
---|
2019 | Free;
|
---|
2020 | end;
|
---|
2021 | end;
|
---|
2022 |
|
---|
2023 | procedure TEngine.SaveToRegistry(Context: TRegistryContext);
|
---|
2024 | begin
|
---|
2025 | with TRegistryEx.Create do
|
---|
2026 | try
|
---|
2027 | CurrentContext := Context;
|
---|
2028 |
|
---|
2029 | PlayerPool.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Players'));
|
---|
2030 | finally
|
---|
2031 | Free;
|
---|
2032 | end;
|
---|
2033 | end;
|
---|
2034 |
|
---|
2035 | procedure TEngine.KeyUp(Key: Word);
|
---|
2036 | const
|
---|
2037 | KeyF1 = 112;
|
---|
2038 | KeyF2 = 113;
|
---|
2039 | KeyF3 = 114;
|
---|
2040 | KeyF4 = 115;
|
---|
2041 | KeyF5 = 116;
|
---|
2042 | KeyF10 = 121;
|
---|
2043 | KeyEsc = 27;
|
---|
2044 | var
|
---|
2045 | I: Integer;
|
---|
2046 | begin
|
---|
2047 | KeyBoard.KeyState[Key] := False;
|
---|
2048 |
|
---|
2049 | if State = gsMenu then begin
|
---|
2050 | if Key = KeyF1 then begin
|
---|
2051 | State := gsNewRound;
|
---|
2052 | NewGame;
|
---|
2053 | end else
|
---|
2054 | if Key = KeyF2 then begin
|
---|
2055 | State := gsInstructions;
|
---|
2056 | end else
|
---|
2057 | if Key = KeyF3 then begin
|
---|
2058 | State := gsInformation;
|
---|
2059 | end else
|
---|
2060 | if Key = KeyF4 then begin
|
---|
2061 | State := gsSettings;
|
---|
2062 | end else
|
---|
2063 | if Key = KeyF10 then begin
|
---|
2064 | if Assigned(FOnClose) then FOnClose(Self);
|
---|
2065 | end;
|
---|
2066 | end else
|
---|
2067 | if State = gsMap then begin
|
---|
2068 | if Key = KeyEsc then begin
|
---|
2069 | State := gsMenu;
|
---|
2070 | FShowMenuStats := True;
|
---|
2071 | end;
|
---|
2072 | end else
|
---|
2073 | if State in [gsInformation, gsInstructions] then begin
|
---|
2074 | if Key = KeyEsc then begin
|
---|
2075 | State := gsMenu;
|
---|
2076 | end;
|
---|
2077 | end else
|
---|
2078 | if State = gsSettings then begin
|
---|
2079 | if Key = KeyF1 then begin
|
---|
2080 | PlayerPool.EnableMore;
|
---|
2081 | Redraw;
|
---|
2082 | end else
|
---|
2083 | if Key = KeyF2 then begin
|
---|
2084 | PlayerPool.EnableLess;
|
---|
2085 | Redraw;
|
---|
2086 | end else
|
---|
2087 | if Key = KeyEsc then begin
|
---|
2088 | State := gsMenu;
|
---|
2089 | end;
|
---|
2090 | end else
|
---|
2091 | if State = gsGame then begin
|
---|
2092 | if Key = KeyEsc then begin
|
---|
2093 | State := gsMap;
|
---|
2094 | end;
|
---|
2095 | end;
|
---|
2096 |
|
---|
2097 | {$IFDEF DEBUG}
|
---|
2098 | if (State = gsGame) and (Key = KeyF5) then begin
|
---|
2099 | // Destroy first alive player
|
---|
2100 | for I := 0 to Players.Count - 1 do
|
---|
2101 | with Players[I] do begin
|
---|
2102 | if not Exploded then begin
|
---|
2103 | Energy := -100;
|
---|
2104 | Break;
|
---|
2105 | end;
|
---|
2106 | end;
|
---|
2107 | end;
|
---|
2108 | {$ENDIF}
|
---|
2109 | end;
|
---|
2110 |
|
---|
2111 | procedure TEngine.KeyDown(Key: Word);
|
---|
2112 | begin
|
---|
2113 | KeyBoard.KeyState[Key] := True;
|
---|
2114 | end;
|
---|
2115 |
|
---|
2116 | end.
|
---|
2117 |
|
---|