hedgewars/uTeams.pas
author Wuzzy <Wuzzy2@mail.ru>
Sat, 17 Aug 2019 01:06:13 +0200
changeset 15359 63372e3879df
parent 15241 ceb289e8a582
child 15466 6031c0cfec89
permissions -rw-r--r--
gfSwitchHog+gfKing: Fix hog switching being delayed one round too many

 (*
 * 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 uTeams;
interface
uses uConsts, uInputHandler, uRandom, uFloat, uStats,
     uCollisions, uSound, uStore, uTypes, uScript
     {$IFDEF USE_TOUCH_INTERFACE}, uWorld{$ENDIF};


procedure initModule;
procedure freeModule;

function  AddTeam(TeamColor: Longword): PTeam;
function  SetMissionTeam(): PTeam;
procedure SwitchHedgehog;
procedure AfterSwitchHedgehog;
procedure InitTeams;
function  TeamSize(p: PTeam): Longword;
procedure RecountTeamHealth(team: PTeam);
procedure RecountAllTeamsHealth();
procedure RestoreHog(HH: PHedgehog);

procedure RestoreTeamsFromSave;
function  CheckForWin: boolean;
procedure TeamGoneEffect(var Team: TTeam);
procedure SwitchCurrentHedgehog(newHog: PHedgehog);

var MaxTeamHealth: LongInt;

implementation
uses uLocale, uAmmos, uChat, uVariables, uUtils, uIO, uCaptions, uCommands, uDebug,
    uGearsUtils, uGearsList, uVisualGearsList, uTextures
    {$IFDEF USE_TOUCH_INTERFACE}, uTouch{$ENDIF};

var TeamsGameOver: boolean;
    NextClan: boolean;
    SwapClanPre, SwapClanReal: LongInt;

function CheckForWin: boolean;
var AliveClan: PClan;
    s, cap: ansistring;
    ts: array[0..(cMaxTeams - 1)] of ansistring;
    t, ActiveAliveCount, i, j: LongInt;
    allWin, winCamera: boolean;
begin
CheckForWin:= false;
ActiveAliveCount:= 0;
// Victory if there is 1 living and non-passive clan left
for t:= 0 to Pred(ClansCount) do
    if (ClansArray[t]^.ClanHealth > 0) and (not ClansArray[t]^.Passive) then
        begin
        inc(ActiveAliveCount);
        AliveClan:= ClansArray[t]
        end;

// Exception: gfOneClanMode, then there is no winner
if (ActiveAliveCount > 1) or ((ActiveAliveCount = 1) and ((GameFlags and gfOneClanMode) <> 0)) then
    exit;
CheckForWin:= true;

TurnTimeLeft:= 0;
ReadyTimeLeft:= 0;

// If the game ends during a multishot, or after the Sudden Death
// water has risen, do last turn stats / reaction.
if ((not bBetweenTurns) and isInMultiShoot) or (bDuringWaterRise) then
    begin
    TurnStats();
    if (not bDuringWaterRise) then
        TurnReaction();
    TurnStatsReset();
    end;

if not TeamsGameOver then
    begin
    if ActiveAliveCount = 0 then
        begin // draw
        AddCaption(GetEventString(eidRoundDraw), capcolDefault, capgrpGameState);
        if SendGameResultOn then
            SendStat(siGameResult, shortstring(trmsg[sidDraw]));
        if PreviousTeam <> nil then
            AddVoice(sndStupid, PreviousTeam^.voicepack)
        else
            AddVoice(sndStupid, TeamsArray[0]^.voicepack);
        AddGear(0, 0, gtATFinishGame, 0, _0, _0, 3000);
        end
    else // win
        begin
        allWin:= false;
        with AliveClan^ do
            begin
            if TeamsNumber = 1 then // single team wins
                begin
                s:= ansistring(Teams[0]^.TeamName);
                // Victory caption is randomly selected
                cap:= FormatA(GetEventString(eidRoundWin), s);
                AddCaption(cap, capcolDefault, capgrpGameState);
                s:= FormatA(trmsg[sidWinner], s);
                end
            else // clan with at least 2 teams wins
                begin
                s:= '';
                for j:= 0 to Pred(TeamsNumber) do
                    begin
                    ts[j] := Teams[j]^.TeamName;
                    end;

                // Write victory message for caption and stats page
                if (TeamsNumber = cMaxTeams) or (TeamsCount = TeamsNumber) then
                    begin
                    // No enemies for some reason ... Everyone wins!!1!
                    s:= trmsg[sidWinnerAll];
                    allWin:= true;
                    end
                else if (TeamsNumber >= 2) and (TeamsNumber < cMaxTeams) then
                    // List all winning teams in a list
                    if (TeamsNumber = 2) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner2)], ts[0], ts[1])
                    else if (TeamsNumber = 3) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner3)], ts[0], ts[1], ts[2])
                    else if (TeamsNumber = 4) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner4)], ts[0], ts[1], ts[2], ts[3])
                    else if (TeamsNumber = 5) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner5)], ts[0], ts[1], ts[2], ts[3], ts[4])
                    else if (TeamsNumber = 6) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner6)], ts[0], ts[1], ts[2], ts[3], ts[4], ts[5])
                    else if (TeamsNumber = 7) then
                        s:= FormatA(trmsg[TMsgStrId(sidWinner7)], ts[0], ts[1], ts[2], ts[3], ts[4], ts[5], ts[6]);

                // The winner caption is the same as the stats message and not randomized
                cap:= s;
                AddCaption(cap, capcolDefault, capgrpGameState);
                // TODO (maybe): Show victory animation/captions per-team instead of all winners at once?
                end;

            // Enable winner state for winning hogs and move camera to a winning hedgehog
            winCamera:= false;
            for j:= 0 to Pred(TeamsNumber) do
                with Teams[j]^ do
                    for i:= 0 to cMaxHHIndex do
                        with Hedgehogs[i] do
                            if (Gear <> nil) then
                                begin
                                if (not winCamera) then
                                    begin
                                    FollowGear:= Gear;
                                    winCamera:= true;
                                    end;
                                Gear^.State:= gstWinner;
                                end;
            if Flawless then
                AddVoice(sndFlawless, Teams[0]^.voicepack)
            else
                AddVoice(sndVictory, Teams[0]^.voicepack);
            end;

        if SendGameResultOn then
            SendStat(siGameResult, shortstring(s));
        if allWin and SendAchievementsStatsOn then
            SendStat(siEverAfter, '');
        AddGear(0, 0, gtATFinishGame, 0, _0, _0, 3000)
        end;
    SendStats;
    end;
