Changeset 85 for trunk/Engine.pas
- Timestamp:
- May 17, 2024, 8:07:49 PM (6 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Engine.pas
r84 r85 151 151 procedure HideTank; 152 152 procedure InitTanks; 153 procedure ClearKeys; 153 154 constructor Create; 154 155 destructor Destroy; override; … … 172 173 procedure EnableMore; 173 174 procedure EnableLess; 175 procedure ClearKey(Key: Integer); 174 176 end; 175 177 … … 201 203 202 204 TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation, 203 gsInstructions, gsSettings );205 gsInstructions, gsSettings, gsPlayerKeys, gsPlayerKeysRedefine); 204 206 205 207 { TEngine } … … 220 222 FStateTime: TDateTime; 221 223 FShowMenuStats: Boolean; 224 FSelectedPlayer: TPlayer; 222 225 procedure InitDigMasks; 223 226 procedure SetActive(const AValue: Boolean); … … 234 237 procedure DrawInstructions; 235 238 procedure DrawSettings; 239 procedure DrawPlayerKeys; 240 procedure DrawPlayerKeysRedefine; 236 241 procedure DrawNewRound; 237 242 procedure DrawMap; … … 239 244 procedure ShowMenuItem(Key, Text: string; X, Y: Integer; Canvas: TCanvas); 240 245 function TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer; 246 function GetMenuWidth: Integer; 241 247 public 242 248 ThreadErrorMessage: string; … … 252 258 AudioExplode: TSound; 253 259 DrawDuration: TDatetime; 260 HomePage: string; 254 261 constructor Create(AOwner: TComponent); override; 255 262 destructor Destroy; override; … … 282 289 283 290 uses 284 Platform, FastPixel ;291 Platform, FastPixel, UITypes2; 285 292 286 293 resourcestring … … 309 316 'It supports High DPI scaling. It supports up to eight players.'; 310 317 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';318 'Homepage: %s'; 312 319 SSettings = 'Settings'; 313 320 SWorldReady = 'World ready'; … … 330 337 SMorePlayers = 'More players'; 331 338 SLessPlayers = 'Less players'; 339 SPlayersKeys = 'Players keys'; 340 SDefinePlayerKeys = 'Define player keys'; 332 341 SBack = 'Back'; 333 342 SPlayersCount = 'Players count'; 343 SLeft = 'Left'; 344 SUp = 'Up'; 345 SRight = 'Right'; 346 SDown = 'Down'; 347 SShoot = 'Shoot'; 348 SSet = 'Set'; 349 SDone = 'Done'; 334 350 335 351 { TBullets } … … 453 469 Break; 454 470 end; 471 end; 472 end; 473 474 procedure TPlayers.ClearKey(Key: Integer); 475 var 476 I: Integer; 477 begin 478 for I := 0 to Count - 1 do 479 with Items[I].Keys do begin 480 if Left = Key then Left := 0; 481 if Up = Key then Up := 0; 482 if Right = Key then Right := 0; 483 if Down = Key then Down := 0; 484 if Shoot = Key then Shoot := 0; 455 485 end; 456 486 end; … … 1032 1062 end; 1033 1063 1064 procedure TPlayer.ClearKeys; 1065 begin 1066 Keys.Left := 0; 1067 Keys.Up := 0; 1068 Keys.Right := 0; 1069 Keys.Down := 0; 1070 Keys.Shoot := 0; 1071 end; 1072 1034 1073 constructor TPlayer.Create; 1035 1074 begin … … 1281 1320 Inc(Y, LineHeight); 1282 1321 1283 Text := SInformationDetails2;1322 Text := Format(SInformationDetails2, [HomePage]); 1284 1323 Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text, Bitmap.Width - 60)); 1285 1324 Inc(Y, LineHeight); … … 1353 1392 ClearBackground; 1354 1393 1355 if FShowMenuStats then begin 1356 MenuWidth := Bitmap.Width div 2; 1357 DrawStats; 1358 end else MenuWidth := Bitmap.Width; 1394 MenuWidth := GetMenuWidth; 1359 1395 1360 1396 Brush.Style := bsClear; … … 1364 1400 Font.Size := 30; 1365 1401 Text := SSettings; 1366 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);1402 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1367 1403 1368 1404 Pen.Color := clPurple; 1369 1405 Pen.Width := 6; 1370 1406 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40, 1371 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);1407 (MenuWidth + 500) div 2, Bitmap.Height div 10 * 4 + 200); 1372 1408 1373 1409 Font.Color := clPurple; … … 1376 1412 ShowMenuItem('F1', SMorePlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1377 1413 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); 1414 ShowMenuItem('F3', SPlayersKeys, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1415 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas); 1379 1416 1380 1417 Font.Color := clDarkGreen; 1381 1418 Font.Size := 20; 1382 1419 Text := SPlayersCount + ': ' + IntToStr(PlayerPool.GetEnabledCount); 1383 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 6, Text); 1420 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 8, Text); 1421 end; 1422 end; 1423 1424 procedure TEngine.DrawPlayerKeys; 1425 var 1426 Text: string; 1427 MenuWidth: Integer; 1428 Y: Integer; 1429 I: Integer; 1430 begin 1431 with Bitmap.Canvas do begin 1432 ClearBackground; 1433 1434 MenuWidth := GetMenuWidth; 1435 1436 Brush.Style := bsClear; 1437 Pen.Style := psSolid; 1438 Pen.Color := clWhite; 1439 Font.Color := clTuna; 1440 Font.Size := 30; 1441 Text := SPlayersKeys; 1442 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1443 1444 Pen.Color := clPurple; 1445 Pen.Width := 6; 1446 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40, 1447 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 440); 1448 1449 Font.Color := clPurple; 1450 Font.Size := 20; 1451 1452 Y := Bitmap.Height div 10 * 4; 1453 for I := 0 to PlayerPool.GetEnabledCount - 1 do begin 1454 Font.Color := PlayerPool[I].Color1; 1455 ShowMenuItem('F' + IntToStr(I + 1), PlayerPool[I].Name, MenuWidth div 2 - 180, Y, Bitmap.Canvas); 1456 Y := Y + 40; 1457 end; 1458 Font.Color := clPurple; 1459 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Y, Bitmap.Canvas); 1460 end; 1461 end; 1462 1463 procedure TEngine.DrawPlayerKeysRedefine; 1464 var 1465 Text: string; 1466 MenuWidth: Integer; 1467 Y: Integer; 1468 I: Integer; 1469 1470 function IsKeySet(Key: Integer): string; 1471 begin 1472 if Key <> 0 then Result := SSet 1473 else Result := ''; 1474 end; 1475 1476 begin 1477 with Bitmap.Canvas do begin 1478 ClearBackground; 1479 1480 MenuWidth := GetMenuWidth; 1481 1482 Brush.Style := bsClear; 1483 Pen.Style := psSolid; 1484 Pen.Color := clWhite; 1485 Font.Color := clTuna; 1486 Font.Size := 30; 1487 Text := SDefinePlayerKeys; 1488 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 20, Text); 1489 1490 Pen.Color := clPurple; 1491 Pen.Width := 6; 1492 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40, 1493 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 280); 1494 1495 Font.Color := clPurple; 1496 Font.Size := 20; 1497 1498 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Left), SLeft, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas); 1499 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Up), SUp, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas); 1500 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Right), SRight, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1501 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Down), SDown, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas); 1502 ShowMenuItem(IsKeySet(FSelectedPlayer.Keys.Shoot), SShoot, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 160, Bitmap.Canvas); 1503 ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 200, Bitmap.Canvas); 1504 1505 if (FSelectedPlayer.Keys.Left <> 0) and 1506 (FSelectedPlayer.Keys.Up <> 0) and 1507 (FSelectedPlayer.Keys.Right <> 0) and 1508 (FSelectedPlayer.Keys.Down <> 0) and 1509 (FSelectedPlayer.Keys.Shoot <> 0) then begin 1510 Font.Color := clDarkGreen; 1511 Font.Size := 20; 1512 Text := SDone; 1513 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text); 1514 end; 1384 1515 end; 1385 1516 end; … … 1465 1596 end; 1466 1597 1598 function TEngine.GetMenuWidth: Integer; 1599 begin 1600 if FShowMenuStats then begin 1601 Result := Bitmap.Width div 2; 1602 DrawStats; 1603 end else Result := Bitmap.Width; 1604 end; 1605 1467 1606 procedure TEngine.InitDigMasks; 1468 1607 var … … 1561 1700 with PlayerPool.AddNew do begin 1562 1701 Name := SGreen; 1563 Keys.Left := 65;1564 Keys.Down := 83;1565 Keys.Right := 68;1566 Keys.Up := 87;1567 Keys.Shoot := 69;1702 Keys.Left := vkA; 1703 Keys.Down := vkS; 1704 Keys.Right := vkD; 1705 Keys.Up := vkW; 1706 Keys.Shoot := vkE; 1568 1707 Color1 := $00ff00; 1569 1708 Color2 := $00a000; … … 1572 1711 with PlayerPool.AddNew do begin 1573 1712 Name := SBlue; 1574 Keys.Left := 37;1575 Keys.Down := 40;1576 Keys.Right := 39;1577 Keys.Up := 38;1578 Keys.Shoot := 17;1713 Keys.Left := vkLeft; 1714 Keys.Down := vkDown; 1715 Keys.Right := vkRight; 1716 Keys.Up := vkUp; 1717 Keys.Shoot := vkControl; 1579 1718 Color1 := $ff2c2c; 1580 1719 Color2 := $b60000; … … 1583 1722 with PlayerPool.AddNew do begin 1584 1723 Name := SRed; 1585 Keys.Left := 76;1724 Keys.Left := vkL; 1586 1725 Keys.Down := 147; 1587 Keys.Right := 222;1588 Keys.Up := 80;1589 Keys.Shoot := 191;1726 Keys.Right := vkQuote; 1727 Keys.Up := vkP; 1728 Keys.Shoot := vkSlash; 1590 1729 Color1 := $0000ff; 1591 1730 Color2 := $0000a0; … … 1593 1732 with PlayerPool.AddNew do begin 1594 1733 Name := SPink; 1595 Keys.Left := 100;1596 Keys.Down := 98;1597 Keys.Right := 102;1598 Keys.Up := 104;1599 Keys.Shoot := 105;1734 Keys.Left := vkNumpad4; 1735 Keys.Down := vkNumpad2; 1736 Keys.Right := vkNumpad6; 1737 Keys.Up := vkNumpad8; 1738 Keys.Shoot := vkNumpad9; 1600 1739 Color1 := $ff2cff; 1601 1740 Color2 := $b600b6; … … 1712 1851 ClearBackground; 1713 1852 1714 if FShowMenuStats then begin 1715 MenuWidth := Bitmap.Width div 2; 1716 DrawStats; 1717 end else MenuWidth := Bitmap.Width; 1853 MenuWidth := GetMenuWidth; 1718 1854 1719 1855 Brush.Style := bsClear; … … 1727 1863 Font.Color := clDarkOrange; 1728 1864 Font.Size := 20; 1729 Text := 'by Chronos oft';1865 Text := 'by Chronos'; 1730 1866 TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text); 1731 1867 … … 1973 2109 gsMap: DrawMap; 1974 2110 gsNewRound: DrawNewRound; 2111 gsPlayerKeys: DrawPlayerKeys; 2112 gsPlayerKeysRedefine: DrawPlayerKeysRedefine; 1975 2113 end; 1976 2114 … … 2034 2172 2035 2173 procedure TEngine.KeyUp(Key: Word); 2036 const2037 KeyF1 = 112;2038 KeyF2 = 113;2039 KeyF3 = 114;2040 KeyF4 = 115;2041 KeyF5 = 116;2042 KeyF10 = 121;2043 KeyEsc = 27;2044 2174 var 2045 2175 I: Integer; … … 2048 2178 2049 2179 if State = gsMenu then begin 2050 if Key = KeyF1 then begin2180 if Key = vkF1 then begin 2051 2181 State := gsNewRound; 2052 2182 NewGame; 2053 2183 end else 2054 if Key = KeyF2 then begin2184 if Key = vkF2 then begin 2055 2185 State := gsInstructions; 2056 2186 end else 2057 if Key = KeyF3 then begin2187 if Key = vkF3 then begin 2058 2188 State := gsInformation; 2059 2189 end else 2060 if Key = KeyF4 then begin2190 if Key = vkF4 then begin 2061 2191 State := gsSettings; 2062 2192 end else 2063 if Key = KeyF10 then begin2193 if Key = vkF10 then begin 2064 2194 if Assigned(FOnClose) then FOnClose(Self); 2065 2195 end; 2066 2196 end else 2067 2197 if State = gsMap then begin 2068 if Key = KeyEscthen begin2198 if Key = vkEscape then begin 2069 2199 State := gsMenu; 2070 2200 FShowMenuStats := True; … … 2072 2202 end else 2073 2203 if State in [gsInformation, gsInstructions] then begin 2074 if Key = KeyEscthen begin2204 if Key = vkEscape then begin 2075 2205 State := gsMenu; 2076 2206 end; 2077 2207 end else 2078 2208 if State = gsSettings then begin 2079 if Key = KeyF1 then begin2209 if Key = vkF1 then begin 2080 2210 PlayerPool.EnableMore; 2081 2211 Redraw; 2082 2212 end else 2083 if Key = KeyF2 then begin2213 if Key = vkF2 then begin 2084 2214 PlayerPool.EnableLess; 2085 2215 Redraw; 2086 2216 end else 2087 if Key = KeyEsc then begin 2217 if Key = vkF3 then begin 2218 State := gsPlayerKeys; 2219 end else 2220 if Key = vkEscape then begin 2088 2221 State := gsMenu; 2222 end; 2223 end else 2224 if State = gsPlayerKeys then begin 2225 if Key = vkF1 then begin 2226 FSelectedPlayer := PlayerPool[0]; 2227 FSelectedPlayer.ClearKeys; 2228 State := gsPlayerKeysRedefine; 2229 end else 2230 if Key = vkF2 then begin 2231 FSelectedPlayer := PlayerPool[1]; 2232 FSelectedPlayer.ClearKeys; 2233 State := gsPlayerKeysRedefine; 2234 end else 2235 if Key = vkF3 then begin 2236 FSelectedPlayer := PlayerPool[2]; 2237 FSelectedPlayer.ClearKeys; 2238 State := gsPlayerKeysRedefine; 2239 end else 2240 if Key = vkF4 then begin 2241 FSelectedPlayer := PlayerPool[3]; 2242 FSelectedPlayer.ClearKeys; 2243 State := gsPlayerKeysRedefine; 2244 end else 2245 if Key = vkF5 then begin 2246 FSelectedPlayer := PlayerPool[4]; 2247 FSelectedPlayer.ClearKeys; 2248 State := gsPlayerKeysRedefine; 2249 end else 2250 if Key = vkF6 then begin 2251 FSelectedPlayer := PlayerPool[5]; 2252 FSelectedPlayer.ClearKeys; 2253 State := gsPlayerKeysRedefine; 2254 end else 2255 if Key = vkF7 then begin 2256 FSelectedPlayer := PlayerPool[6]; 2257 FSelectedPlayer.ClearKeys; 2258 State := gsPlayerKeysRedefine; 2259 end else 2260 if Key = vkF8 then begin 2261 FSelectedPlayer := PlayerPool[7]; 2262 FSelectedPlayer.ClearKeys; 2263 State := gsPlayerKeysRedefine; 2264 end else 2265 if Key = vkEscape then begin 2266 State := gsSettings; 2267 end; 2268 end else 2269 if State = gsPlayerKeysRedefine then begin 2270 if Key = vkEscape then begin 2271 State := gsPlayerKeys; 2272 end else begin 2273 if FSelectedPlayer.Keys.Left = 0 then begin 2274 PlayerPool.ClearKey(Key); 2275 FSelectedPlayer.Keys.Left := Key; 2276 end else 2277 if FSelectedPlayer.Keys.Up = 0 then begin 2278 PlayerPool.ClearKey(Key); 2279 FSelectedPlayer.Keys.Up := Key; 2280 end else 2281 if FSelectedPlayer.Keys.Right = 0 then begin 2282 PlayerPool.ClearKey(Key); 2283 FSelectedPlayer.Keys.Right := Key; 2284 end else 2285 if FSelectedPlayer.Keys.Down = 0 then begin 2286 PlayerPool.ClearKey(Key); 2287 FSelectedPlayer.Keys.Down := Key; 2288 end else 2289 if FSelectedPlayer.Keys.Shoot = 0 then begin 2290 PlayerPool.ClearKey(Key); 2291 FSelectedPlayer.Keys.Shoot := Key; 2292 end; 2293 2294 Redraw; 2089 2295 end; 2090 2296 end else 2091 2297 if State = gsGame then begin 2092 if Key = KeyEscthen begin2298 if Key = vkEscape then begin 2093 2299 State := gsMap; 2094 2300 end; … … 2096 2302 2097 2303 {$IFDEF DEBUG} 2098 if (State = gsGame) and (Key = KeyF5) then begin2304 if (State = gsGame) and (Key = vkF5) then begin 2099 2305 // Destroy first alive player 2100 2306 for I := 0 to Players.Count - 1 do
Note:
See TracChangeset
for help on using the changeset viewer.