Changeset 84

Timestamp:

May 17, 2024, 5:16:27 PM (6 weeks ago)

Author:

chronos

Message:

• Added: A new settings page where number of players can be adjusted.

Location:

trunk

Files:

• Engine.pas (modified) (14 diffs)
• Forms/FormMain.pas (modified) (1 diff)
• Languages/Tunneler.cs.po (modified) (6 diffs)
• Languages/Tunneler.pot (modified) (5 diffs)

trunk/Engine.pas

@@ -169 +169 @@
     function GetAliveCount: Integer;
     function GetWinner: TPlayer;
+    function GetEnabledCount: Integer;
+    procedure EnableMore;
+    procedure EnableLess;
   end;
 
@@ -198 +201 @@
 
   TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
-    gsInstructions);
+    gsInstructions, gsSettings);
 
   { TEngine }
@@ -230 +233 @@
     procedure DrawInformation;
     procedure DrawInstructions;
+    procedure DrawSettings;
     procedure DrawNewRound;
     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 ' +
     'Homepage: https://app.zdechov.net/Tunneler';
+  SSettings = 'Settings';
   SWorldReady = 'World ready';
   SExit = 'Exit';
@@ -323 +328 @@
   SOrange = 'Orange';
   SGray = 'Gray';
+  SMorePlayers = 'More players';
+  SLessPlayers = 'Less players';
+  SBack = 'Back';
+  SPlayersCount = 'Players count';
 
 { TBullets }
@@ -409 +418 @@
     TopScore := Score;
     Result := Items[I];
+  end;
+end;
+
+function TPlayers.GetEnabledCount: Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 0 to Count - 1 do begin
+    if Items[I].Enabled then Inc(Result);
+  end;
+end;
+
+procedure TPlayers.EnableMore;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do begin
+    if not Items[I].Enabled then begin
+      Items[I].Enabled := True;
+      Break;
+    end;
+  end;
+end;
+
+procedure TPlayers.EnableLess;
+var
+  I: Integer;
+begin
+  if GetEnabledCount > 2 then
+  for I := Count - 1 downto 0 do begin
+    if Items[I].Enabled then begin
+      Items[I].Enabled := False;
+      Break;
+    end;
   end;
 end;
@@ -1301 +1345 @@
 end;
 
+procedure TEngine.DrawSettings;
+var
+  Text: string;
+  MenuWidth: Integer;
+begin
+  with Bitmap.Canvas do begin
+    ClearBackground;
+
+    if FShowMenuStats then begin
+      MenuWidth := Bitmap.Width div 2;
+      DrawStats;
+    end else MenuWidth := Bitmap.Width;
+
+    Brush.Style := bsClear;
+    Pen.Style := psSolid;
+    Pen.Color := clWhite;
+    Font.Color := clTuna;
+    Font.Size := 30;
+    Text := SSettings;
+    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
+
+    Pen.Color := clPurple;
+    Pen.Width := 6;
+    Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
+      (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);
+
+    Font.Color := clPurple;
+    Font.Size := 20;
+
+    ShowMenuItem('F1', SMorePlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4, Bitmap.Canvas);
+    ShowMenuItem('F2', SLessPlayers, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas);
+    ShowMenuItem('ESC', SBack, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas);
+
+    Font.Color := clDarkGreen;
+    Font.Size := 20;
+    Text := SPlayersCount + ': ' + IntToStr(PlayerPool.GetEnabledCount);
+    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 6, Text);
+  end;
+end;
+
 procedure TEngine.DrawNewRound;
 var
@@ -1649 +1733 @@
     Pen.Width := 6;
     Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
-      (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 200);
+      (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 240);
 
     Font.Color := clPurple;
@@ -1657 +1741 @@
     ShowMenuItem('F2', SInstructions, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 40, Bitmap.Canvas);
     ShowMenuItem('F3', SInformation, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 80, Bitmap.Canvas);
-    ShowMenuItem('F10', SExit, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas);
+    ShowMenuItem('F4', SSettings, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 120, Bitmap.Canvas);
+    ShowMenuItem('F10', SExit, MenuWidth div 2 - 180, Bitmap.Height div 10 * 4 + 160, Bitmap.Canvas);
 
     Font.Color := clDarkGreen;
@@ -1885 +1970 @@
       gsInformation: DrawInformation;
       gsInstructions: DrawInstructions;
