(*

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

(*

 * This unit defines the behavior of gears.

 *

 * Gears are "things"/"objects" that may be visible to the player or not,

 * but always have an effect on the course of the game.

 *

 * E.g.: weapons, hedgehogs, etc.

 *

 * Note: The visual appearance of gears is defined in the unit "uGearsRender".

 *

 * Note: Gears that do not have an effect on the game but are just visual

 *       effects are called "Visual Gears" and defined in the respective unit!

 *)

interface

uses uConsts, uFloat, uTypes, uChat, uCollisions;

procedure initModule;

procedure freeModule;

function  SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content, cnt: Longword): PGear;

function  SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean ): PGear;

procedure ProcessGears;

procedure EndTurnCleanup;

procedure DrawGears;

procedure DrawGearsGui;

procedure FreeGearsList;

procedure AddMiscGears;

procedure AssignHHCoords;

procedure StartSuddenDeath;

function  GearByUID(uid : Longword) : PGear;

function  IsClockRunning() : boolean;

implementation

uses uStore, uSound, uTeams, uRandom, uIO, uLandGraphics,

    {$IFDEF USE_TOUCH_INTERFACE}uTouch,{$ENDIF}

    uLocale, uAmmos, uStats, uVisualGears, uScript, uVariables,

    uCommands, uUtils, uTextures, uRenderUtils, uGearsRender, uCaptions,

    uGearsHedgehog, uGearsUtils, uGearsList, uGearsHandlersRope

    , uVisualGearsList, uGearsHandlersMess, uAI;

var skipFlag: boolean;

var delay: LongWord;

    delay2: LongWord;

    NewTurnTick: LongWord;

    //SDMusic: shortstring;

function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs

var Gear: PGear;

    dmg: LongInt;

begin

CheckNoDamage:= true;

Gear:= GearsList;

while Gear <> nil do

    begin

    if (Gear^.Kind = gtHedgehog) and (((GameFlags and gfInfAttack) = 0) or ((Gear^.dX.QWordValue < _0_000004.QWordValue)

    and (Gear^.dY.QWordValue < _0_000004.QWordValue))) then

        begin

        if (not isInMultiShoot) then

            inc(Gear^.Damage, Gear^.Karma);

        if (Gear^.Damage <> 0) and ((Gear^.Hedgehog^.Effects[heInvulnerable] = 0)) then

            begin

            CheckNoDamage:= false;

            dmg:= Gear^.Damage;

            if (Gear^.Health < dmg) then

                begin

                Gear^.Active:= true;

                Gear^.Health:= 0

                end

            else

                dec(Gear^.Health, dmg);

(*

This doesn't fit well w/ the new loser sprite which is cringing from an attack.

            if (Gear^.Hedgehog^.Team = CurrentTeam) and (Gear^.Damage <> Gear^.Karma)

            and (not Gear^.Hedgehog^.King) and (Gear^.Hedgehog^.Effects[hePoisoned] = 0) and (not SuddenDeathDmg) then

                Gear^.State:= Gear^.State or gstLoser;

*)

            spawnHealthTagForHH(Gear, dmg);

            RenderHealth(Gear^.Hedgehog^);

            RecountTeamHealth(Gear^.Hedgehog^.Team);

            end

        else if ((GameFlags and gfKing) <> 0) and (not Gear^.Hedgehog^.Team^.hasKing) then

            begin

            Gear^.Active:= true;

            Gear^.Health:= 0;

            RenderHealth(Gear^.Hedgehog^);

            RecountTeamHealth(Gear^.Hedgehog^.Team);

            end;

        if (not isInMultiShoot) then

            Gear^.Karma:= 0;

        Gear^.Damage:= 0

        end;

    Gear:= Gear^.NextGear

    end;

end;

function CheckMinionsDie: boolean;

var Gear: PGear;

begin

    CheckMinionsDie:= false;

    if (GameFlags and gfKing) = 0 then

        exit;

    Gear:= GearsList;

    while Gear <> nil do

        begin

        if (Gear^.Kind = gtHedgehog) and (not Gear^.Hedgehog^.King) and (not Gear^.Hedgehog^.Team^.hasKing) then

            begin

            CheckMinionsDie:= true;

            exit;

            end;

        Gear:= Gear^.NextGear;

        end;

end;

procedure HealthMachine;

var Gear: PGear;

    team: PTeam;

    i: LongWord;

    flag: Boolean;

    tmp: LongWord;