TeamsGameOver:= true;
GameOver:= true
end;

procedure SwitchHedgehog;
var c, i, t: LongWord;
    PrevHH, PrevTeam : LongWord;
begin
TargetPoint.X:= NoPointX;
if checkFails(CurrentTeam <> nil, 'Team is nil!', true) then exit;
with CurrentHedgehog^ do
    if (PreviousTeam <> nil) and PlacingHogs and Unplaced then
        begin
        Unplaced:= false;
        if Gear <> nil then
           begin
           DeleteCI(Gear);
           FindPlace(Gear, false, 0, LAND_WIDTH, true);
           if Gear <> nil then
               AddCI(Gear)
           end
        end
    else if (PreviousTeam <> nil) and PlacingKings and UnplacedKing then
        UnplacedKing:= false;

PreviousTeam:= CurrentTeam;

with CurrentHedgehog^ do
    begin
    if Gear <> nil then
        begin
        MultiShootAttacks:= 0;
        Gear^.Message:= 0;
        Gear^.Z:= cHHZ;
        RemoveGearFromList(Gear);
        InsertGearToList(Gear)
        end
    end;
// Try to make the ammo menu viewed when not your turn be a bit more useful for per-hog-ammo mode
with CurrentTeam^ do
    if ((GameFlags and gfPerHogAmmo) <> 0) and (not ExtDriven) and (CurrentHedgehog^.BotLevel = 0) then
        begin
        c:= CurrHedgehog;
        repeat
            begin
            inc(c);
            if c > cMaxHHIndex then
                c:= 0
            end
        until (c = CurrHedgehog) or (Hedgehogs[c].Gear <> nil) and (Hedgehogs[c].Effects[heFrozen] < 50255);
        LocalAmmo:= Hedgehogs[c].AmmoStore
        end;

c:= CurrentTeam^.Clan^.ClanIndex;
repeat
    if (GameFlags and gfTagTeam) <> 0 then
        begin
        with ClansArray[c]^ do
            begin
            if (CurrTeam = TagTeamIndex) then
                begin
                TagTeamIndex:= Pred(TagTeamIndex) mod TeamsNumber;
                CurrTeam:= Pred(CurrTeam) mod TeamsNumber;
                inc(c);
                if c = ClansCount then
                    c:= 0;
                if c = SwapClanReal then
                    inc(TotalRoundsReal);
                NextClan:= true;
                end;
            end;

        with ClansArray[c]^ do
            begin
            if (not PlacingHogs) and (not PlacingKings) and ((Succ(CurrTeam) mod TeamsNumber) = TagTeamIndex) then
                begin
                if c = SwapClanPre then
                    inc(TotalRoundsPre);
                end;
            end;
        end
    else
        begin
        inc(c);
        if c = ClansCount then
            c:= 0;
        if (not PlacingHogs) and (not PlacingKings) then
            begin
            if c = SwapClanPre then
                inc(TotalRoundsPre);
            if c = SwapClanReal then
                inc(TotalRoundsReal);
            end;
        end;

    with ClansArray[c]^ do
        begin
        PrevTeam:= CurrTeam;
        repeat
            CurrTeam:= Succ(CurrTeam) mod TeamsNumber;
            CurrentTeam:= Teams[CurrTeam];
            with CurrentTeam^ do
                if (not Passive) then
                    begin
                    PrevHH:= CurrHedgehog mod HedgehogsNumber; // prevent infinite loop when CurrHedgehog = 7, but HedgehogsNumber < 8 (team is destroyed before its first turn)
                    repeat
                        CurrHedgehog:= Succ(CurrHedgehog) mod HedgehogsNumber;
                    until ((Hedgehogs[CurrHedgehog].Gear <> nil) and (Hedgehogs[CurrHedgehog].Effects[heFrozen] < 256)) or (CurrHedgehog = PrevHH)
                    end
        until ((not CurrentTeam^.Passive) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Effects[heFrozen] < 256)) or (PrevTeam = CurrTeam) or ((CurrTeam = TagTeamIndex) and ((GameFlags and gfTagTeam) <> 0))
        end;
        if (CurrentTeam^.Passive) or (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear = nil) or (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Effects[heFrozen] > 255) then
            begin
            with CurrentTeam^.Clan^ do
                for t:= 0 to Pred(TeamsNumber) do
                    with Teams[t]^ do
                        for i:= 0 to Pred(HedgehogsNumber) do
                            with Hedgehogs[i] do
                                begin
                                if Effects[heFrozen] > 255 then Effects[heFrozen]:= max(255,Effects[heFrozen]-50000);
                                if (Gear <> nil) and (Effects[heFrozen] < 256) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Effects[heFrozen] > 255) then
                                    CurrHedgehog:= i
                                end;
            if (not CurrentTeam^.Passive) and ((CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear = nil) or (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Effects[heFrozen] > 255)) then
                inc(CurrentTeam^.Clan^.TurnNumber);
            end;
