Survival Mode Fix

[derek10]

Script Name: Survival Fix
Original Author(s): DrK
Core Version: 2.8.2 (SC3)
Compile test: Passed
Script Full Description:

Fix 2 bugs that started since the release of Soldat 1.7 if survival is enabled, those were not present in older versions as far as I know.
  - At the end of a map, a map change or a restart, if a player is dead but the round (on survival, a round won't end until all players from a team are dead) is not over, the player will not respawn when the map begins.
  - When a map ends because score limit was reached or time ran out, the server will trigger nextmap 2 times, making all active players load the first nextmap, while the server will actually be running the second one, thus kicking everyone for "Wrong map version detected" error.

Code: (Only a part of it)

Code: [Select]

procedure Clock(Ticks: Integer);
var
d: byte; // Store team's ID
begin
if not forcepause then begin
for d := 0 to 4 do if (Game.Teams[d].Score >= Game.ScoreLimit) then begin // Pauses the game after score limit is reached or timelimit is over
Game.Paused := true; // Pause the game when the map ends
UpCount := 1; // Amount of time (in seconds) that the game will be paused before /map command is executed, don't use anything below 1 or else it will loop /map command
forcepause := true; // Anti-loop
CheckChanged := 10; // Countdown to check if the map changed
end;
if (FirstEnd) and (Game.TimeLeft = 0) then begin
Game.Paused := true; // Pause the game when the map ends
UpCount := 1; // Amount of time (in seconds) that the game will be paused before /map command is executed, don't use anything below 1 or else it will loop /map command
forcepause := true; // Anti-loop
FirstEnd := false; // Read comment on var section
CheckChanged := 10; // Countdown to check if the map changed
end;
end;
if (CheckChanged = 0) and (Game.CurrentMap = SameMap) then begin
forcepause := false; // Reset forcepause if map didn't change for some reason
end;
if (CheckChanged > 0) then begin
CheckChanged := CheckChanged - 1 // Decrease map check countdown
end;
if UpCount > 0 then begin
UpCount := UpCount - 1; // Decrease unpause countdown
end
else if UpCount = 0 then begin
UpCount := -1; // Reset unpause countdown
Players.WriteConsole('Anti nextmap bug script in action...', Color); // Heads-up to players that the script is working
Map.SetMap(+TrueNM); // Change the map to the "true nextmap" according to maplist.txt
end;
end;
Changelog:

1.0 > 1.1
- Minor code improvements
- Added additional checks to prevent bugs caused by manually pausing the game at the end of a match to change limit or abuse infinite time.

[soldat-game]

I wonder why the code in the code frame does not match the code of the download script.
After my research and saveage global variables Players.Active and Players.Alive may give false values. We also discovered a problem with how colorbug is made:
When the player is kicked while changing the map - or when leave and join again - but will stay in the team selection menu, and other players will join during this time then after a while he will choose a team. Teams will get buggy and for some you will become invisible or you will not see others and the colors will mix up so you can also get a radar hack in realistic mode.

Once upon a time I created such a script:
 - Prevents double caps in survival mode.
 - Prevents players from dying when changing maps.
 - Add /setscore <team_ID> <score_num> for admins.
 - Fix problem when players join when all one team dead and give free score for team. (Destroying the team's scoreboard when joining to team)
So it basically does all the same and more.

Code: [Select]

const
Color = $FFFF0000;
Color2 = $FFBF7F7F;

var
Resurrect: array[1..32] of Boolean;

function CountAliveTeam(TeamID: Byte): Byte;
var i: ShortInt;
begin
if Players.Active.Count <> 0 then for i := 0 to Players.Active.Count-1 do if (Players.Active[i].Alive) and (Players.Active[i].Team = TeamID) then Inc(Result, 1);
end;

function CountPlayers(): Byte;
var i: ShortInt;
begin
if Players.Active.Count <> 0 then for i := 0 to Players.Active.Count-1 do if Players.Active[i].Team < 5 then Inc(Result, 1);
end;

procedure OnFlagSc(Player: TActivePlayer; Flag: TActiveFlag; Team: Byte);
var AlphaAliveCount, BravoAliveCount, AllAlive: byte; ActualScore, NewScore: integer;
begin
AlphaAliveCount := CountAliveTeam(1); BravoAliveCount := CountAliveTeam(2); AllAlive := CountPlayers();
if AlphaAliveCount > 0 then if BravoAliveCount = 0 then begin
ActualScore := Game.Teams[1].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[1].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[1].Score := NewScore;
Game.Paused := false;
end else Game.Teams[1].Score := NewScore;
if AllAlive > 1 then begin
if AllAlive <> AlphaAliveCount then Players.WriteConsole('Double captures have been disabled and have no effect.', Color) else Players.WriteConsole('There is no enemy team.', Color);
end else Player.WriteConsole('Stop playing with yourself loser.', Color);
exit;
end;
if BravoAliveCount > 0 then if AlphaAliveCount = 0 then begin
ActualScore := Game.Teams[2].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[2].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[2].Score := NewScore;
Game.Paused := false;
end else Game.Teams[2].Score := NewScore;
if AllAlive > 1 then begin
if AllAlive <> BravoAliveCount then Players.WriteConsole('Double captures have been disabled and have no effect.', Color) else Players.WriteConsole('There is no enemy team.', Color);
end else Player.WriteConsole('Stop playing with yourself loser.', Color);
end;
end;

procedure OnJoinTeam(Player: TActivePlayer; Team: TTeam);
var TempAlphaAlive, TempBravoAlive: byte; ActualScore, NewScore: integer;
begin
TempAlphaAlive := CountAliveTeam(1); TempBravoAlive := CountAliveTeam(2);
if (Team.ID <> 5) and (Player.Alive = False) then if (((Game.Teams[1].Count = 0) and (Game.Teams[2].Count > 1)) or ((Game.Teams[2].Count = 0) and (Game.Teams[1].Count > 1)) or ((Game.Teams[1].Count = 1) and (Game.Teams[2].Count > 0)) or ((Game.Teams[2].Count = 1) and (Game.Teams[1].Count > 0))) then if (TempAlphaAlive > 0) and (TempBravoAlive = 0) then begin
ActualScore := Game.Teams[1].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[1].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[1].Score := NewScore;
Game.Paused := false;
end else Game.Teams[1].Score := NewScore;
end else if (TempBravoAlive > 0) and (TempAlphaAlive = 0) then begin
ActualScore := Game.Teams[2].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[2].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[2].Score := NewScore;
Game.Paused := false;
end else Game.Teams[2].Score := NewScore;
end;
end;

function AdmCmdSend(Player: TActivePlayer; Command: string): boolean;
begin
Result := false;
if (LowerCase(Copy(Command, 1, 9)) = '/setscore')  then begin
if (StrToInt(Copy(Command, 13, Length(Command)))) < Game.ScoreLimit then begin
try
Game.Teams[StrToInt(Copy(Command, 11, 1))].Score := StrToInt(Copy(Command, 13, Length(Command)));
except
end;
end else Player.WriteConsole('Please enter a value less than the capture limit', Color2);
end;
end;

function OnDamage(Shooter, Victim: TActivePlayer; Damage: Single; BulletId: Byte): Single;
begin
if Resurrect[Victim.ID] then Result := 0 else Result := Damage;
end;

procedure OnAfterMapChange(Next: string);
var i: Byte;
begin
for i := 1 to 32 do if (Players[i].Active) and (Players[i].Alive = false) and (Players[i].Team <> 5) then begin
Resurrect[i] := true;
Players[i].ChangeTeam(Players[i].Team, TJoinSilent);
Resurrect[i] := false;
end;
end;

procedure ScriptDecl;
var i: Byte;
begin
for i := 1 to 32 do begin
Players[i].OnDamage := @OnDamage;
Players[i].OnFlagScore := @OnFlagSc;
end;
for i := 0 to 5 do Game.Teams[i].OnJoin := @OnJoinTeam;
Map.OnAfterMapChange := @OnAfterMapChange;
Game.OnAdminCommand := @AdmCmdSend;
end;

begin
ScriptDecl;
Players.WriteConsole('Recompile AutoScoreFix',Color2);
end.


[derek10]

I wonder why the code in the code frame does not match the code of the download script.
After my research and saveage global variables Players.Active and Players.Alive may give false values. We also discovered a problem with how colorbug is made:
When the player is kicked while changing the map - or when leave and join again - but will stay in the team selection menu, and other players will join during this time then after a while he will choose a team. Teams will get buggy and for some you will become invisible or you will not see others and the colors will mix up so you can also get a radar hack in realistic mode.

Once upon a time I created such a script:
 - Prevents double caps in survival mode.
 - Prevents players from dying when changing maps.
 - Add /setscore <team_ID> <score_num> for admins.
 - Fix problem when players join when all one team dead and give free score for team. (Destroying the team's scoreboard when joining to team)
So it basically does all the same and more.

Code: [Select]

const
Color = $FFFF0000;
Color2 = $FFBF7F7F;

var
Resurrect: array[1..32] of Boolean;

function CountAliveTeam(TeamID: Byte): Byte;
var i: ShortInt;
begin
if Players.Active.Count <> 0 then for i := 0 to Players.Active.Count-1 do if (Players.Active[i].Alive) and (Players.Active[i].Team = TeamID) then Inc(Result, 1);
end;

function CountPlayers(): Byte;
var i: ShortInt;
begin
if Players.Active.Count <> 0 then for i := 0 to Players.Active.Count-1 do if Players.Active[i].Team < 5 then Inc(Result, 1);
end;

procedure OnFlagSc(Player: TActivePlayer; Flag: TActiveFlag; Team: Byte);
var AlphaAliveCount, BravoAliveCount, AllAlive: byte; ActualScore, NewScore: integer;
begin
AlphaAliveCount := CountAliveTeam(1); BravoAliveCount := CountAliveTeam(2); AllAlive := CountPlayers();
if AlphaAliveCount > 0 then if BravoAliveCount = 0 then begin
ActualScore := Game.Teams[1].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[1].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[1].Score := NewScore;
Game.Paused := false;
end else Game.Teams[1].Score := NewScore;
if AllAlive > 1 then begin
if AllAlive <> AlphaAliveCount then Players.WriteConsole('Double captures have been disabled and have no effect.', Color) else Players.WriteConsole('There is no enemy team.', Color);
end else Player.WriteConsole('Stop playing with yourself loser.', Color);
exit;
end;
if BravoAliveCount > 0 then if AlphaAliveCount = 0 then begin
ActualScore := Game.Teams[2].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[2].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[2].Score := NewScore;
Game.Paused := false;
end else Game.Teams[2].Score := NewScore;
if AllAlive > 1 then begin
if AllAlive <> BravoAliveCount then Players.WriteConsole('Double captures have been disabled and have no effect.', Color) else Players.WriteConsole('There is no enemy team.', Color);
end else Player.WriteConsole('Stop playing with yourself loser.', Color);
end;
end;

procedure OnJoinTeam(Player: TActivePlayer; Team: TTeam);
var TempAlphaAlive, TempBravoAlive: byte; ActualScore, NewScore: integer;
begin
TempAlphaAlive := CountAliveTeam(1); TempBravoAlive := CountAliveTeam(2);
if (Team.ID <> 5) and (Player.Alive = False) then if (((Game.Teams[1].Count = 0) and (Game.Teams[2].Count > 1)) or ((Game.Teams[2].Count = 0) and (Game.Teams[1].Count > 1)) or ((Game.Teams[1].Count = 1) and (Game.Teams[2].Count > 0)) or ((Game.Teams[2].Count = 1) and (Game.Teams[1].Count > 0))) then if (TempAlphaAlive > 0) and (TempBravoAlive = 0) then begin
ActualScore := Game.Teams[1].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[1].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[1].Score := NewScore;
Game.Paused := false;
end else Game.Teams[1].Score := NewScore;
end else if (TempBravoAlive > 0) and (TempAlphaAlive = 0) then begin
ActualScore := Game.Teams[2].Score;
NewScore := ActualScore - 1; if NewScore < 0 then NewScore := 0;
if Game.Teams[2].Score = Game.ScoreLimit then begin
Game.Paused := true;
Game.Teams[2].Score := NewScore;
Game.Paused := false;
end else Game.Teams[2].Score := NewScore;
end;
end;

function AdmCmdSend(Player: TActivePlayer; Command: string): boolean;
begin
Result := false;
if (LowerCase(Copy(Command, 1, 9)) = '/setscore')  then begin
if (StrToInt(Copy(Command, 13, Length(Command)))) < Game.ScoreLimit then begin
try
Game.Teams[StrToInt(Copy(Command, 11, 1))].Score := StrToInt(Copy(Command, 13, Length(Command)));
except
end;
end else Player.WriteConsole('Please enter a value less than the capture limit', Color2);
end;
end;

function OnDamage(Shooter, Victim: TActivePlayer; Damage: Single; BulletId: Byte): Single;
begin
if Resurrect[Victim.ID] then Result := 0 else Result := Damage;
end;

procedure OnAfterMapChange(Next: string);
var i: Byte;
begin
for i := 1 to 32 do if (Players[i].Active) and (Players[i].Alive = false) and (Players[i].Team <> 5) then begin
Resurrect[i] := true;
Players[i].ChangeTeam(Players[i].Team, TJoinSilent);
Resurrect[i] := false;
end;
end;

procedure ScriptDecl;
var i: Byte;
begin
for i := 1 to 32 do begin
Players[i].OnDamage := @OnDamage;
Players[i].OnFlagScore := @OnFlagSc;
end;
for i := 0 to 5 do Game.Teams[i].OnJoin := @OnJoinTeam;
Map.OnAfterMapChange := @OnAfterMapChange;
Game.OnAdminCommand := @AdmCmdSend;
end;

begin
ScriptDecl;
Players.WriteConsole('Recompile AutoScoreFix',Color2);
end.


I don't quite follow you there, the code is identical, check https://www.diffchecker.com/Yll98ZYI. If you were talking about the whole code, according to the template posted in this topic https://forums.soldat.pl/index.php?topic=7409.0 The code section should contain "(Just some snippets, not the whole script)" so thats why I posted only a part of it.

About your script, I am still new to coding and w/o comments its hard for me to understand all of it, but thanks for the information and sharing your knowledge.