hedgewars/uStats.pas
author Wuzzy <Wuzzy2@mail.ru>
Wed, 07 Mar 2018 15:09:31 +0100
changeset 13089 c9cdbf630447
parent 12918 6deb29364723
child 13642 3d14950641a4
permissions -rw-r--r--
Stop SplitByChar also lowercasing the entire string. Fixes bug #581. It's weird that a function with this name would lowercase the whole string. Nemo and I have checked the history and code for any justifications of the lowercasing but we found none. I have checked in the code if anything actually depends on SplitByChar also lowercasing the string but I found nothing. It would surprise me since it's not obvious from the name IMO is bad coding practice anyway. Bug 581 is fixed by this because cLocale was (incorrectly) lowercased, which broke locale names like pt_BR to pt_br.

(*
 * 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 TotalRounds: LongInt; // Number of rounds played (-1 if game not started)
    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), cWhiteColor, 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), cWhiteColor, 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;
    TotalRounds:= -1;
    FinishedTurnsTotal:= -1;
end;

procedure freeModule;
begin
end;

end.