until (not CurrentTeam^.Passive) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Effects[heFrozen] < 256);

SwitchCurrentHedgehog(@(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]));
{$IFDEF USE_TOUCH_INTERFACE}
if (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NoCrosshair) = 0 then
    begin
    if not(arrowUp.show) then
        begin
        animateWidget(@arrowUp, true, true);
        animateWidget(@arrowDown, true, true);
        end;
    end
else
    if arrowUp.show then
        begin
        animateWidget(@arrowUp, true, false);
        animateWidget(@arrowDown, true, false);
        end;
{$ENDIF}
AmmoMenuInvalidated:= true;
end;

procedure AfterSwitchHedgehog;
var i, t: LongInt;
    CurWeapon: PAmmo;
    w: real;
    vg: PVisualGear;
    g: PGear;
    s: ansistring;
begin
if PlacingHogs or PlacingKings then
    begin
    PlacingHogs:= false;
    PlacingKings:= false;
    for t:= 0 to Pred(TeamsCount) do
        for i:= 0 to cMaxHHIndex do
            if ((GameFlags and gfPlaceHog) <> 0) and (TeamsArray[t]^.Hedgehogs[i].Gear <> nil) and (TeamsArray[t]^.Hedgehogs[i].Unplaced) then
                PlacingHogs:= true
            else if ((GameFlags and gfPlaceHog) = 0) and ((GameFlags and gfKing) <> 0) and (TeamsArray[t]^.Hedgehogs[i].Gear <> nil) and (TeamsArray[t]^.Hedgehogs[i].UnplacedKing) then
                PlacingKings:= true;

    if (not PlacingHogs) and (not PlacingKings) then // Reset various things I mucked with
        begin
        for i:= 0 to ClansCount do
            if ClansArray[i] <> nil then
                begin
                ClansArray[i]^.TurnNumber:= 0;
                end;
        ResetWeapons
        end;

    end;

if (not PlacingHogs) and (not PlacingKings) then
    begin
    if (TotalRoundsReal = -1) then
        TotalRoundsReal:= 0;
    if (TotalRoundsPre = -1) and (ClansCount = 1) then
        TotalRoundsPre:= 0;
    end;

// Determine clan ID to check to determine whether to increase TotalRoundsPre/TotalRoundsReal
if (not PlacingHogs) and (not PlacingKings) then
    begin
    if SwapClanPre = -1 then
        begin
        if (GameFlags and gfRandomOrder) <> 0 then
            SwapClanPre:= 0
        else
            SwapClanPre:= ClansCount - 1;
        end;
    if SwapClanReal = -1 then
        SwapClanReal:= CurrentTeam^.Clan^.ClanIndex;
    end;

inc(CurrentTeam^.Clan^.TurnNumber);
with CurrentTeam^.Clan^ do
    for t:= 0 to Pred(TeamsNumber) do
        with Teams[t]^ do
            for i:= 0 to Pred(HedgehogsNumber) do
                with Hedgehogs[i] do
                    if Effects[heFrozen] > 255 then
                        Effects[heFrozen]:= max(255,Effects[heFrozen]-50000);

CurWeapon:= GetCurAmmoEntry(CurrentHedgehog^);
if CurWeapon^.Count = 0 then
    CurrentHedgehog^.CurAmmoType:= amNothing;

with CurrentHedgehog^ do
    begin
    with Gear^ do
        begin
        Z:= cCurrHHZ;
        State:= gstHHDriven;
        Active:= true;
        Power:= 0;
        LastDamage:= nil
        end;
    RemoveGearFromList(Gear);
    InsertGearToList(Gear);
    FollowGear:= Gear
    end;

if (GameFlags and gfDisableWind) = 0 then
    begin
    cWindSpeed:= rndSign(GetRandomf * 2 * cMaxWindSpeed);
    w:= hwFloat2Float(cWindSpeed);
    vg:= AddVisualGear(0, 0, vgtSmoothWindBar);
    if vg <> nil then vg^.dAngle:= w;
    AddFileLog('Wind = '+FloatToStr(cWindSpeed));
    end;