+      gsSettings: DrawSettings;
       gsMap: DrawMap;
       gsNewRound: DrawNewRound;
@@ -1953 +2039 @@
   KeyF3 = 114;
   KeyF4 = 115;
+  KeyF5 = 116;
   KeyF10 = 121;
   KeyEsc = 27;
@@ -1971 +2058 @@
       State := gsInformation;
     end else
+    if Key = KeyF4 then begin
+      State := gsSettings;
+    end else
     if Key = KeyF10 then begin
       if Assigned(FOnClose) then FOnClose(Self);
@@ -1986 +2076 @@
     end;
   end else
+  if State = gsSettings then begin
+    if Key = KeyF1 then begin
+      PlayerPool.EnableMore;
+      Redraw;
+    end else
+    if Key = KeyF2 then begin
+      PlayerPool.EnableLess;
+      Redraw;
+    end else
+    if Key = KeyEsc then begin
+      State := gsMenu;
+    end;
+  end else
   if State = gsGame then begin
      if Key = KeyEsc then begin
@@ -1993 +2096 @@
 
   {$IFDEF DEBUG}
-  if (State = gsGame) and (Key = KeyF4) then begin
+  if (State = gsGame) and (Key = KeyF5) then begin
     // Destroy first alive player
     for I := 0 to Players.Count - 1 do

trunk/Forms/FormMain.pas

@@ -184 +184 @@
   Engine := TEngine.Create(nil);
   Engine.OnClose := AExitExecute;
+  Engine.InitPlayerPool;
   LoadConfig;
-  Engine.InitPlayerPool;
   Engine.Bitmap := Image1.Picture.Bitmap;
   Engine.NewGame;

trunk/Languages/Tunneler.cs.po

@@ -10 +10 @@
 "Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
-"X-Generator: Poedit 3.0.1\n"
+"X-Generator: Poedit 3.4.2\n"
+
+#: engine.sback
+msgid "Back"
+msgstr "Zpět"
 
 #: engine.sblue
@@ -77 +81 @@
 msgstr "Ovládání: \\n Modrá: W - nahoru, A - vlevo, S - dolů, D - vpravo, E - střelba \\n ZelenÃœ: kurzorové Å¡ipky, CTRL + střelba"
 
+#: engine.slessplayers
+msgid "Less players"
+msgstr "Méně hráčů"
+
 #: engine.smetersdug
 msgctxt "engine.smetersdug"
@@ -87 +95 @@
 msgstr "UraşenÜch metrů"
 
+#: engine.smoreplayers
+msgid "More players"
+msgstr "Více hráčů"
+
 #: engine.sorange
 msgctxt "engine.sorange"
@@ -102 +114 @@
 msgstr "Růşová"
 
+#: engine.splayerscount
+msgid "Players count"
+msgstr "Počet hráčů"
+
 #: engine.spressesc
 msgctxt "engine.spressesc"
@@ -116 +132 @@
 msgid "Round"
 msgstr "Kolo"
+
+#: engine.ssettings
+msgid "Settings"
+msgstr "Nastavení"
 
 #: engine.sshotsfired
@@ -167 +187 @@
 msgctxt "sound.sunabletoplay"
 msgid "Unable to play "
-msgstr "Nelze přehrát"
+msgstr "Nelze přehrát "
 
 #: tformdebug.caption

trunk/Languages/Tunneler.pot

@@ -1 +1 @@
 msgid ""
 msgstr "Content-Type: text/plain; charset=UTF-8"
+
+#: engine.sback
+msgid "Back"
+msgstr ""
 
 #: engine.sblue
@@ -67 +71 @@
 msgstr ""
 
+#: engine.slessplayers
+msgid "Less players"
+msgstr ""
+
 #: engine.smetersdug
 msgctxt "engine.smetersdug"
@@ -77 +85 @@
 msgstr ""
 
+#: engine.smoreplayers
+msgid "More players"
+msgstr ""
+
 #: engine.sorange
 msgctxt "engine.sorange"
@@ -92 +104 @@
 msgstr ""
 
+#: engine.splayerscount
+msgid "Players count"
+msgstr ""
+
 #: engine.spressesc
 msgctxt "engine.spressesc"
@@ -105 +121 @@
 msgctxt "engine.sround"
 msgid "Round"
+msgstr ""
+
+#: engine.ssettings
+msgid "Settings"
 msgstr ""