begin

    Gear:= GearsList;

    while Gear <> nil do

    begin

        if Gear^.Kind = gtHedgehog then

            begin

            tmp:= 0;

            // Deal poison damage (when not frozen)

            if (Gear^.Hedgehog^.Effects[hePoisoned] <> 0) and (Gear^.Hedgehog^.Effects[heFrozen] = 0) then

                begin

                inc(tmp, ModifyDamage(Gear^.Hedgehog^.Effects[hePoisoned], Gear));

                if (GameFlags and gfResetHealth) <> 0 then

                    dec(Gear^.Hedgehog^.InitialHealth);

                end;

            // Apply SD health decrease as soon as SD starts

            if (TotalRoundsPre > cSuddenDTurns - 1) then

                begin

                inc(tmp, cHealthDecrease);

                if (GameFlags and gfResetHealth) <> 0 then

                    dec(Gear^.Hedgehog^.InitialHealth, cHealthDecrease)

                end;

            // Reduce king health when he is alone in team

            if Gear^.Hedgehog^.King then

                begin

                flag:= false;

                team:= Gear^.Hedgehog^.Team;

                for i:= 0 to Pred(team^.HedgehogsNumber) do

                    if (team^.Hedgehogs[i].Gear <> nil) and (not team^.Hedgehogs[i].King)

                    and (team^.Hedgehogs[i].Gear^.Health > team^.Hedgehogs[i].Gear^.Damage) then

                        flag:= true;

                if not flag then

                    begin

                    inc(tmp, 5);

                    if (GameFlags and gfResetHealth) <> 0 then

                        dec(Gear^.Hedgehog^.InitialHealth, 5)

                    end

                end;

            // Initial health must never be below 1 because hog might be resurrected

            if Gear^.Hedgehog^.InitialHealth < 1 then

                Gear^.Hedgehog^.InitialHealth:= 1;

            // Set real damage

            if tmp > 0 then

                begin

                // SD damage never reduces health below 1

                tmp:= min(tmp, max(0, Gear^.Health - 1 - Gear^.Damage));

                inc(Gear^.Damage, tmp);

                if tmp > 0 then

                    // Make hedgehog moan on damage

                    HHHurt(Gear^.Hedgehog, dsPoison, tmp);

                end

            end;

        Gear:= Gear^.NextGear

    end;

end;

procedure ProcessGears;

var t: PGear;

    i, AliveCount: LongInt;

    s: ansistring;

    prevtime: LongWord;

    stirFallers: boolean;

begin

stirFallers:= false;

prevtime:= TurnTimeLeft;

ScriptCall('onGameTick');

if GameTicks mod 20 = 0 then ScriptCall('onGameTick20');

if GameTicks = NewTurnTick then

    begin

    ScriptCall('onNewTurn');

{$IFDEF USE_TOUCH_INTERFACE}

    uTouch.NewTurnBeginning();

{$ENDIF}

    end;

PrvInactive:= AllInactive;

AllInactive:= true;

if (StepSoundTimer > 0) and (StepSoundChannel < 0) then

    StepSoundChannel:= LoopSound(sndSteps)

else if (StepSoundTimer = 0) and (StepSoundChannel > -1) then

    begin

    StopSoundChan(StepSoundChannel);

    StepSoundChannel:= -1

    end;

if StepSoundTimer > 0 then

    dec(StepSoundTimer, 1);

t:= GearsList;

while t <> nil do

    begin

    curHandledGear:= t;

    t:= curHandledGear^.NextGear;

    if (GameTicks and $1FFF = 0) and (curHandledGear^.Kind = gtCase) and (curHandledGear^.Pos <> posCaseHealth) then

        stirFallers := true; 

    if curHandledGear^.Message and gmDelete <> 0 then

        DeleteGear(curHandledGear)

    else

        begin

        if curHandledGear^.Message and gmRemoveFromList <> 0 then

            begin

            RemoveGearFromList(curHandledGear);

            // since I can't think of any good reason this would ever be separate from a remove from list, going to keep it inside this block

            if curHandledGear^.Message and gmAddToList <> 0 then InsertGearToList(curHandledGear);

            curHandledGear^.Message:= curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList))

            end;

        if curHandledGear^.Active then

            begin

            if curHandledGear^.RenderTimer and (curHandledGear^.Timer > 500) and ((curHandledGear^.Timer mod 1000) = 0) then

                begin

                FreeAndNilTexture(curHandledGear^.Tex);

                curHandledGear^.Tex:= RenderStringTex(ansistring(inttostr(curHandledGear^.Timer div 1000)), cWhiteColor, fntSmall);

                end;

            curHandledGear^.doStep(curHandledGear);

            // might be useful later

            //ScriptCall('onGearStep', Gear^.uid);

            end

        end

    end;

