(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
{$INCLUDE "options.inc"}
unit uStats;
interface
uses uConsts, uTypes;
var TotalRoundsPre: LongInt; // Helper variable for calculating start of Sudden Death and more. Starts at -1 and is incremented on the turn BEFORE the turn which marks the start of the next round. Always -1 while in hog placing phase
TotalRoundsReal: LongInt; // Total number of rounds played (-1 if not started or in hog placing phase). Exported to Lua as 'TotalRounds'
FinishedTurnsTotal: LongInt;
SendGameResultOn : boolean = true;
SendRankingStatsOn : boolean = true;
SendAchievementsStatsOn : boolean = true;
SendHealthStatsOn : boolean = true;
procedure initModule;
procedure freeModule;
procedure AmmoUsed(am: TAmmoType);
procedure HedgehogPoisoned(Gear: PGear; Attacker: PHedgehog);
procedure HedgehogSacrificed(Hedgehog: PHedgehog);
procedure HedgehogDamaged(Gear: PGear; Attacker: PHedgehog; Damage: Longword; killed: boolean);
procedure TargetHit;
procedure Skipped;
procedure TurnReaction;
procedure SendStats;
procedure hedgehogFlight(Gear: PGear; time: Longword);
procedure declareAchievement(id, teamname, location: shortstring; value: LongInt);
procedure startGhostPoints(n: LongInt);
procedure dumpPoint(x, y: LongInt);
implementation
uses uSound, uLocale, uVariables, uUtils, uIO, uCaptions, uMisc, uConsole, uScript;
var DamageClan : Longword = 0;
DamageTotal : Longword = 0;
DamageTurn : Longword = 0;
PoisonTurn : Longword = 0; // Poisoned enemies per turn
PoisonClan : Longword = 0; // Poisoned own clan members in turn
PoisonTotal : Longword = 0; // Poisoned hogs in whole round
KillsClan : LongWord = 0;
Kills : LongWord = 0;
KillsTotal : LongWord = 0;
HitTargets : LongWord = 0; // Target (gtTarget) hits per turn
AmmoUsedCount : Longword = 0;
AmmoDamagingUsed : boolean = false;
SkippedTurns: LongWord = 0;
isTurnSkipped: boolean = false;
vpHurtSameClan: PVoicepack = nil;
vpHurtEnemy: PVoicepack = nil;
procedure HedgehogPoisoned(Gear: PGear; Attacker: PHedgehog);
begin
if Attacker^.Team^.Clan = Gear^.HEdgehog^.Team^.Clan then
begin
vpHurtSameClan:= CurrentHedgehog^.Team^.voicepack;
inc(PoisonClan)
end
else
begin
vpHurtEnemy:= Gear^.Hedgehog^.Team^.voicepack;
inc(PoisonTurn)
end;
Gear^.Hedgehog^.stats.StepPoisoned:= true;
inc(PoisonTotal)
end;
procedure HedgehogSacrificed(Hedgehog: PHedgehog);
begin
Hedgehog^.stats.Sacrificed:= true
end;
procedure HedgehogDamaged(Gear: PGear; Attacker: PHedgehog; Damage: Longword; killed: boolean);
begin
if Attacker^.Team^.Clan = Gear^.Hedgehog^.Team^.Clan then
vpHurtSameClan:= CurrentHedgehog^.Team^.voicepack
else
vpHurtEnemy:= Gear^.Hedgehog^.Team^.voicepack;
//////////////////////////
inc(Attacker^.stats.StepDamageGiven, Damage);
inc(Attacker^.stats.DamageGiven, Damage);
inc(Gear^.Hedgehog^.stats.StepDamageRecv, Damage);
if CurrentHedgehog^.Team^.Clan = Gear^.Hedgehog^.Team^.Clan then inc(DamageClan, Damage);
if killed then
begin
Gear^.Hedgehog^.stats.StepDied:= true;
inc(Attacker^.stats.StepKills);
inc(Kills);
inc(KillsTotal);
inc(Attacker^.Team^.stats.Kills);
if (Attacker^.Team^.TeamName = Gear^.Hedgehog^.Team^.TeamName) then
begin
inc(Attacker^.Team^.stats.TeamKills);
inc(Attacker^.Team^.stats.TeamDamage, Gear^.Damage);
end;
if Gear = Attacker^.Gear then
inc(Attacker^.Team^.stats.Suicides);
if Attacker^.Team^.Clan = Gear^.Hedgehog^.Team^.Clan then
inc(KillsClan);
end;
inc(DamageTotal, Damage);
inc(DamageTurn, Damage)
end;
procedure TargetHit();
begin
inc(HitTargets)
end;
procedure Skipped;
begin
inc(SkippedTurns);
isTurnSkipped:= true
end;
procedure TurnReaction;
var i, t: LongInt;
killsCheck: LongInt;
s: ansistring;
begin
//TryDo(not bBetweenTurns, 'Engine bug: TurnReaction between turns', true);
inc(FinishedTurnsTotal);
if FinishedTurnsTotal <> 0 then
begin
s:= ansistring(CurrentHedgehog^.Name);
inc(CurrentHedgehog^.stats.FinishedTurns);
// If the hog sacrificed (=kamikaze/piano) itself, this needs to be taken into accounts for the reactions later
if (CurrentHedgehog^.stats.Sacrificed) then
killsCheck:= 1
else
killsCheck:= 0;
// First blood (first damage, poison or kill)
if ((DamageTotal > 0) or (KillsTotal > 0) or (PoisonTotal > 0)) and ((CurrentHedgehog^.stats.DamageGiven = DamageTotal) and (CurrentHedgehog^.stats.StepKills = KillsTotal) and (PoisonTotal = PoisonTurn + PoisonClan)) then
AddVoice(sndFirstBlood, CurrentTeam^.voicepack)
// Hog hurts, poisons or kills itself (except sacrifice)
else if (CurrentHedgehog^.stats.Sacrificed = false) and ((CurrentHedgehog^.stats.StepDamageRecv > 0) or (CurrentHedgehog^.stats.StepPoisoned) or (CurrentHedgehog^.stats.StepDied)) then
begin
AddVoice(sndStupid, PreviousTeam^.voicepack);
// Message for hurting itself only (not drowning)
if (CurrentHedgehog^.stats.DamageGiven = CurrentHedgehog^.stats.StepDamageRecv) and (CurrentHedgehog^.stats.StepDamageRecv >= 1) then
AddCaption(FormatA(GetEventString(eidHurtSelf), s), capcolDefault, capgrpMessage);
end
// Hog hurts, poisons or kills own team/clan member. Sacrifice is taken into account
else if (DamageClan <> 0) or (KillsClan > killsCheck) or (PoisonClan <> 0) then
if (DamageTurn > DamageClan) or (Kills > KillsClan) then
if random(2) = 0 then
AddVoice(sndNutter, CurrentTeam^.voicepack)
else
AddVoice(sndWatchIt, vpHurtSameClan)
else
if random(2) = 0 then
AddVoice(sndSameTeam, vpHurtSameClan)
else
AddVoice(sndTraitor, vpHurtSameClan)
// Hog hurts, kills or poisons enemy
else if (CurrentHedgehog^.stats.StepDamageGiven <> 0) or (CurrentHedgehog^.stats.StepKills > killsCheck) or (PoisonTurn <> 0) then
if Kills > killsCheck then
AddVoice(sndEnemyDown, CurrentTeam^.voicepack)
else
AddVoice(sndRegret, vpHurtEnemy)
// Missed shot
// A miss is defined as a shot with a damaging weapon with 0 kills, 0 damage, 0 hogs poisoned and 0 targets hit
else if AmmoDamagingUsed and (Kills <= killsCheck) and (PoisonTurn = 0) and (PoisonClan = 0) and (DamageTurn = 0) and (HitTargets = 0) then
// Chance to call hedgehog stupid if sacrificed for nothing
if CurrentHedgehog^.stats.Sacrificed then
if random(2) = 0 then
AddVoice(sndMissed, PreviousTeam^.voicepack)
else
AddVoice(sndStupid, PreviousTeam^.voicepack)
else
AddVoice(sndMissed, PreviousTeam^.voicepack)
// Timeout
else if (AmmoUsedCount > 0) and (not isTurnSkipped) then
begin end// nothing ?
// Turn skipped
else if isTurnSkipped and (not PlacingHogs) then
begin
AddVoice(sndCoward, PreviousTeam^.voicepack);
AddCaption(FormatA(GetEventString(eidTurnSkipped), s), capcolDefault, capgrpMessage);
end
end;
for t:= 0 to Pred(TeamsCount) do // send even on zero turn
with TeamsArray[t]^ do
for i:= 0 to cMaxHHIndex do
with Hedgehogs[i].stats do
begin
inc(DamageRecv, StepDamageRecv);
inc(DamageGiven, StepDamageGiven);
if StepDamageRecv > MaxStepDamageRecv then
MaxStepDamageRecv:= StepDamageRecv;
if StepDamageGiven > MaxStepDamageGiven then
MaxStepDamageGiven:= StepDamageGiven;
if StepKills > MaxStepKills then
MaxStepKills:= StepKills;
StepKills:= 0;
StepDamageRecv:= 0;
StepDamageGiven:= 0;
StepPoisoned:= false;
StepDied:= false;
end;
if SendHealthStatsOn then
for t:= 0 to Pred(ClansCount) do
with ClansArray[t]^ do
begin
SendStat(siClanHealth, IntToStr(Color) + ' ' + IntToStr(ClanHealth));
end;
Kills:= 0;
KillsClan:= 0;
DamageClan:= 0;
DamageTurn:= 0;
HitTargets:= 0;
PoisonClan:= 0;
PoisonTurn:= 0;
AmmoUsedCount:= 0;
AmmoDamagingUsed:= false;
isTurnSkipped:= false
end;
procedure AmmoUsed(am: TAmmoType);
begin
inc(AmmoUsedCount);
AmmoDamagingUsed:= AmmoDamagingUsed or Ammoz[am].isDamaging
end;
procedure hedgehogFlight(Gear: PGear; time: Longword);
begin
if time > 4000 then
begin
WriteLnToConsole('FLIGHT');
WriteLnToConsole(Gear^.Hedgehog^.Team^.TeamName);
WriteLnToConsole(inttostr(time));
WriteLnToConsole( '');
end
end;
procedure SendStats;
var i, t: LongInt;
msd, msk: Longword; msdhh, mskhh: PHedgehog;
mskcnt: Longword;
maxTeamKills : Longword;
maxTeamKillsName : shortstring;
maxTurnSkips : Longword;
maxTurnSkipsName : shortstring;
maxTeamDamage : Longword;
maxTeamDamageName : shortstring;
winnersClan : PClan;
begin
if SendHealthStatsOn then
msd:= 0; msdhh:= nil;
msk:= 0; mskhh:= nil;
mskcnt:= 0;
maxTeamKills := 0;
maxTurnSkips := 0;
maxTeamDamage := 0;
winnersClan:= nil;
for t:= 0 to Pred(TeamsCount) do
with TeamsArray[t]^ do
begin
if (not ExtDriven) and SendRankingStatsOn then
SendStat(siTeamStats, GetTeamStatString(TeamsArray[t]));
for i:= 0 to cMaxHHIndex do
begin
if Hedgehogs[i].stats.MaxStepDamageGiven > msd then
begin
msdhh:= @Hedgehogs[i];
msd:= Hedgehogs[i].stats.MaxStepDamageGiven
end;
if Hedgehogs[i].stats.MaxStepKills >= msk then
if Hedgehogs[i].stats.MaxStepKills = msk then
inc(mskcnt)
else
begin
mskcnt:= 1;
mskhh:= @Hedgehogs[i];
msk:= Hedgehogs[i].stats.MaxStepKills
end;
end;
{ send player stats for winner teams }
if Clan^.ClanHealth > 0 then
begin
winnersClan:= Clan;
if SendRankingStatsOn then
SendStat(siPlayerKills, IntToStr(Clan^.Color) + ' ' +
IntToStr(stats.Kills) + ' ' + TeamName);
end;
{ determine maximum values of TeamKills, TurnSkips, TeamDamage }
if stats.TeamKills > maxTeamKills then
begin
maxTeamKills := stats.TeamKills;
maxTeamKillsName := TeamName;
end;
if stats.TurnSkips > maxTurnSkips then
begin
maxTurnSkips := stats.TurnSkips;
maxTurnSkipsName := TeamName;
end;
if stats.TeamDamage > maxTeamDamage then
begin
maxTeamDamage := stats.TeamDamage;
maxTeamDamageName := TeamName;
end;
end;
{ now send player stats for loser teams }
if SendRankingStatsOn then
for t:= 0 to Pred(TeamsCount) do
begin
with TeamsArray[t]^ do
begin
if Clan^.ClanHealth = 0 then
begin
SendStat(siPlayerKills, IntToStr(Clan^.Color) + ' ' +
IntToStr(stats.Kills) + ' ' + TeamName);
end;
end;
end;
// “Achievements” / Details part of stats screen
if SendAchievementsStatsOn then
begin
if msdhh <> nil then
SendStat(siMaxStepDamage, IntToStr(msd) + ' ' + msdhh^.Name + ' (' + msdhh^.Team^.TeamName + ')');
if mskcnt = 1 then
SendStat(siMaxStepKills, IntToStr(msk) + ' ' + mskhh^.Name + ' (' + mskhh^.Team^.TeamName + ')');
if maxTeamKills > 1 then
SendStat(siMaxTeamKills, IntToStr(maxTeamKills) + ' ' + maxTeamKillsName);
if maxTurnSkips > 2 then
SendStat(siMaxTurnSkips, IntToStr(maxTurnSkips) + ' ' + maxTurnSkipsName);
if maxTeamDamage > 30 then
SendStat(siMaxTeamDamage, IntToStr(maxTeamDamage) + ' ' + maxTeamDamageName);
if KilledHHs > 0 then
SendStat(siKilledHHs, IntToStr(KilledHHs));
end;
// now to console
if winnersClan <> nil then
begin
WriteLnToConsole('WINNERS');
WriteLnToConsole(inttostr(winnersClan^.TeamsNumber));
for t:= 0 to winnersClan^.TeamsNumber - 1 do
WriteLnToConsole(winnersClan^.Teams[t]^.TeamName);
end
else
WriteLnToConsole('DRAW');
ScriptCall('onAchievementsDeclaration');
end;
procedure declareAchievement(id, teamname, location: shortstring; value: LongInt);
begin
if (length(id) = 0) or (length(teamname) = 0) or (length(location) = 0) then exit;
WriteLnToConsole('ACHIEVEMENT');
WriteLnToConsole(id);
WriteLnToConsole(teamname);
WriteLnToConsole(location);
WriteLnToConsole(inttostr(value));
end;
procedure startGhostPoints(n: LongInt);
begin
WriteLnToConsole('GHOST_POINTS');
WriteLnToConsole(inttostr(n));
end;
procedure dumpPoint(x, y: LongInt);
begin
WriteLnToConsole(inttostr(x));
WriteLnToConsole(inttostr(y));
end;
procedure initModule;
begin
DamageClan := 0;
DamageTotal := 0;
DamageTurn := 0;
PoisonClan := 0;
PoisonTurn := 0;
KillsClan := 0;
Kills := 0;
KillsTotal := 0;
HitTargets := 0;
AmmoUsedCount := 0;
AmmoDamagingUsed := false;
SkippedTurns:= 0;
isTurnSkipped:= false;
vpHurtSameClan:= nil;
vpHurtEnemy:= nil;
TotalRoundsPre:= -1;
TotalRoundsReal:= -1;
FinishedTurnsTotal:= -1;
end;
procedure freeModule;
begin
end;
end.