Changeset 85 for trunk/Engine.pas


Ignore:
Timestamp:
May 17, 2024, 8:07:49 PM (7 weeks ago)
Author:
chronos
Message:
  • Added: Allow to reconfigure players keys.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Engine.pas

    r84 r85  
    151151    procedure HideTank;
    152152    procedure InitTanks;
     153    procedure ClearKeys;
    153154    constructor Create;
    154155    destructor Destroy; override;
    … …  
    172173    procedure EnableMore;
    173174    procedure EnableLess;
     175    procedure ClearKey(Key: Integer);
    174176  end;
    175177
    … …  
    201203
    202204  TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
    203     gsInstructions, gsSettings);
     205    gsInstructions, gsSettings, gsPlayerKeys, gsPlayerKeysRedefine);
    204206
    205207  { TEngine }
    … …  
    220222    FStateTime: TDateTime;
    221223    FShowMenuStats: Boolean;
     224    FSelectedPlayer: TPlayer;
    222225    procedure InitDigMasks;
    223226    procedure SetActive(const AValue: Boolean);
    … …  
    234237    procedure DrawInstructions;
    235238    procedure DrawSettings;
     239    procedure DrawPlayerKeys;
     240    procedure DrawPlayerKeysRedefine;
    236241    procedure DrawNewRound;
    237242    procedure DrawMap;
    … …  
    239244    procedure ShowMenuItem(Key, Text: string; X, Y: Integer; Canvas: TCanvas);
    240245    function TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
     246    function GetMenuWidth: Integer;
    241247  public
    242248    ThreadErrorMessage: string;
    … …  
    252258    AudioExplode: TSound;
    253259    DrawDuration: TDatetime;
     260    HomePage: string;
    254261    constructor Create(AOwner: TComponent); override;
    255262    destructor Destroy; override;
    … …  
    282289
    283290uses
    284   Platform, FastPixel;
     291  Platform, FastPixel, UITypes2;
    285292
    286293resourcestring
    … …  
    309316    'It supports High DPI scaling. It supports up to eight players.';
    310317  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';
    312319  SSettings = 'Settings';
    313320  SWorldReady = 'World ready';
    … …  
    330337  SMorePlayers = 'More players';
    331338  SLessPlayers = 'Less players';
     339  SPlayersKeys = 'Players keys';
     340  SDefinePlayerKeys = 'Define player keys';
    332341  SBack = 'Back';
    333342  SPlayersCount = 'Players count';
     343  SLeft = 'Left';
     344  SUp = 'Up';
     345  SRight = 'Right';
     346  SDown = 'Down';
     347  SShoot = 'Shoot';
     348  SSet = 'Set';
     349  SDone = 'Done';
    334350
    335351{ TBullets }
    … …  
    453469      Break;
    454470    end;
     471  end;
     472end;
     473
     474procedure TPlayers.ClearKey(Key: Integer);
     475var
     476  I: Integer;
     477begin
     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;
    455485  end;
    456486end;
    … …  
    10321062end;
    10331063
     1064procedure TPlayer.ClearKeys;
     1065begin
     1066  Keys.Left := 0;
     1067  Keys.Up := 0;
     1068  Keys.Right := 0;
     1069  Keys.Down := 0;
     1070  Keys.Shoot := 0;
     1071end;
     1072
    10341073constructor TPlayer.Create;
    10351074begin
    … …  
    12811320    Inc(Y, LineHeight);
    12821321
    1283     Text := SInformationDetails2;
     1322    Text := Format(SInformationDetails2, [HomePage]);
    12841323    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
    12851324    Inc(Y, LineHeight);
    … …  
    13531392    ClearBackground;
    13541393
    1355     if FShowMenuStats then begin
    1356       MenuWidth := Bitmap.Width div 2;
    1357       DrawStats;
    1358     end else MenuWidth := Bitmap.Width;
     1394    MenuWidth := GetMenuWidth;
    13591395
    13601396    Brush.Style := bsClear;
    … …  
    13641400    Font.Size := 30;
    13651401    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);
    13671403
    13681404    Pen.Color := clPurple;
    13691405    Pen.Width := 6;
    13701406    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);
    13721408
    13731409    Font.Color := clPurple;
    … …  
    13761412    ShowMenuItem('F1', SMorePlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas);
    13771413    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);
    13791416
    13801417    Font.Color := clDarkGreen;
    13811418    Font.Size := 20;
    13821419    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;
     1422end;
     1423
     1424procedure TEngine.DrawPlayerKeys;
     1425var
     1426  Text: string;
     1427  MenuWidth: Integer;
     1428  Y: Integer;
     1429  I: Integer;
     1430begin
     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;
     1461end;
     1462
     1463procedure TEngine.DrawPlayerKeysRedefine;
     1464var
     1465  Text: string;
     1466  MenuWidth: Integer;
     1467  Y: Integer;
     1468  I: Integer;
     1469
     1470function IsKeySet(Key: Integer): string;
     1471begin
     1472  if Key <> 0 then Result := SSet
     1473    else Result := '';
     1474end;
     1475
     1476begin
     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;
    13841515  end;
    13851516end;
    … …  
    14651596end;
    14661597
     1598function TEngine.GetMenuWidth: Integer;
     1599begin
     1600  if FShowMenuStats then begin
     1601    Result := Bitmap.Width div 2;
     1602    DrawStats;
     1603  end else Result := Bitmap.Width;
     1604end;
     1605
    14671606procedure TEngine.InitDigMasks;
    14681607var
    … …  
    15611700  with PlayerPool.AddNew do begin
    15621701    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;
    15681707    Color1 := $00ff00;
    15691708    Color2 := $00a000;
    … …  
    15721711  with PlayerPool.AddNew do begin
    15731712    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;
    15791718    Color1 := $ff2c2c;
    15801719    Color2 := $b60000;
    … …  
    15831722  with PlayerPool.AddNew do begin
    15841723    Name := SRed;
    1585     Keys.Left := 76;
     1724    Keys.Left := vkL;
    15861725    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;
    15901729    Color1 := $0000ff;
    15911730    Color2 := $0000a0;
    … …  
    15931732  with PlayerPool.AddNew do begin
    15941733    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;
    16001739    Color1 := $ff2cff;
    16011740    Color2 := $b600b6;
    … …  
    17121851    ClearBackground;
    17131852
    1714     if FShowMenuStats then begin
    1715       MenuWidth := Bitmap.Width div 2;
    1716       DrawStats;
    1717     end else MenuWidth := Bitmap.Width;
     1853    MenuWidth := GetMenuWidth;
    17181854
    17191855    Brush.Style := bsClear;
    … …  
    17271863    Font.Color := clDarkOrange;
    17281864    Font.Size := 20;
    1729     Text := 'by Chronosoft';
     1865    Text := 'by Chronos';
    17301866    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text);
    17311867
    … …  
    19732109      gsMap: DrawMap;
    19742110      gsNewRound: DrawNewRound;
     2111      gsPlayerKeys: DrawPlayerKeys;
     2112      gsPlayerKeysRedefine: DrawPlayerKeysRedefine;
    19752113    end;
    19762114
    … …  
    20342172
    20352173procedure 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;
    20442174var
    20452175  I: Integer;
    … …  
    20482178
    20492179  if State = gsMenu then begin
    2050     if Key = KeyF1 then begin
     2180    if Key = vkF1 then begin
    20512181      State := gsNewRound;
    20522182      NewGame;
    20532183    end else
    2054     if Key = KeyF2 then begin
     2184    if Key = vkF2 then begin
    20552185      State := gsInstructions;
    20562186    end else
    2057     if Key = KeyF3 then begin
     2187    if Key = vkF3 then begin
    20582188      State := gsInformation;
    20592189    end else
    2060     if Key = KeyF4 then begin
     2190    if Key = vkF4 then begin
    20612191      State := gsSettings;
    20622192    end else
    2063     if Key = KeyF10 then begin
     2193    if Key = vkF10 then begin
    20642194      if Assigned(FOnClose) then FOnClose(Self);
    20652195    end;
    20662196  end else
    20672197  if State = gsMap then begin
    2068     if Key = KeyEsc then begin
     2198    if Key = vkEscape then begin
    20692199      State := gsMenu;
    20702200      FShowMenuStats := True;
    … …  
    20722202  end else
    20732203  if State in [gsInformation, gsInstructions] then begin
    2074     if Key = KeyEsc then begin
     2204    if Key = vkEscape then begin
    20752205      State := gsMenu;
    20762206    end;
    20772207  end else
    20782208  if State = gsSettings then begin
    2079     if Key = KeyF1 then begin
     2209    if Key = vkF1 then begin
    20802210      PlayerPool.EnableMore;
    20812211      Redraw;
    20822212    end else
    2083     if Key = KeyF2 then begin
     2213    if Key = vkF2 then begin
    20842214      PlayerPool.EnableLess;
    20852215      Redraw;
    20862216    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
    20882221      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;
    20892295    end;
    20902296  end else
    20912297  if State = gsGame then begin
    2092      if Key = KeyEsc then begin
     2298     if Key = vkEscape then begin
    20932299       State := gsMap;
    20942300     end;
    … …  
    20962302
    20972303  {$IFDEF DEBUG}
    2098   if (State = gsGame) and (Key = KeyF5) then begin
     2304  if (State = gsGame) and (Key = vkF5) then begin
    20992305    // Destroy first alive player
    21002306    for I := 0 to Players.Count - 1 do
Note: See TracChangeset for help on using the changeset viewer.