(*
 * 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 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.