ApplyAmmoChanges(CurrentHedgehog^);

if (not CurrentTeam^.ExtDriven) and (CurrentHedgehog^.BotLevel = 0) then
    SetBinds(CurrentTeam^.Binds);

if PlacingHogs then
    begin
    if CurrentHedgehog^.Unplaced then
        TurnTimeLeft:= 15000
    else TurnTimeLeft:= 0
    end
else if PlacingKings then
    if CurrentHedgehog^.King and CurrentHedgehog^.UnplacedKing then
        TurnTimeLeft:= cHedgehogTurnTime
    else
        TurnTimeLeft:= 0
else
    begin
    if ((GameFlags and gfTagTeam) <> 0) and (not NextClan) then
        begin
        if TagTurnTimeLeft <> 0 then
            TurnTimeLeft:= TagTurnTimeLeft;
        TagTurnTimeLeft:= 0;
        end
    else
        begin
        TurnTimeLeft:= cHedgehogTurnTime;
        TagTurnTimeLeft:= 0;
        NextClan:= false;
        end;

    // Enable switching mode when gfSwitchHog is active
    if ((GameFlags and gfSwitchHog) <> 0) and (not CurrentTeam^.hasGone) and
            // Exception: During the special "Place your King" round in King Mode;
            // you're not supposed to switch away from your king in this round.
            (not (((GameFlags and gfKing) <> 0) and ((GameFlags and gfPlaceHog) = 0) and (TotalRoundsReal = -1))) then
        begin
        g:= AddGear(hwRound(CurrentHedgehog^.Gear^.X), hwRound(CurrentHedgehog^.Gear^.Y), gtSwitcher, 0, _0, _0, 0);
        CurAmmoGear:= g;
        lastGearByUID:= g;
        end
    else
        bShowFinger:= true;
    end;
IsGetAwayTime:= false;

// turn start taunt: sndYesSir for own team, sndHmm for enemy or computer team
if (TurnTimeLeft > 0) and (CurrentHedgehog^.BotLevel = 0) then
    begin
    if (not CinematicScript) then
        if CurrentTeam^.ExtDriven then
            AddVoice(sndHmm, CurrentTeam^.voicepack)
        else
            AddVoice(sndYesSir, CurrentTeam^.voicepack);
    if cHedgehogTurnTime < 1000000 then
        ReadyTimeLeft:= cReadyDelay;
    s:= ansistring(CurrentTeam^.TeamName);
    AddCaption(FormatA(trmsg[sidReady], s), capcolDefault, capgrpGameState)
    end
else
    begin
    if (TurnTimeLeft > 0) and (not CinematicScript) then
        AddVoice(sndHmm, CurrentTeam^.voicepack);
    ReadyTimeLeft:= 0;
    end;
end;

function SetMissionTeam(): PTeam;
var team: PTeam;
begin
New(team);
if checkFails(team <> nil, 'AddTeam: team = nil', true) then exit(nil);
FillChar(team^, sizeof(TTeam), 0);
team^.HedgehogsNumber:= 0;
team^.Binds:= DefaultBinds;

CurrentTeam:= team;
MissionTeam:= team;
SetMissionTeam:= team;
end;

function AddTeam(TeamColor: Longword): PTeam;
var team: PTeam;
    c: LongInt;
begin
if checkFails(TeamsCount < cMaxTeams, 'Too many teams', true) then exit(nil);
New(team);
if checkFails(team <> nil, 'AddTeam: team = nil', true) then exit(nil);
FillChar(team^, sizeof(TTeam), 0);
team^.AttackBar:= 2;
team^.CurrHedgehog:= 0;
team^.Flag:= 'hedgewars';

TeamsArray[TeamsCount]:= team;
inc(TeamsCount);
inc(VisibleTeamsCount);

team^.Binds:= DefaultBinds;
team^.Passive:= false;

c:= Pred(ClansCount);
while (c >= 0) and (ClansArray[c]^.Color <> TeamColor) do dec(c);
if c < 0 then
    begin
    new(team^.Clan);
    FillChar(team^.Clan^, sizeof(TClan), 0);
    ClansArray[ClansCount]:= team^.Clan;
    inc(ClansCount);
    with team^.Clan^ do
        begin
        ClanIndex:= Pred(ClansCount);
        Color:= TeamColor;
        TagTeamIndex:= 0;
        Flawless:= true;
        LocalOrAlly:= false;
        DeathLogged:= false;
        StatsHandled:= false;
        end
    end
else
    begin
    team^.Clan:= ClansArray[c];
    end;

with team^.Clan^ do
    begin
    Teams[TeamsNumber]:= team;
    Passive:= false;
    inc(TeamsNumber)
    end;

// mirror changes into array for clans to spawn
SpawnClansArray:= ClansArray;

CurrentTeam:= team;
AddTeam:= team;
end;

procedure RecountAllTeamsHealth;
var t: LongInt;
begin
for t:= 0 to Pred(TeamsCount) do
    RecountTeamHealth(TeamsArray[t])
