hedgewars/uStats.pas
author Xeli
Fri, 16 Sep 2011 20:39:14 +0200
branchhedgeroid
changeset 5938 c186c454779d
parent 5638 e35ba2a400d8
child 6014 b432c4b9cc9b
permissions -rw-r--r--
isOnCurrentHog and isOnCrosshair now look at the distance relative to the screen rather than world coords, this means that zooming out doesn't make it harder to touch the hog or crosshair

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2011 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

{$INCLUDE "options.inc"}

unit uStats;
interface
uses uConsts, uTypes;

var TotalRounds: LongInt;
    FinishedTurnsTotal: LongInt;

procedure initModule;
procedure freeModule;

procedure AmmoUsed(am: TAmmoType);
procedure HedgehogDamaged(Gear: PGear; Attacker: PHedgehog; Damage: Longword; killed: boolean);
procedure Skipped;
procedure TurnReaction;
procedure SendStats;

implementation
uses uSound, uLocale, uVariables, uUtils, uIO, uCaptions, uDebug, uMisc;

var DamageClan  : Longword = 0;
    DamageTotal : Longword = 0;
    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 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
    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)
end;

procedure Skipped;
begin
inc(SkippedTurns);
isTurnSkipped:= true
end;

procedure TurnReaction;
var i, t: LongInt;
begin
TryDo(not bBetweenTurns, 'Engine bug: TurnReaction between turns', true);

inc(FinishedTurnsTotal);
if FinishedTurnsTotal <> 0 then
    begin
    inc(CurrentHedgehog^.stats.FinishedTurns);

    if (CurrentHedgehog^.stats.DamageGiven = DamageTotal) and (DamageTotal > 0) then
        AddVoice(sndFirstBlood, CurrentTeam^.voicepack)

    else if CurrentHedgehog^.stats.StepDamageRecv > 0 then
        begin
        AddVoice(sndStupid, PreviousTeam^.voicepack);
        if CurrentHedgehog^.stats.DamageGiven = CurrentHedgehog^.stats.StepDamageRecv then 
            AddCaption(Format(GetEventString(eidHurtSelf), CurrentHedgehog^.Name), cWhiteColor, capgrpMessage);
        end

    else if DamageClan <> 0 then
        if DamageTotal > DamageClan 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)

    else if CurrentHedgehog^.stats.StepDamageGiven <> 0 then
        if Kills > 0 then
            AddVoice(sndEnemyDown, CurrentTeam^.voicepack)
        else
            AddVoice(sndRegret, vpHurtEnemy)

    else if AmmoDamagingUsed then
        AddVoice(sndMissed, PreviousTeam^.voicepack)
    else if (AmmoUsedCount > 0) and not isTurnSkipped then
        // nothing ?
    else if isTurnSkipped then
        begin
        AddVoice(sndBoring, PreviousTeam^.voicepack);
        AddCaption(Format(GetEventString(eidTurnSkipped), CurrentHedgehog^.Name), cWhiteColor, capgrpMessage);
        end
    else if not PlacingHogs then
        AddVoice(sndCoward, PreviousTeam^.voicepack);
    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
                end;

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;
AmmoUsedCount:= 0;
AmmoDamagingUsed:= false;
isTurnSkipped:= false
end;

procedure AmmoUsed(am: TAmmoType);
begin
inc(AmmoUsedCount);
AmmoDamagingUsed:= AmmoDamagingUsed or Ammoz[am].isDamaging
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
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 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;
            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 }
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;

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

// now to console
if winnersClan <> nil then 
    begin
    writeln('WINNERS');
    for t:= 0 to winnersClan^.TeamsNumber - 1 do
        writeln(winnersClan^.Teams[t]^.TeamName);
    writeln;
    end else
    writeln('DRAW');
end;

procedure initModule;
begin
    TotalRounds:= -1;
    FinishedTurnsTotal:= -1;
end;

procedure freeModule;
begin

end;

end.