(*

 * 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;

    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 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;

    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 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

    else if AmmoDamagingUsed and (Kills <= killsCheck) and (PoisonTurn = 0) and (PoisonClan = 0) and (DamageTurn = 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;

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;

    AmmoUsedCount := 0;

    AmmoDamagingUsed := false;

    SkippedTurns:= 0;

    isTurnSkipped:= false;

    vpHurtSameClan:= nil;

    vpHurtEnemy:= nil;

    TotalRounds:= -1;

    FinishedTurnsTotal:= -1;

end;

procedure freeModule;

begin

end;

end.