end;

procedure InitTeams;
var i, t: LongInt;
    th, h: LongInt;
begin

for t:= 0 to Pred(TeamsCount) do
    with TeamsArray[t]^ do
        begin
        if (not ExtDriven) and (Hedgehogs[0].BotLevel = 0) then
            begin
            if (MissionTeam = nil) or (MissionTeam^.TeamName = TeamName) then
                Clan^.LocalOrAlly:= true;
            LocalTeam:= t;
            LocalAmmo:= Hedgehogs[0].AmmoStore
            end;
        th:= 0;
        for i:= 0 to cMaxHHIndex do
            if Hedgehogs[i].Gear <> nil then
                inc(th, Hedgehogs[i].Gear^.Health);
        if th > MaxTeamHealth then
            MaxTeamHealth:= th;
        // Some initial King buffs
        if (GameFlags and gfKing) <> 0 then
            begin
            hasKing:= true;
            Hedgehogs[0].King:= true;
            Hedgehogs[0].Hat:= 'crown';
            Hedgehogs[0].Effects[hePoisoned] := 0;
            h:= Hedgehogs[0].Gear^.Health;
            Hedgehogs[0].Gear^.Health:= hwRound(int2hwFloat(th)*_0_375);
            if Hedgehogs[0].Gear^.Health > h then
                begin
                dec(th, h);
                inc(th, Hedgehogs[0].Gear^.Health);
                if th > MaxTeamHealth then
                    MaxTeamHealth:= th
                end
            else
                Hedgehogs[0].Gear^.Health:= h;
            // Prevent overflow
            if (Hedgehogs[0].Gear^.Health < 0) or (Hedgehogs[0].Gear^.Health > cMaxHogHealth) then
                Hedgehogs[0].Gear^.Health:= cMaxHogHealth;
            Hedgehogs[0].InitialHealth:= Hedgehogs[0].Gear^.Health
            end;
        end;

RecountAllTeamsHealth
end;

function  TeamSize(p: PTeam): Longword;
var i, value: Longword;
begin
value:= 0;
for i:= 0 to cMaxHHIndex do
    if p^.Hedgehogs[i].Gear <> nil then
        inc(value);
TeamSize:= value;
end;

procedure RecountClanHealth(clan: PClan);
var i: LongInt;
begin
with clan^ do
    begin
    ClanHealth:= 0;
    for i:= 0 to Pred(TeamsNumber) do
        inc(ClanHealth, Teams[i]^.TeamHealth)
    end
end;

procedure RecountTeamHealth(team: PTeam);
var i: LongInt;
begin
with team^ do
    begin
    TeamHealth:= 0;
    for i:= 0 to cMaxHHIndex do
        if Hedgehogs[i].Gear <> nil then
            inc(TeamHealth, Hedgehogs[i].Gear^.Health)
        else if Hedgehogs[i].GearHidden <> nil then
            inc(TeamHealth, Hedgehogs[i].GearHidden^.Health);

    if TeamHealth > MaxTeamHealth then
        begin
        MaxTeamHealth:= TeamHealth;
        RecountAllTeamsHealth;
        end
    end;

RecountClanHealth(team^.Clan);

AddVisualGear(0, 0, vgtTeamHealthSorter)
end;

procedure RestoreHog(HH: PHedgehog);
begin
    HH^.Gear:=HH^.GearHidden;
    HH^.GearHidden:= nil;
    InsertGearToList(HH^.Gear);
    HH^.Gear^.State:= (HH^.Gear^.State and (not (gstHHDriven or gstInvisible or gstAttacking))) or gstAttacked;
    AddCI(HH^.Gear);
    HH^.Gear^.Active:= true;
    ScriptCall('onHogRestore', HH^.Gear^.Uid);
    AddVisualGear(0, 0, vgtTeamHealthSorter);
end;

procedure RestoreTeamsFromSave;
var t: LongInt;
begin
for t:= 0 to Pred(TeamsCount) do
   TeamsArray[t]^.ExtDriven:= false
end;

procedure TeamGoneEffect(var Team: TTeam);
var i: LongInt;
begin
    with Team do
        if skippedTurns < 3 then
            begin
            inc(skippedTurns);
            for i:= 0 to cMaxHHIndex do
                with Hedgehogs[i] do
                    if Gear <> nil then
                        Gear^.State:= Gear^.State and (not gstHHDriven);

            ParseCommand('/skip', true);
            end
        else
            for i:= 0 to cMaxHHIndex do
                with Hedgehogs[i] do
                    begin
                    if Hedgehogs[i].GearHidden <> nil then
                        RestoreHog(@Hedgehogs[i]);

                    if Gear <> nil then
                        begin
                        Gear^.Hedgehog^.Effects[heInvulnerable]:= 0;
                        Gear^.Damage:= Gear^.Health;
                        Gear^.State:= (Gear^.State or gstHHGone) and (not gstHHDriven)
                        end
                    end
end;

procedure chAddMissionHH(var id: shortstring);
var s: shortstring;
    Health: LongInt;
begin
s:= '';
if (not isDeveloperMode) then
    exit;