if stirFallers then

    begin

    t := GearsList;

    while t <> nil do

        begin

        if (t^.Kind = gtGenericFaller) and (t^.Tag = 1) then

            begin

            t^.Active:= true;

            t^.X:=  int2hwFloat(GetRandom(rightX-leftX)+leftX);

            t^.Y:=  int2hwFloat(GetRandom(LAND_HEIGHT-topY)+topY);

            t^.dX:= _90-(GetRandomf*_360);

            t^.dY:= _90-(GetRandomf*_360)

            end;

        t := t^.NextGear

        end

    end;

curHandledGear:= nil;

if AllInactive then

case step of

    stInit:

        begin

        if (not bBetweenTurns) and (not isInMultiShoot) then

            ScriptCall('onEndTurn');

        inc(step)

        end;

    stChDmg:

    if CheckNoDamage then

        inc(step)

    else

    stSweep:

    if SweepDirty then

        begin

        SetAllToActive;

        step:= stChDmg

        end

    else

        inc(step);

    stTurnStats:

        begin

        if (not bBetweenTurns) and (not isInMultiShoot) then

            uStats.TurnStats;

        inc(step)

        end;

    stChWin1:

        begin

        CheckForWin();

        inc(step)

        end;

    stTurnReact:

        begin

        if (not bBetweenTurns) and (not isInMultiShoot) then

            begin

            uStats.TurnReaction;

            uStats.TurnStatsReset;

            inc(step)

            end

        else

            inc(step, 2);

        end;

    stChWin2:

        begin

        CheckForWin();

        inc(step)

        end;

    stWater:

    if (not bBetweenTurns) and (not isInMultiShoot) then

        begin

        // Start Sudden Death water rise in the 2nd round of Sudden Death

        if TotalRoundsPre = cSuddenDTurns + 1 then

            bWaterRising:= true;

        if bWaterRising and (cWaterRise > 0) then

            begin

            bDuringWaterRise:= true;

            AddGear(0, 0, gtWaterUp, 0, _0, _0, 0)^.Tag:= cWaterRise;

            end;

        inc(step)

        end

    else // since we are not raising the water, another win-check isn't needed

        inc(step,2);

    stChWin3:

        begin

        CheckForWin;

        bDuringWaterRise:= false;

        inc(step)

        end;

    stChKing:

        begin

        if (not isInMultiShoot) and (CheckMinionsDie) then

            step:= stChDmg

        else

            inc(step);

        end;

        begin

        if (cWaterRise <> 0) or (cHealthDecrease <> 0) then

            begin

            if (TotalRoundsPre = cSuddenDTurns) and (not SuddenDeath) and (not isInMultiShoot) then

            else if (TotalRoundsPre < cSuddenDTurns) and (not isInMultiShoot) then

                begin

                i:= cSuddenDTurns - TotalRoundsPre;

                s:= ansistring(inttostr(i));

                if i = 1 then

                else if (i = 2) or ((i > 0) and ((i mod 50 = 0) or ((i <= 25) and (i mod 5 = 0)))) then

                    AddCaption(FormatA(trmsg[sidRoundsSD], s), capcolDefault, capgrpGameState);

                end;

            end;

    stSpawn:

        begin

            SpawnBoxOfSmth;

        end;

    stNTurn:

        begin

        if isInMultiShoot then

            isInMultiShoot:= false

        else

            begin

            // delayed till after 0.9.12

            // reset to default zoom

            //ZoomValue:= ZoomDefault;

            with CurrentHedgehog^ do

                if (Gear <> nil)

                and ((Gear^.State and gstAttacked) = 0)

                and (MultiShootAttacks > 0) then

                    OnUsedAmmo(CurrentHedgehog^);

                EndTurnCleanup;

                FreeActionsList; // could send -left, -right and similar commands, so should be called before /nextturn

                ParseCommand('/nextturn', true);

                SwitchHedgehog;

                AfterSwitchHedgehog;