Changeset 84 for trunk/Engine.pas
- Timestamp:
- May 17, 2024, 5:16:27 PM (6 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Engine.pas
r83 r84 169 169 function GetAliveCount: Integer; 170 170 function GetWinner: TPlayer; 171 function GetEnabledCount: Integer; 172 procedure EnableMore; 173 procedure EnableLess; 171 174 end; 172 175 … … 198 201 199 202 TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation, 200 gsInstructions );203 gsInstructions, gsSettings); 201 204 202 205 { TEngine } … … 230 233 procedure DrawInformation; 231 234 procedure DrawInstructions; 235 procedure DrawSettings; 232 236 procedure DrawNewRound; 233 237 procedure DrawMap; … … 306 310 SInformationDetails2 = 'This is a public domain open source program: feel free to copy it for friends and study the source code. \n ' + 307 311 'Homepage: https://app.zdechov.net/Tunneler'; 312 SSettings = 'Settings'; 308 313 SWorldReady = 'World ready'; 309 314 SExit = 'Exit'; … … 323 328 SOrange = 'Orange'; 324 329 SGray = 'Gray'; 330 SMorePlayers = 'More players'; 331 SLessPlayers = 'Less players'; 332 SBack = 'Back'; 333 SPlayersCount = 'Players count'; 325 334 326 335 { TBullets } … … 409 418 TopScore := Score; 410 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; 411 455 end; 412 456 end; … … 1301 1345 end; 1302 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 1303 1387 procedure TEngine.DrawNewRound; 1304 1388 var … … 1649 1733 Pen.Width := 6; 1650 1734 Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40, 1651 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 2 00);1735 (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240); 1652 1736 1653 1737 Font.Color := clPurple; … … 1657 1741 ShowMenuItem('F2', SInstructions, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas); 1658 1742 ShowMenuItem('F3', SInformation, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas); 1659 ShowMenuItem('F10', SExit, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, 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); 1660 1745 1661 1746 Font.Color := clDarkGreen; … … 1885 1970 gsInformation: DrawInformation; 1886 1971 gsInstructions: DrawInstructions; 1972 gsSettings: DrawSettings; 1887 1973 gsMap: DrawMap; 1888 1974 gsNewRound: DrawNewRound; … … 1953 2039 KeyF3 = 114; 1954 2040 KeyF4 = 115; 2041 KeyF5 = 116; 1955 2042 KeyF10 = 121; 1956 2043 KeyEsc = 27; … … 1971 2058 State := gsInformation; 1972 2059 end else 2060 if Key = KeyF4 then begin 2061 State := gsSettings; 2062 end else 1973 2063 if Key = KeyF10 then begin 1974 2064 if Assigned(FOnClose) then FOnClose(Self); … … 1986 2076 end; 1987 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 1988 2091 if State = gsGame then begin 1989 2092 if Key = KeyEsc then begin … … 1993 2096 1994 2097 {$IFDEF DEBUG} 1995 if (State = gsGame) and (Key = KeyF 4) then begin2098 if (State = gsGame) and (Key = KeyF5) then begin 1996 2099 // Destroy first alive player 1997 2100 for I := 0 to Players.Count - 1 do
Note:
See TracChangeset
for help on using the changeset viewer.