if checkFails((CurrentTeam <> nil), 'Can''t add hedgehogs yet, add a team first!', true) then exit;
with CurrentTeam^ do
    begin
    if checkFails(HedgehogsNumber<=cMaxHHIndex, 'Can''t add hedgehog to "' + TeamName + '"! (already ' + intToStr(HedgehogsNumber) + ' hogs)', true) then exit;
    SplitBySpace(id, s);
    CurrentHedgehog:= @Hedgehogs[HedgehogsNumber];
    CurrentHedgehog^.BotLevel:= StrToInt(id);
    CurrentHedgehog^.Team:= CurrentTeam;
    SplitBySpace(s, id);
    Health:= StrToInt(s);
    if checkFails((Health > 0) and (Health <= cMaxHogHealth), 'Invalid hedgehog health (must be between 1 and '+IntToStr(cMaxHogHealth)+')', true) then exit;
    CurrentHedgehog^.Name:= id;
    CurrentHedgehog^.InitialHealth:= Health;
    CurrentHedgehog^.RevengeHog:= nil;
    inc(HedgehogsNumber)
    end
end;

procedure chAddHH(var id: shortstring);
var s: shortstring;
    Gear: PGear;
begin
s:= '';
if (not isDeveloperMode) then
    exit;
if checkFails((CurrentTeam <> nil), 'Can''t add hedgehogs yet, add a team first!', true) then exit;
with CurrentTeam^ do
    begin
    if checkFails(HedgehogsNumber<=cMaxHHIndex, 'Can''t add hedgehog to "' + TeamName + '"! (already ' + intToStr(HedgehogsNumber) + ' hogs)', true) then exit;
    SplitBySpace(id, s);
    SwitchCurrentHedgehog(@Hedgehogs[HedgehogsNumber]);
    CurrentHedgehog^.BotLevel:= StrToInt(id);
    CurrentHedgehog^.Team:= CurrentTeam;
    Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0);
    SplitBySpace(s, id);
    Gear^.Health:= StrToInt(s);
    if checkFails((Gear^.Health > 0) and (Gear^.Health <= cMaxHogHealth), 'Invalid hedgehog health (must be between 1 and '+IntToStr(cMaxHogHealth)+')', true) then exit;
    if (GameFlags and gfSharedAmmo) <> 0 then
        CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex
    else if (GameFlags and gfPerHogAmmo) <> 0 then
        begin
        AddAmmoStore;
        CurrentHedgehog^.AmmoStore:= StoreCnt - 1
        end
    else CurrentHedgehog^.AmmoStore:= TeamsCount - 1;
    CurrentHedgehog^.Gear:= Gear;
    CurrentHedgehog^.Name:= id;
    CurrentHedgehog^.InitialHealth:= Gear^.Health;
    CurrentHedgehog^.RevengeHog:= nil;
    CurrentHedgehog^.FlownOffMap:= false;
    CurrHedgehog:= HedgehogsNumber;
    inc(HedgehogsNumber)
    end
end;

