(*

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

procedure AddMiscGears;

procedure AssignHHCoords;

function  GearByUID(uid : Longword) : PGear;

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

    uGearsHedgehog, uGearsUtils, uGearsList, uGearsHandlersRope

    , uVisualGearsList, uGearsHandlersMess, uAI;

var skipFlag: boolean;

var delay: LongWord;

    delay2: LongWord;

    step: (stDelay, stChDmg, stSweep, stTurnReact,

    stAfterDelay, stChWin, stWater, stChWin2, stHealth,

    stSpawn, stNTurn);

    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;

        if (not isInMultiShoot) then

            Gear^.Karma:= 0;

        Gear^.Damage:= 0

        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;

            if Gear^.Hedgehog^.Effects[hePoisoned] <> 0 then

                begin

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

                if (GameFlags and gfResetHealth) <> 0 then

                    dec(Gear^.Hedgehog^.InitialHealth)  // does not need a minimum check since <= 1 basically disables it

                end;

            if (TotalRounds > cSuddenDTurns - 1) then

                begin

                inc(tmp, cHealthDecrease);

                if (GameFlags and gfResetHealth) <> 0 then

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

                end;

            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;

            if tmp > 0 then

                begin

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

                HHHurt(Gear^.Hedgehog, dsPoison);

                end

            end;

        Gear:= Gear^.NextGear

    end;

end;

procedure ProcessGears;

var t: PGear;

    i, AliveCount: LongInt;

    s: ansistring;

    prevtime: LongWord;

begin

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

curHandledGear:= nil;

if AllInactive then

case step of

    stDelay:

        begin

        if delay = 0 then

            delay:= cInactDelay

        else

            dec(delay);

        if delay = 0 then

            inc(step)

        end;

    stChDmg:

    if CheckNoDamage then

        inc(step)

    else

        step:= stDelay;

    stSweep:

    if SweepDirty then

        begin

        SetAllToActive;

        step:= stChDmg

        end

    else

        inc(step);

    stTurnReact:

        begin

        if (not bBetweenTurns) and (not isInMultiShoot) then

            begin

            uStats.TurnReaction;

            inc(step)

            end

        else

            inc(step, 2);

        end;

    stAfterDelay:

        begin

        if delay = 0 then

            delay:= cInactDelay

        else

            dec(delay);

        if delay = 0 then

            inc(step)

            end;

    stChWin:

        begin

        CheckForWin();

        inc(step)

        end;

    stWater:

    if (not bBetweenTurns) and (not isInMultiShoot) then

        begin

        if TotalRounds = cSuddenDTurns + 1 then

            bWaterRising:= true;

        if bWaterRising and (cWaterRise > 0) then

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

        inc(step)

        end

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

        inc(step,2);

    stChWin2:

        begin

        CheckForWin;

        inc(step)

        end;

    stHealth:

        begin

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

             begin

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

                begin

                SuddenDeath:= true;

                if cHealthDecrease <> 0 then

                    begin

                    SuddenDeathDmg:= true;

                    // flash

                    ScreenFade:= sfFromWhite;

                    ScreenFadeValue:= sfMax;

                    ScreenFadeSpeed:= 1;

                    ChangeToSDClouds;

                    ChangeToSDFlakes;

                    SetSkyColor(SDSkyColor.r * (SDTint/255) / 255, SDSkyColor.g * (SDTint/255) / 255, SDSkyColor.b * (SDTint/255) / 255);

                    Ammoz[amTardis].SkipTurns:= 9999;

                    Ammoz[amTardis].Probability:= 0;

                    end;

                AddCaption(trmsg[sidSuddenDeath], cWhiteColor, capgrpGameState);

                ScriptCall('onSuddenDeath');

                playSound(sndSuddenDeath);

                StopMusic;

                if SDMusicFN <> '' then PlayMusic

                end

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

                begin

                i:= cSuddenDTurns - TotalRounds;

                s:= ansistring(inttostr(i));

                if i = 1 then

                    AddCaption(trmsg[sidRoundSD], cWhiteColor, capgrpGameState)

                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), cWhiteColor, capgrpGameState);

                end;

            end;

            if bBetweenTurns

            or isInMultiShoot

            or (TotalRounds = -1) then

                inc(step)

            else

                begin

                bBetweenTurns:= true;

                HealthMachine;

                step:= stChDmg

                end

            end;

    stSpawn:

        begin

        if not isInMultiShoot then

            SpawnBoxOfSmth;

        inc(step)

        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;

                bBetweenTurns:= false;

                NewTurnTick:= GameTicks + 1

                end;

            step:= Low(step)

            end;

    end

