Changeset 61 for trunk/UEngine.pas
- Timestamp:
- Dec 25, 2022, 10:44:53 PM (23 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UEngine.pas
r60 r61 7 7 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle, 8 8 Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, XMLConf, DOM, 9 Generics.Collections ;9 Generics.Collections, UWorld, UMatter; 10 10 11 11 const … … 32 32 clTuna = $5555ff; 33 33 clPurple = $aa00aa; 34 clOrange = $0055aa; 34 35 clDarkOrange = $0000aa; 35 36 clDarkGreen = $00aa00; 37 clCyan = $ffff00; 36 38 37 39 type … … 81 83 procedure Assign(Source: TTanks); 82 84 end; 83 84 TMatterIndex = (miSpace, miDirt1, miDirt2, miRock, miBullet1, miBullet2, miBorder,85 miPlayer1Cannon, miPlayer1Home, miPlayer1TankBody, miPlayer1TankBody2,86 miPlayer2Cannon, miPlayer2Home, miPlayer2TankBody, miPlayer2TankBody2,87 miPlayer3Cannon, miPlayer3Home, miPlayer3TankBody, miPlayer3TankBody2,88 miPlayer4Cannon, miPlayer4Home, miPlayer4TankBody, miPlayer4TankBody2,89 miPlayer5Cannon, miPlayer5Home, miPlayer5TankBody, miPlayer5TankBody2,90 miPlayer6Cannon, miPlayer6Home, miPlayer6TankBody, miPlayer6TankBody2,91 miPlayer7Cannon, miPlayer7Home, miPlayer7TankBody, miPlayer7TankBody2,92 miPlayer8Cannon, miPlayer8Home, miPlayer8TankBody, miPlayer8TankBody2);93 94 TMatterKind = (mkSpace, mkDirt, mkRock, mkBullet, mkTankBody,95 mkHome, mkBorder);96 85 97 86 TColisionState = record … … 116 105 function DigProc(Item1, Item2: Byte): Byte; 117 106 public 107 Name: string; 118 108 Color1: TColor; 119 109 Color2: TColor; … … 122 112 Engine: TEngine; 123 113 Position: TPoint; 114 StartPosition: TPoint; 124 115 Score: Integer; 125 116 Direction: Integer; 126 117 ScreenFrame: TRectangle; 127 Name: string;128 118 Keys: TPlayerKeys; 129 119 Tanks: TTanks; … … 137 127 LastShield: Real; 138 128 House: TRectangle; 129 ShootCount: Integer; 130 procedure ResetTank; 139 131 procedure Init; 140 132 procedure Explosion(Position: TPoint; Distance: Integer); … … 165 157 procedure SaveConfig(Config: TXMLConfig; Path: string); 166 158 function GetAliveCount: Integer; 167 end; 168 169 { TMatter } 170 171 TMatter = class 172 Kind: TMatterKind; 173 Player: Integer; 174 Color: TColor; 175 Diggable: Boolean; 176 Blocking: Boolean; 177 end; 178 179 { TMatters } 180 181 TMatters = class(TObjectList<TMatter>) 182 function AddNew: TMatter; 183 end; 184 185 { TWorld } 186 187 TWorld = class 188 private 189 function GetSize: TMatrixByteIndex; 190 procedure SetSize(const AValue: TMatrixByteIndex); 191 procedure InitMatter; 192 public 193 Engine: TEngine; 194 Surface: TMatrixByte; 195 Matters: TMatters; 196 procedure Generate; 197 constructor Create; 198 destructor Destroy; override; 199 procedure DrawToBitmap(Bitmap: TBitmap); 200 property Size: TMatrixByteIndex read GetSize write SetSize; 159 function GetWinner: TPlayer; 201 160 end; 202 161 … … 243 202 FState: TGameState; 244 203 FSystemThread: TSystemThread; 245 ClearBackground: Boolean;204 FClearBackground: Boolean; 246 205 FStateTime: TDateTime; 206 FShowMenuStats: Boolean; 247 207 procedure InitDigMasks; 248 208 procedure SetActive(const AValue: Boolean); … … 254 214 procedure CheckGameEnd; 255 215 procedure DrawMenu; 216 procedure DrawStats; 256 217 procedure DrawGamePrepare(Thread: TVirtualThread); 257 218 procedure DrawGame; … … 262 223 procedure SetState(AValue: TGameState); 263 224 public 225 ThreadErrorMessage: string; 264 226 Keyboard: TKeyboard; 265 227 World: TWorld; … … 291 253 end; 292 254 293 TFastBitmapPixelComponents = packed record294 B, G, R, A: Byte;295 end;296 297 255 const 298 256 DirectionToDelta: array[0..7] of TPoint = … … 300 258 (X: 0; Y: 1), (X: -1; Y: 1), (X: -1; Y: 0), (X: -1; Y: -1)); 301 259 302 function SwapBRComponent(Value: Cardinal): Cardinal; inline;303 304 260 305 261 implementation 306 262 307 263 uses 308 UPlatform ;264 UPlatform, UFastPixel; 309 265 310 266 resourcestring … … 312 268 SRound = 'Round'; 313 269 SPressEsc = 'Press ESC to continue'; 314 SStartGame = 'start game'; 315 SInstructions = 'instructions'; 316 SInformation = 'information'; 317 SWorldReady = 'world ready'; 318 SExit = 'exit'; 319 320 function SwapBRComponent(Value: Cardinal): Cardinal; inline; 321 begin 322 // Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16); 323 Result := Value; 324 TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B; 325 TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R; 326 end; 327 328 { TMatters } 329 330 function TMatters.AddNew: TMatter; 331 begin 332 Result := TMatter.Create; 333 Add(Result); 334 end; 270 SStartGame = 'Start game'; 271 SInstructions = 'Instructions'; 272 SInformation = 'Information'; 273 SWorldReady = 'World ready'; 274 SExit = 'Exit'; 275 SStatistics = 'Statistics'; 276 SShotsFired = 'Shot fired'; 277 SWinnerIs = 'The winner is'; 335 278 336 279 { TTanks } … … 383 326 with Items[I] do 384 327 if not Exploded then Inc(Result); 328 end; 329 330 function TPlayers.GetWinner: TPlayer; 331 var 332 I: Integer; 333 TopScore: Integer; 334 begin 335 Result := nil; 336 TopScore := 0; 337 for I := 0 to Count - 1 do 338 with Items[I] do 339 if Enabled and (Score > TopScore) then begin 340 TopScore := Score; 341 Result := Items[I]; 342 end; 385 343 end; 386 344 … … 404 362 procedure TSystemThread.Execute; 405 363 begin 406 repeat 407 Engine.Tick; 408 Sleep(10); 409 until Terminated; 364 try 365 repeat 366 Engine.Tick; 367 Sleep(10); 368 until Terminated; 369 except 370 on E: Exception do 371 Engine.ThreadErrorMessage := E.Message; 372 end; 410 373 end; 411 374 … … 429 392 procedure TDrawThread.Execute; 430 393 begin 431 repeat 432 Engine.DrawThread(Self); 433 if not Terminated then Synchronize(DrawSync); 434 Sleep(50); 435 until Terminated; 394 try 395 repeat 396 Engine.DrawThread(Self); 397 if not Terminated then Synchronize(DrawSync); 398 Sleep(50); 399 until Terminated; 400 except 401 on E: Exception do 402 Engine.ThreadErrorMessage := E.Message; 403 end; 436 404 end; 437 405 … … 473 441 FreeAndNil(Image); 474 442 inherited; 475 end;476 477 { TWorld }478 479 function TWorld.GetSize: TMatrixByteIndex;480 begin481 Result := Surface.Count;482 end;483 484 procedure TWorld.SetSize(const AValue: TMatrixByteIndex);485 begin486 Surface.Count := AValue;487 Generate;488 end;489 490 procedure TWorld.InitMatter;491 var492 I: Integer;493 begin494 // Space495 with Matters.AddNew do begin496 Kind := mkSpace;497 Color := clBlack;498 Player := -1;499 end;500 // Dirt1501 with Matters.AddNew do begin502 Kind := mkDirt;503 Color := $0756b0;504 Player := -1;505 Diggable := True;506 end;507 // Dirt2508 with Matters.AddNew do begin509 Kind := mkDirt;510 Color := $2170c3;511 Player := -1;512 Diggable := True;513 end;514 // Rock515 with Matters.AddNew do begin516 Kind := mkRock;517 Color := TColor($9a9a9a);518 Player := -1;519 Blocking := True;520 end;521 // Bullet1522 with Matters.AddNew do begin523 Kind := mkBullet;524 Color := clRed;525 Player := -1;526 end;527 // Bullet2528 with Matters.AddNew do begin529 Kind := mkBullet;530 Color := clRed;531 Player := -1;532 end;533 // Border534 with Matters.AddNew do begin535 Kind := mkBorder;536 Color := clNavy;537 Player := -1;538 end;539 540 for I := 0 to 7 do begin541 // Player cannon542 with Matters.AddNew do begin543 Kind := mkTankBody;544 Player := I;545 Blocking := True;546 end;547 // Player home548 with Matters.AddNew do begin549 Kind := mkHome;550 Player := I;551 Blocking := True;552 end;553 // Player body1554 with Matters.AddNew do begin555 Kind := mkTankBody;556 Player := I;557 Blocking := True;558 end;559 // Player body2560 with Matters.AddNew do begin561 Kind := mkTankBody;562 Player := I;563 Blocking := True;564 end;565 end;566 end;567 568 procedure TWorld.Generate;569 var570 X, Y: Integer;571 Distance: Double;572 Delta: Double;573 begin574 for Y := 0 to Surface.Count.Y - 1 do575 for X := 0 to Surface.Count.X - 1 do begin576 if Random < 0.5 then577 Surface.ItemsXY[X, Y] := Byte(miDirt1) else578 Surface.ItemsXY[X, Y] := Byte(miDirt2);579 end;580 581 Distance := 0.1 * Surface.Count.X;582 Delta := 0;583 for Y := 0 to Surface.Count.Y - 1 do begin584 for X := 0 to Round(Distance) - 1 do begin585 Surface.ItemsXY[X, Y] := Byte(miRock);586 end;587 Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);588 Distance := Distance + Delta;589 end;590 591 Distance := 0.1 * Surface.Count.X;592 Delta := 0;593 for Y := 0 to Surface.Count.Y - 1 do begin594 for X := 0 to Round(Distance) - 1 do begin595 Surface.ItemsXY[Surface.Count.X - 1 - X, Y] := Byte(miRock);596 end;597 Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);598 Distance := Distance + Delta;599 end;600 601 Distance := 0.1 * Surface.Count.Y;602 Delta := 0;603 for X := 0 to Surface.Count.X - 1 do begin604 for Y := 0 to Round(Distance) - 1 do begin605 Surface.ItemsXY[X, Y] := Byte(miRock);606 end;607 Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);608 Distance := Distance + Delta;609 end;610 611 Distance := 0.1 * Surface.Count.Y;612 Delta := 0;613 for X := 0 to Surface.Count.X - 1 do begin614 for Y := 0 to Round(Distance) - 1 do begin615 Surface.ItemsXY[X, Surface.Count.Y - 1 - Y] := Byte(miRock);616 end;617 Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);618 Distance := Distance + Delta;619 end;620 end;621 622 constructor TWorld.Create;623 var624 NewSize: TMatrixByteIndex;625 begin626 Matters := TMatters.Create;627 InitMatter;628 Surface := TMatrixByte.Create;629 NewSize.X := 800;630 NewSize.Y := 300;631 Size := NewSize;632 end;633 634 destructor TWorld.Destroy;635 begin636 FreeAndNil(Surface);637 FreeAndNil(Matters);638 inherited;639 end;640 641 procedure TWorld.DrawToBitmap(Bitmap: TBitmap);642 var643 X, Y: Integer;644 PixelPtr: PInteger;645 PixelRowPtr: PInteger;646 RawImage: TRawImage;647 BytePerPixel: Integer;648 P: Integer;649 begin650 Bitmap.BeginUpdate;651 try652 RawImage := Bitmap.RawImage;653 PixelRowPtr := PInteger(RawImage.Data);654 BytePerPixel := RawImage.Description.BitsPerPixel div 8;655 for Y := 0 to Bitmap.Height - 1 do begin656 PixelPtr := PixelRowPtr;657 for X := 0 to Bitmap.Width - 1 do begin658 P := Matters[Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X),659 Trunc(Y / Bitmap.Height * Surface.Count.Y)]].Color;660 PixelPtr^ := SwapBRComponent(P);661 Inc(PByte(PixelPtr), BytePerPixel);662 end;663 Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);664 end;665 finally666 Bitmap.EndUpdate;667 end;668 443 end; 669 444 … … 712 487 if (Bullets.Count < MaxBulletCount) and 713 488 ((Now - LastShootTime) > ShootDelay * OneSecond) then begin 489 Inc(ShootCount); 714 490 NewBullet := TBullet.Create; 715 491 NewBullet.Player := Self; … … 797 573 if ExplosionPending and (SecondOf(Now - ExplosionTime) > ExplosionDelay) then begin 798 574 ExplosionPending := False; 799 Synchronize(Engine.CheckGameEnd);575 Engine.CheckGameEnd; 800 576 end; 801 577 if LastEnergy <> Energy then begin … … 882 658 end; 883 659 884 if not Exploded then ShowTank;660 if (Engine.State = gsGame) and not Exploded then ShowTank; 885 661 end; 886 662 … … 973 749 if FExploded = AValue then Exit; 974 750 FExploded := AValue; 975 if FExploded then HideTank else ShowTank; 976 Energy := 0; 977 Shield := 0; 751 if FExploded then begin 752 HideTank; 753 Energy := 0; 754 Shield := 0; 755 end else ShowTank; 978 756 end; 979 757 … … 981 759 begin 982 760 with Engine.World do begin 983 Surface.Merge(Surface.CreateIndex(Position.X - TTank(Tanks[Direction]).Image.Count.X div 2, 984 Position.Y - TTank(Tanks[Direction]).Image.Count.Y div 2), 985 TTank(Tanks[Direction]).Image, ShowTankProc); 761 Surface.Merge(Surface.CreateIndex( 762 Position.X - Tanks[Direction].Image.Count.X div 2, 763 Position.Y - Tanks[Direction].Image.Count.Y div 2), 764 Tanks[Direction].Image, ShowTankProc); 986 765 end; 987 766 end; … … 998 777 end; 999 778 1000 procedure TPlayer.Init; 1001 begin 1002 with Engine do 1003 Position := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)), 1004 Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6))); 1005 Exploded := False; 779 procedure TPlayer.ResetTank; 780 begin 781 HideTank; 782 Position := StartPosition; 1006 783 ExplosionPending := False; 1007 784 Bullets.Clear; … … 1009 786 Shield := 1; 1010 787 Direction := 0; 788 ShootCount := 0; 789 ShowTank; 790 Exploded := False; 791 end; 792 793 procedure TPlayer.Init; 794 begin 795 with Engine do 796 StartPosition := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)), 797 Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6))); 798 Position := StartPosition; 1011 799 PlaceHouse; 1012 ShowTank;1013 800 end; 1014 801 … … 1039 826 begin 1040 827 with Engine.World do begin 1041 Surface.Merge(Surface.CreateIndex(Position.X - TTank(Tanks[Direction]).Image.Count.X div 2, 1042 Position.Y - TTank(Tanks[Direction]).Image.Count.Y div 2), TTank(Tanks[Direction]).Image, HideTankProc); 828 Surface.Merge(Surface.CreateIndex( 829 Position.X - Tanks[Direction].Image.Count.X div 2, 830 Position.Y - Tanks[Direction].Image.Count.Y div 2), 831 Tanks[Direction].Image, HideTankProc); 1043 832 end; 1044 833 end; … … 1161 950 Enabled := Source.Enabled; 1162 951 Position := Source.Position; 952 StartPosition := Source.StartPosition; 1163 953 Score := Source.Score; 954 ShootCount := Source.ShootCount; 955 FExploded := Source.FExploded; 1164 956 Tanks.Assign(Source.Tanks); 1165 957 end; … … 1275 1067 BytePerPixel := RawImage.Description.BitsPerPixel div 8; 1276 1068 BytePerRow := RawImage.Description.BytesPerLine; 1277 if ClearBackground then begin1069 if FClearBackground then begin 1278 1070 BgColor := World.Matters[Integer(miBorder)].Color; 1279 1071 BgColor := SwapBRComponent(BgColor); 1280 1072 FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor); 1281 ClearBackground := False;1073 FClearBackground := False; 1282 1074 end; 1283 1075 … … 1338 1130 1339 1131 procedure TEngine.DrawInformation; 1132 var 1133 Text: string; 1134 X: Integer; 1340 1135 begin 1341 1136 with Bitmap.Canvas do begin 1342 1137 Brush.Style := bsSolid; 1138 Brush.Color := clBlack; 1139 Clear; 1140 1141 X := Bitmap.Width div 2; 1142 1143 Brush.Style := bsClear; 1144 Pen.Style := psSolid; 1145 Pen.Color := clWhite; 1146 Font.Color := clTuna; 1147 Font.Size := 30; 1148 Text := SInformation; 1149 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text); 1150 1151 Font.Color := clGreen; 1152 Font.Size := 30; 1153 Text := SPressEsc; 1154 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text); 1343 1155 end; 1344 1156 end; 1345 1157 1346 1158 procedure TEngine.DrawInstructions; 1347 begin 1348 1159 var 1160 Text: string; 1161 X: Integer; 1162 begin 1163 with Bitmap.Canvas do begin 1164 Brush.Style := bsSolid; 1165 Brush.Color := clBlack; 1166 Clear; 1167 1168 X := Bitmap.Width div 2; 1169 1170 Brush.Style := bsClear; 1171 Pen.Style := psSolid; 1172 Pen.Color := clWhite; 1173 Font.Color := clTuna; 1174 Font.Size := 30; 1175 Text := SInstructions; 1176 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text); 1177 1178 Font.Color := clGreen; 1179 Font.Size := 30; 1180 Text := SPressEsc; 1181 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text); 1182 end; 1349 1183 end; 1350 1184 … … 1630 1464 var 1631 1465 Text: string; 1466 MenuWidth: Integer; 1632 1467 begin 1633 1468 with Bitmap.Canvas do begin … … 1635 1470 Brush.Color := clBlack; 1636 1471 Clear; 1472 1473 if FShowMenuStats then begin 1474 MenuWidth := Bitmap.Width div 2; 1475 DrawStats; 1476 end else MenuWidth := Bitmap.Width; 1637 1477 1638 1478 Brush.Style := bsClear; … … 1642 1482 Font.Size := 30; 1643 1483 Text := 'TUNNELER'; 1644 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);1484 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text); 1645 1485 1646 1486 Font.Color := clDarkOrange; 1647 1487 Font.Size := 20; 1648 1488 Text := 'by Chronosoft'; 1649 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 + 60, Text);1489 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text); 1650 1490 1651 1491 Pen.Color := clPurple; 1652 1492 Pen.Width := 6; 1653 Frame(( Bitmap.Width - 400) div 2, Bitmap.Height div 10 * 4 - 40,1654 ( Bitmap.Width + 400) div 2, Bitmap.Height div 10 * 4 + 200);1493 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40, 1494 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 200); 1655 1495 1656 1496 Font.Color := clPurple; 1657 1497 Font.Size := 20; 1658 1498 Text := '<F1> ' + SStartGame; 1659 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);1499 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text); 1660 1500 Text := '<F2> ' + SInstructions; 1661 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);1501 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text); 1662 1502 Text := '<F3> ' + SInformation; 1663 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);1664 Text := '< F10> ' + SExit;1665 TextOut(( Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);1503 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text); 1504 Text := '<Alt+F4> ' + SExit; 1505 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text); 1666 1506 1667 1507 Font.Color := clDarkGreen; 1668 1508 Font.Size := 20; 1669 1509 Text := '(' + SWorldReady + ')'; 1670 TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); 1510 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); 1511 end; 1512 end; 1513 1514 procedure TEngine.DrawStats; 1515 var 1516 X: Integer; 1517 Text: string; 1518 Winner: TPlayer; 1519 begin 1520 with Bitmap.Canvas do begin 1521 X := Bitmap.Width div 4 * 3; 1522 1523 Brush.Style := bsClear; 1524 Pen.Style := psSolid; 1525 1526 Pen.Color := clWhite; 1527 MoveTo(Bitmap.Width div 2, 0); 1528 LineTo(Bitmap.Width div 2, Bitmap.Height); 1529 1530 Font.Color := clCyan; 1531 Font.Size := 20; 1532 Text := SStatistics; 1533 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text); 1534 1535 Font.Color := clOrange; 1536 Font.Size := 20; 1537 1538 //Text := SShotsFired + ' ' + IntToStr(ShootCount); 1539 //TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text); 1540 1541 Winner := Players.GetWinner; 1542 if Assigned(Winner) then begin 1543 Text := SWinnerIs + ' ' + Winner.Name; 1544 TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 + 60, Text); 1545 end; 1671 1546 end; 1672 1547 end; … … 1684 1559 FBitmapLower.Count := OldCount; 1685 1560 1686 if ClearBackground then FBitmapLower.FillAll(clNavy);1561 if FClearBackground then FBitmapLower.FillAll(clNavy); 1687 1562 for I := 0 to Players.Count - 1 do 1688 1563 if Players[I].Enabled then begin … … 1719 1594 end; 1720 1595 end; 1721 ClearBackground := True;1596 FClearBackground := True; 1722 1597 Redraw; 1723 1598 end; … … 1735 1610 Keyboard := TKeyboard.Create; 1736 1611 World := TWorld.Create; 1737 World.Engine := Self;1738 1612 //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil); 1739 1613 AudioShot := TMediaPlayer.Create(nil); … … 1747 1621 InitDigMasks; 1748 1622 Redraw; 1749 MaxRound := 3;1623 MaxRound := 5; 1750 1624 end; 1751 1625 … … 1814 1688 1815 1689 procedure TEngine.NewGame; 1690 var 1691 I: Integer; 1816 1692 begin 1817 1693 Active := False; … … 1819 1695 ResizePlayerFrames; 1820 1696 CurrentRound := 1; 1821 NewRound;1822 1823 Active := True;1824 end;1825 1826 procedure TEngine.NewRound;1827 var1828 I: Integer;1829 begin1830 1697 World.Generate; 1831 1832 1698 for I := 0 to Players.Count - 1 do 1833 1699 Players[I].Init; 1834 ClearBackground := True; 1700 NewRound; 1701 1702 Active := True; 1703 end; 1704 1705 procedure TEngine.NewRound; 1706 var 1707 I: Integer; 1708 begin 1709 for I := 0 to Players.Count - 1 do 1710 Players[I].ResetTank; 1711 FClearBackground := True; 1835 1712 Redraw; 1836 1713 end; … … 1866 1743 if Key = KeyF2 then begin 1867 1744 State := gsInstructions; 1868 NewGame;1869 1745 end else 1870 1746 if Key = KeyF3 then begin 1871 1747 State := gsInformation; 1872 NewGame;1873 1748 end; 1874 1749 end else … … 1876 1751 if Key = KeyEsc then begin 1877 1752 State := gsMenu; 1753 FShowMenuStats := True; 1754 end; 1755 end else 1756 if State in [gsInformation, gsInstructions] then begin 1757 if Key = KeyEsc then begin 1758 State := gsMenu; 1878 1759 end; 1879 1760 end; 1880 1761 1881 1762 {$IFDEF DEBUG} 1882 if Key = KeyF4then begin1763 if (State = gsGame) and (Key = KeyF4) then begin 1883 1764 // Destroy first alive player 1884 1765 for I := 0 to Players.Count - 1 do … … 1890 1771 end; 1891 1772 end else 1892 if Key = KeyF5then begin1773 if (State = gsGame) and (Key = KeyF5) then begin 1893 1774 State := gsMap; 1894 1775 end;
Note:
See TracChangeset
for help on using the changeset viewer.