procedure loadTeamBinds(s: shortstring);
var i: LongInt;
begin
    for i:= 1 to length(s) do
        if ((s[i] = '\') or
            (s[i] = '/') or
            (s[i] = ':')) then
            s[i]:= '_';

    s:= cPathz[ptTeams] + '/' + s + '.hwt';

    loadBinds('bind', s);
end;

// Make sure the team name of chTeam is unique.
// If it isn't, the name is changed to be unique.
procedure makeTeamNameUnique(chTeam: PTeam);
var tail: shortstring;
    t, numLen, numTail: LongInt;
//    valOK: Word;    -- see pas2c-related FIXME below
    nameDupeCheck: boolean;
    chChar: char;
begin
    nameDupeCheck:= false;
    while(nameDupeCheck = false) do
        begin
        nameDupeCheck:= true;
        for t:=0 to TeamsCount - 1 do
            begin
            // Name collision?
            if (chTeam <> teamsArray[t]) and (TeamsArray[t]^.TeamName = chTeam^.TeamName) then
                begin
                // Change the name by appending a sequence number, starting from 2
                numLen:= 0;
                chChar:= chTeam^.TeamName[Length(chTeam^.TeamName) - numLen];
                // Parse number at end of team name (if any)
                while (chChar >= '0') and (chChar <= '9') and (numLen < Length(chTeam^.TeamName)) do
                    begin
                    inc(numLen);
                    chChar:= chTeam^.TeamName[Length(chTeam^.TeamName) - numLen];
                    end;

                if numLen > 0 then
                    // Number found: Increment it by 1
                    begin
                    tail:= Copy(chTeam^.TeamName, Length(chTeam^.TeamName) - numLen + 1, numLen);
(* FIXME - pas2c missing 3rd param for val
                    valOK:= 1;
                    Val(tail, numTail, valOK);
                    Inc(numTail);
                    if valOK = 0 then
                        tail:= IntToStr(numTail)
                    else
                        // This should not happen
                        tail:= shortstring('X');
*)
                    Val(tail, numTail);
                    Inc(numTail);
                    tail:= IntToStr(numTail);
                    chTeam^.TeamName:= Copy(chTeam^.TeamName, 0, Length(chTeam^.TeamName) - numLen) + tail;
                    end
                else
                    // No number at team end: Just append a '2'
                    chTeam^.TeamName:= chTeam^.TeamName + ' 2';
                nameDupeCheck:= false;
                break;
                end;
            end;
        end;
end;

procedure chAddTeam(var s: shortstring);
var Color: Longword;
    ts, cs: shortstring;
begin
cs:= '';
ts:= '';
if isDeveloperMode then
    begin
    SplitBySpace(s, cs);
    SplitBySpace(cs, ts);
    Color:= StrToInt(cs);

    // color is always little endian so the mask must be constant also in big endian archs
    Color:= Color or $FF000000;
    AddTeam(Color);

    if CurrentTeam <> nil then
        begin
        CurrentTeam^.TeamName:= ts;
        makeTeamNameUnique(CurrentTeam);

        CurrentTeam^.PlayerHash:= s;
        loadTeamBinds(ts);

        if GameType in [gmtDemo, gmtSave, gmtRecord] then
            CurrentTeam^.ExtDriven:= true;

        CurrentTeam^.voicepack:= AskForVoicepack('Default_qau')
        end
    end
end;

procedure chSetMissionTeam(var s: shortstring);
var ts, cs: shortstring;
begin
cs:= '';
ts:= '';
if isDeveloperMode then
    begin
    SplitBySpace(s, cs);
    SplitBySpace(cs, ts);

    SetMissionTeam();

    if CurrentTeam <> nil then
        begin
        CurrentTeam^.TeamName:= ts;
        CurrentTeam^.PlayerHash:= s;
        loadTeamBinds(ts);
        CurrentTeam^.voicepack:= AskForVoicepack('Default_qau')
        end
    end
end;

procedure chSetHHCoords(var x: shortstring);
var y: shortstring;
    t: Longint;
begin
    y:= '';
    if (not isDeveloperMode) or (CurrentHedgehog = nil) or (CurrentHedgehog^.Gear = nil) then
        exit;
    SplitBySpace(x, y);
    t:= StrToInt(x);
    CurrentHedgehog^.Gear^.X:= int2hwFloat(t);
    t:= StrToInt(y);
    CurrentHedgehog^.Gear^.Y:= int2hwFloat(t)
end;

procedure chBind(var id: shortstring);
begin
    if CurrentTeam = nil then
        exit;

    addBind(CurrentTeam^.Binds, id)
end;

procedure chTeamGone(var s:shortstring);
var t, i: LongInt;
    isSynced: boolean;
begin
    isSynced:= s[1] = 's';

    Delete(s, 1, 1);

    t:= 0;
    while (t < TeamsCount) and (TeamsArray[t]^.TeamName <> s) do
        inc(t);
    if t = TeamsCount then
        exit;

    TeamsArray[t]^.isGoneFlagPendingToBeSet:= true;

    if isSynced then
        begin
        for i:= 0 to Pred(TeamsCount) do
            with TeamsArray[i]^ do
                begin
                if (not hasGone) and isGoneFlagPendingToBeSet then
                    begin
                    if (not TeamsGameOver) then
                        AddChatString(#7 + Format('* '+shortstring(trmsg[sidTeamGone]), TeamName));
                    if not CurrentTeam^.ExtDriven then SendIPC(_S'f' + s);
                    hasGone:= true;
                    skippedTurns:= 0;
                    isGoneFlagPendingToBeSet:= false;
                    RecountTeamHealth(TeamsArray[i])
                    end;
                if hasGone and isGoneFlagPendingToBeUnset then
                    ParseCommand('/teamback s' + s, true)
                end
        end
    else
        begin
        //TeamsArray[t]^.isGoneFlagPendingToBeSet:= true;

        if (not CurrentTeam^.ExtDriven) or (CurrentTeam^.TeamName = s) or (CurrentTeam^.hasGone) then
            ParseCommand('/teamgone s' + s, true)
        end;
end;

procedure chTeamBack(var s:shortstring);
var t: LongInt;
    isSynced: boolean;
begin
    isSynced:= s[1] = 's';

    Delete(s, 1, 1);

    t:= 0;
    while (t < TeamsCount) and (TeamsArray[t]^.TeamName <> s) do
        inc(t);
    if t = TeamsCount then
        exit;

    if isSynced then
        begin
        with TeamsArray[t]^ do
            if hasGone then
                begin
                AddChatString(#8 + Format('* '+shortstring(trmsg[sidTeamBack]), TeamName));
                if not CurrentTeam^.ExtDriven then SendIPC(_S'g' + s);
                hasGone:= false;

                RecountTeamHealth(TeamsArray[t]);

                if isGoneFlagPendingToBeUnset and (Owner = UserNick) then
                    ExtDriven:= false;

                isGoneFlagPendingToBeUnset:= false;
                end;
        end
    else
        begin
        TeamsArray[t]^.isGoneFlagPendingToBeUnset:= true;

        if not CurrentTeam^.ExtDriven then
            ParseCommand('/teamback s' + s, true);
        end;
end;


procedure SwitchCurrentHedgehog(newHog: PHedgehog);
var oldCI, newCI: boolean;
    oldHH: PHedgehog;
begin
   if (CurrentHedgehog <> nil) and (CurrentHedgehog^.CurAmmoType = amKnife) then
       LoadHedgehogHat(CurrentHedgehog^, CurrentHedgehog^.Hat);
    oldCI:= (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil) and (CurrentHedgehog^.Gear^.CollisionIndex >= 0);
    newCI:= (newHog^.Gear <> nil) and (newHog^.Gear^.CollisionIndex >= 0);
    if oldCI then DeleteCI(CurrentHedgehog^.Gear);
    if newCI then DeleteCI(newHog^.Gear);
    oldHH:= CurrentHedgehog;
    CurrentHedgehog:= newHog;
    if oldCI then AddCI(oldHH^.Gear);
    if newCI then AddCI(newHog^.Gear)
end;


procedure chSetHat(var s: shortstring);
begin
if (not isDeveloperMode) or (CurrentTeam = nil) then exit;
with CurrentTeam^ do
    begin
    if not CurrentHedgehog^.King then
    if (s = '')
    or (((GameFlags and gfKing) <> 0) and (s = 'crown'))
    or ((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then
        CurrentHedgehog^.Hat:= 'NoHat'
    else
        CurrentHedgehog^.Hat:= s
    end;
end;

procedure chGrave(var s: shortstring);
begin
    if CurrentTeam = nil then
        OutError(errmsgIncorrectUse + ' "/grave"', true);
    if s[1]='"' then
        Delete(s, 1, 1);
    if s[byte(s[0])]='"' then
        Delete(s, byte(s[0]), 1);
    CurrentTeam^.GraveName:= s
end;

procedure chFort(var s: shortstring);
begin
    if CurrentTeam = nil then
        OutError(errmsgIncorrectUse + ' "/fort"', true);
    if s[1]='"' then
        Delete(s, 1, 1);
    if s[byte(s[0])]='"' then
        Delete(s, byte(s[0]), 1);
    CurrentTeam^.FortName:= s
end;

procedure chFlag(var s: shortstring);
begin
    if CurrentTeam = nil then
        OutError(errmsgIncorrectUse + ' "/flag"', true);
    if s[1]='"' then
        Delete(s, 1, 1);
    if s[byte(s[0])]='"' then
        Delete(s, byte(s[0]), 1);
    CurrentTeam^.flag:= s
end;

procedure chOwner(var s: shortstring);
begin
    if CurrentTeam = nil then
        OutError(errmsgIncorrectUse + ' "/owner"', true);

    CurrentTeam^.Owner:= s
end;

procedure initModule;
begin
RegisterVariable('addhh', @chAddHH, false);
RegisterVariable('addmisshh', @chAddMissionHH, false);
RegisterVariable('addteam', @chAddTeam, false);
RegisterVariable('setmissteam', @chSetMissionTeam, false);
RegisterVariable('hhcoords', @chSetHHCoords, false);
RegisterVariable('bind', @chBind, true );
RegisterVariable('teamgone', @chTeamGone, true );
RegisterVariable('teamback', @chTeamBack, true );
RegisterVariable('fort'    , @chFort         , false);
RegisterVariable('grave'   , @chGrave        , false);
RegisterVariable('hat'     , @chSetHat       , false);
RegisterVariable('flag'    , @chFlag         , false);
RegisterVariable('owner'   , @chOwner        , false);

CurrentTeam:= nil;
PreviousTeam:= nil;
CurrentHedgehog:= nil;
TeamsCount:= 0;
ClansCount:= 0;
LocalTeam:= -1;
LocalAmmo:= -1;
TeamsGameOver:= false;
NextClan:= true;
SwapClanPre:= -1;
SwapClanReal:= -1;
MaxTeamHealth:= 0;
end;

procedure freeModule;
var i, h: LongWord;
begin
CurrentHedgehog:= nil;
if TeamsCount > 0 then
    begin
    for i:= 0 to Pred(TeamsCount) do
        begin
        for h:= 0 to cMaxHHIndex do
            with TeamsArray[i]^.Hedgehogs[h] do
                begin
//                if Gear <> nil then
//                    DeleteGearStage(Gear, true);
                if GearHidden <> nil then
                    Dispose(GearHidden);
//                    DeleteGearStage(GearHidden, true);

                FreeAndNilTexture(NameTagTex);
                FreeAndNilTexture(HealthTagTex);
                FreeAndNilTexture(HatTex)
                end;

        with TeamsArray[i]^ do
            begin
            FreeAndNilTexture(NameTagTex);
            FreeAndNilTexture(OwnerTex);
            FreeAndNilTexture(GraveTex);
            FreeAndNilTexture(AIKillsTex);
            FreeAndNilTexture(LuaTeamValueTex);
            FreeAndNilTexture(FlagTex);
            end;

        Dispose(TeamsArray[i])
        end;
    for i:= 0 to Pred(ClansCount) do
        begin
        FreeAndNilTexture(ClansArray[i]^.HealthTex);
        Dispose(ClansArray[i])
        end
    end;
TeamsCount:= 0;
ClansCount:= 0;
SwapClanPre:= -1;
SwapClanReal:= -1;
end;

end.