else if ((GameFlags and gfInfAttack) <> 0) then

    begin

    if delay2 = 0 then

        delay2:= cInactDelay * 50

    else

        begin

        dec(delay2);

        if ((delay2 mod cInactDelay) = 0) and (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil)

        and (not CurrentHedgehog^.Unplaced) then

            begin

            if (CurrentHedgehog^.Gear^.State and gstAttacked <> 0)

            and (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NeedTarget <> 0) then

                begin

                CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstChooseTarget;

                isCursorVisible := true

                end;

            CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State and (not gstAttacked);

            end;

        if delay2 = 0 then

            begin

            if (CurrentHedgehog^.Gear <> nil) and (CurrentHedgehog^.Gear^.State and gstAttacked = 0)

            and (CurAmmoGear = nil) then

                SweepDirty;

            if (CurrentHedgehog^.Gear = nil) or (CurrentHedgehog^.Gear^.State and gstHHDriven = 0) or (CurrentHedgehog^.Gear^.Damage = 0) then

                CheckNoDamage;

            AliveCount:= 0; // shorter version of check for win to allow typical step activity to proceed

            for i:= 0 to Pred(ClansCount) do

                if ClansArray[i]^.ClanHealth > 0 then

                    inc(AliveCount);

            if (AliveCount <= 1) and ((GameFlags and gfOneClanMode) = 0) then

                begin

                step:= stChDmg;

                if TagTurnTimeLeft = 0 then

                    TagTurnTimeLeft:= TurnTimeLeft;

                TurnTimeLeft:= 0

                end

            end

        end

    end;

if TurnTimeLeft > 0 then

    if CurrentHedgehog^.Gear <> nil then

        if (((CurrentHedgehog^.Gear^.State and gstAttacking) = 0)

            or (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_DoesntStopTimerWhileAttacking <> 0))

            and (not(isInMultiShoot and ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_DoesntStopTimerInMultiShoot) <> 0))) then

            //(CurrentHedgehog^.CurAmmoType in [amShotgun, amDEagle, amSniperRifle])

                begin

                if (TurnTimeLeft = 5000)

                and (cHedgehogTurnTime >= 10000)

                and (not PlacingHogs)

                and (CurrentHedgehog^.Gear <> nil)

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

                    PlaySoundV(sndHurry, CurrentTeam^.voicepack);

            if ReadyTimeLeft > 0 then

                begin

                if (ReadyTimeLeft = 2000) and (LastVoice.snd = sndNone) then

                    AddVoice(sndComeonthen, CurrentTeam^.voicepack);

                dec(ReadyTimeLeft)

                end

            else

                dec(TurnTimeLeft)

            end;

if skipFlag then

    begin

    if TagTurnTimeLeft = 0 then

        TagTurnTimeLeft:= TurnTimeLeft;

    TurnTimeLeft:= 0;

    skipFlag:= false;

    inc(CurrentHedgehog^.Team^.stats.TurnSkips);

    end;

if ((GameTicks and $FFFF) = $FFFF) then

    begin

    if (not CurrentTeam^.ExtDriven) then

        begin

        SendIPC(_S'#');

        AddFileLog('hiTicks increment message sent')

        end;

    if (not CurrentTeam^.ExtDriven) or CurrentTeam^.hasGone then

        begin

        AddFileLog('hiTicks increment (current team is local or gone)');

        inc(hiTicks) // we do not recieve a message for this

        end

    end;

AddRandomness(CheckSum);

TurnClockActive:= prevtime <> TurnTimeLeft;

inc(GameTicks)

end;

//Purpose, to reset all transient attributes toggled by a utility and clean up various gears and effects at end of turn

//If any of these are set as permanent toggles in the frontend, that needs to be checked and skipped here.

procedure EndTurnCleanup;

var  i: LongInt;