(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2012 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 uAIMisc;

interface

uses SDLh, uConsts, uFloat, uTypes;

const MAXBONUS = 1024;

      afTrackFall  = $00000001;

      afErasesLand = $00000002;

      afSetSkip    = $00000004;

      BadTurn = Low(LongInt) div 4;

type TTarget = record

    Point: TPoint;

    Score: LongInt;

    skip, matters, dead: boolean;

    end;

TTargets = record

    Count: Longword;

    ar: array[0..Pred(cMaxHHs)] of TTarget;

    reset: boolean;

    end;

TJumpType = (jmpNone, jmpHJump, jmpLJump);

TGoInfo = record

    Ticks: Longword;

    FallPix: Longword;

    JumpType: TJumpType;

    end;

TBonus = record

    X, Y: LongInt;

    Radius: LongInt;

    Score: LongInt;

    end;

procedure initModule;

procedure freeModule;

procedure FillTargets;

procedure ResetTargets; inline;

procedure AddBonus(x, y: LongInt; r: Longword; s: LongInt); inline;

procedure FillBonuses(isAfterAttack: boolean);

procedure AwareOfExplosion(x, y, r: LongInt); inline;

function  RatePlace(Gear: PGear): LongInt;

function  TestColl(x, y, r: LongInt): boolean; inline;

function  TestCollExcludingObjects(x, y, r: LongInt): boolean; inline;

function  TestCollExcludingMe(Me: PGear; x, y, r: LongInt): boolean; inline;

function  TraceShoveFall(x, y, dX, dY: Real): LongInt;

function  RateExplosion(Me: PGear; x, y, r: LongInt): LongInt; inline;

function  RateExplosion(Me: PGear; x, y, r: LongInt; Flags: LongWord): LongInt; inline;

function  RealRateExplosion(Me: PGear; x, y, r: LongInt; Flags: LongWord): LongInt;

function  RateShove(x, y, r, power, kick: LongInt; gdX, gdY: real; Flags: LongWord): LongInt;

function  RateShotgun(Me: PGear; gdX, gdY: real; x, y: LongInt): LongInt; inline;

function  RealRateShotgun(Me: PGear; gdX, gdY: real; x, y: LongInt): LongInt;

function  RateHammer(Me: PGear): LongInt;

function  HHGo(Gear, AltGear: PGear; var GoInfo: TGoInfo): boolean;

function  AIrndSign(num: LongInt): LongInt;

var ThinkingHH: PGear;

    Targets: TTargets;

    bonuses: record

        Count: Longword;

        ar: array[0..Pred(MAXBONUS)] of TBonus;

        end;

    walkbonuses: record

        Count: Longword;

        ar: array[0..Pred(MAXBONUS div 8)] of TBonus;  // don't use too many

        end;

const KillScore = 200;

var friendlyfactor: LongInt = 300;

var dmgMod: real = 1.0;

implementation

uses uCollisions, uVariables, uUtils, uLandTexture, uGearsUtils;

var

    KnownExplosion: record

        X, Y, Radius: LongInt

        end = (X: 0; Y: 0; Radius: 0);

procedure ResetTargets; inline;

var i: LongWord;

begin

if Targets.reset then

    for i:= 0 to Targets.Count do

        Targets.ar[i].dead:= false;

Targets.reset:= false;

end;

procedure FillTargets;

var i, t: Longword;

    f, e: LongInt;

begin

Targets.Count:= 0;

Targets.reset:= false;

f:= 0;

e:= 0;

for t:= 0 to Pred(TeamsCount) do

    with TeamsArray[t]^ do

        if not hasGone then

            begin

            for i:= 0 to cMaxHHIndex do

                if (Hedgehogs[i].Gear <> nil)

                and (Hedgehogs[i].Gear <> ThinkingHH)

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

                    then

                    begin

                    with Targets.ar[Targets.Count], Hedgehogs[i] do

                        begin

                        skip:= false;

                        dead:= false;

                        matters:= (Hedgehogs[i].Gear^.AIHints and aihDoesntMatter) = 0;

                        Point.X:= hwRound(Gear^.X);

                        Point.Y:= hwRound(Gear^.Y);

                        if Clan <> CurrentTeam^.Clan then

                            begin

                            Score:= Gear^.Health - Gear^.Damage;

                            inc(e)

                            end else

                            begin

                            Score:= Gear^.Damage - Gear^.Health;

                            inc(f)

                            end

                        end;

                    inc(Targets.Count)

                    end;

            end;

if e > f then friendlyfactor:= 300 + (e - f) * 30

else friendlyfactor:= max(30, 300 - f * 80 div max(1,e))

end;

procedure AddBonus(x, y: LongInt; r: Longword; s: LongInt); inline;

begin

if(bonuses.Count < MAXBONUS) then

    begin

    bonuses.ar[bonuses.Count].x:= x;

    bonuses.ar[bonuses.Count].y:= y;

    bonuses.ar[bonuses.Count].Radius:= r;

    bonuses.ar[bonuses.Count].Score:= s;

    inc(bonuses.Count);

    end;

end;

procedure AddWalkBonus(x, y: LongInt; r: Longword; s: LongInt); inline;

begin

if(walkbonuses.Count < MAXBONUS div 8) then

    begin

    walkbonuses.ar[walkbonuses.Count].x:= x;

    walkbonuses.ar[walkbonuses.Count].y:= y;

    walkbonuses.ar[walkbonuses.Count].Radius:= r;

    walkbonuses.ar[walkbonuses.Count].Score:= s;

    inc(walkbonuses.Count);

    end;

end;

procedure FillBonuses(isAfterAttack: boolean);

var Gear: PGear;

    MyClan: PClan;

    i: Longint;

begin

bonuses.Count:= 0;

MyClan:= ThinkingHH^.Hedgehog^.Team^.Clan;

Gear:= GearsList;

while Gear <> nil do

    begin

        case Gear^.Kind of

            gtCase:

                AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y) + 3, 37, 25);

            gtFlame:

                if (Gear^.State and gsttmpFlag) <> 0 then

                    AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 20, -50);

// avoid mines unless they are very likely to be duds, or are duds. also avoid if they are about to blow

            gtMine:

                if ((Gear^.State and gstAttacking) = 0) and (((cMineDudPercent < 90) and (Gear^.Health <> 0))

                or (isAfterAttack and (Gear^.Health = 0) and (Gear^.Damage > 30))) then

                    AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 50, -50)

                else if (Gear^.State and gstAttacking) <> 0 then

                    AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, -50); // mine is on

            gtExplosives:

            if isAfterAttack then

                AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 75, -60 + Gear^.Health);

            gtSMine:

                AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 50, -30);

            gtDynamite:

                AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -75);

            gtHedgehog:

                begin

                if Gear^.Damage >= Gear^.Health then

                    AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 60, -25)

                else

                    if isAfterAttack

                      and (ThinkingHH^.Hedgehog <> Gear^.Hedgehog)

                      and ((hwAbs(Gear^.dX) + hwAbs(Gear^.dY)) < _0_1) then

                        if (ClansCount > 2) or (MyClan = Gear^.Hedgehog^.Team^.Clan) then

                            AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -3) // hedgehog-friend

                        else

                            AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, 3)

                end;

            end;

    Gear:= Gear^.NextGear

    end;

if isAfterAttack and (KnownExplosion.Radius > 0) then

    with KnownExplosion do

        AddBonus(X, Y, Radius + 10, -Radius);

if isAfterAttack then

    begin

    for i:= 0 to Pred(walkbonuses.Count) do

        with walkbonuses.ar[i] do

            AddBonus(X, Y, Radius, Score);

    walkbonuses.Count:= 0

    end;

end;

procedure AwareOfExplosion(x, y, r: LongInt); inline;

begin

    KnownExplosion.X:= x;

    KnownExplosion.Y:= y;

    KnownExplosion.Radius:= r

end;

function RatePlace(Gear: PGear): LongInt;

var i, r: LongInt;

    rate: LongInt;

    gX, gY: real;

begin

gX:= hwFloat2Float(Gear^.X);

gY:= hwFloat2Float(Gear^.Y);

rate:= 0;

for i:= 0 to Pred(bonuses.Count) do

    with bonuses.ar[i] do

        begin

        r:= Radius;

        if abs(gX-X)+abs(gY-Y) < Radius then

            r:= trunc(sqrt(sqr(gX - X)+sqr(gY - Y)));

        if r < 20 then

                inc(rate, Score * Radius)

        else if r < Radius then

                inc(rate, Score * (Radius - r))

        end;

    RatePlace:= rate;

end;

function CheckBounds(x, y, r: Longint): boolean; inline;

begin

    CheckBounds := (((x-r) and LAND_WIDTH_MASK) = 0) and

        (((x+r) and LAND_WIDTH_MASK) = 0) and

        (((y-r) and LAND_HEIGHT_MASK) = 0) and

        (((y+r) and LAND_HEIGHT_MASK) = 0);

end;

function TestCollWithEverything(x, y, r: LongInt): boolean; inline;

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (Land[y-r, x-r] <> 0) or

       (Land[y+r, x-r] <> 0) or

       (Land[y-r, x+r] <> 0) or

       (Land[y+r, x+r] <> 0) then

       exit(true);

    TestCollWithEverything := false;

end;

function TestCollExcludingObjects(x, y, r: LongInt): boolean; inline;

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (Land[y-r, x-r] > lfAllObjMask) or

       (Land[y+r, x-r] > lfAllObjMask) or

       (Land[y-r, x+r] > lfAllObjMask) or

       (Land[y+r, x+r] > lfAllObjMask) then

       exit(true);

    TestCollExcludingObjects:= false;

end;

function TestColl(x, y, r: LongInt): boolean; inline;

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (Land[y-r, x-r] and lfNotCurrentMask <> 0) or

       (Land[y+r, x-r] and lfNotCurrentMask <> 0) or

       (Land[y-r, x+r] and lfNotCurrentMask <> 0) or

       (Land[y+r, x+r] and lfNotCurrentMask <> 0) then

       exit(true);

    TestColl:= false;

end;

// Wrapper to test various approaches.  If it works reasonably, will just replace.

// Right now, converting to hwFloat is a tad inefficient since the x/y were hwFloat to begin with...

function TestCollExcludingMe(Me: PGear; x, y, r: LongInt): boolean; inline;

var MeX, MeY: LongInt;

begin

    if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then

    begin

        MeX:= hwRound(Me^.X);

        MeY:= hwRound(Me^.Y);

        // We are still inside the hog. Skip radius test

        if ((sqr(x-MeX) + sqr(y-MeY)) < 256) and (Land[y, x] and lfObjMask = 0) then

            exit(false);

    end;

    TestCollExcludingMe:= TestCollWithEverything(x, y, r)

end;

function TraceFall(eX, eY: LongInt; var x, y: Real; dX, dY: Real; r: LongWord): LongInt;

var skipLandCheck: boolean;

    rCorner: real;

    dmg: LongInt;

begin

    skipLandCheck:= true;

    if x - eX < 0 then dX:= -dX;

    if y - eY < 0 then dY:= -dY;

    // ok. attempt approximate search for an unbroken trajectory into water.  if it continues far enough, assume out of map

    rCorner:= r * 0.75;

    while true do

    begin

        x:= x + dX;

        y:= y + dY;

        dY:= dY + cGravityf;

        skipLandCheck:= skipLandCheck and (r <> 0) and (abs(eX-x) + abs(eY-y) < r) and ((abs(eX-x) < rCorner) or (abs(eY-y) < rCorner));

        if not skipLandCheck and TestCollExcludingObjects(trunc(x), trunc(y), cHHRadius) then

        begin

            if 0.4 < dY then

            begin

                dmg := 1 + trunc((abs(dY) - 0.4) * 70);

                if dmg >= 1 then

                    exit(dmg);

            end;

            exit(0)

        end;

        if (y > cWaterLine) or (x > 4096) or (x < 0) then

            exit(-1);

    end;

end;

function TraceShoveFall(x, y, dX, dY: Real): LongInt;

var dmg: LongInt;

begin

//v:= random($FFFFFFFF);

    while true do

    begin

        x:= x + dX;

        y:= y + dY;

        dY:= dY + cGravityf;

{        if ((trunc(y) and LAND_HEIGHT_MASK) = 0) and ((trunc(x) and LAND_WIDTH_MASK) = 0) then

            begin

            LandPixels[trunc(y), trunc(x)]:= v;

            UpdateLandTexture(trunc(X), 1, trunc(Y), 1, true);

            end;}

        // consider adding dX/dY calc here for fall damage

        if TestCollExcludingObjects(trunc(x), trunc(y), cHHRadius) then

        begin

            if 0.4 < dY then

            begin

                dmg := 1 + trunc((abs(dY) - 0.4) * 70);

                if dmg >= 1 then

                    exit(dmg);

            end;

            exit(0)

        end;

        if (y > cWaterLine) or (x > 4096) or (x < 0) then

            // returning -1 for drowning so it can be considered in the Rate routine

            exit(-1)

    end;

end;

function RateExplosion(Me: PGear; x, y, r: LongInt): LongInt; inline;

begin

    RateExplosion:= RealRateExplosion(Me, x, y, r, 0);

    ResetTargets;

end;

function RateExplosion(Me: PGear; x, y, r: LongInt; Flags: LongWord): LongInt; inline;

begin

    RateExplosion:= RealRateExplosion(Me, x, y, r, Flags);

    ResetTargets;

end;

function RealRateExplosion(Me: PGear; x, y, r: LongInt; Flags: LongWord): LongInt;

var i, fallDmg, dmg, dmgBase, rate, erasure: LongInt;

    pX, pY, dX, dY: real;

    hadSkips: boolean;

begin

fallDmg:= 0;

rate:= 0;

// add our virtual position

with Targets.ar[Targets.Count] do

    begin

    Point.x:= hwRound(Me^.X);

    Point.y:= hwRound(Me^.Y);

    skip:= false;

    matters:= true;

    Score:= - ThinkingHH^.Health

    end;

// rate explosion

dmgBase:= r + cHHRadius div 2;

if (Flags and afErasesLand <> 0) and (GameFlags and gfSolidLand = 0) then erasure:= r

else erasure:= 0;

hadSkips:= false;

for i:= 0 to Targets.Count do

    if not Targets.ar[i].dead then

        with Targets.ar[i] do

          if not matters then hadSkips:= true

            else

            begin

            dmg:= 0;

            if abs(Point.x - x) + abs(Point.y - y) < dmgBase then

                dmg:= trunc(dmgMod * min((dmgBase - trunc(sqrt(sqr(Point.x - x)+sqr(Point.y - y)))) div 2, r));

            if dmg > 0 then

                begin

                pX:= Point.x;

                pY:= Point.y;

                if (Flags and afTrackFall <> 0) and (dmg < abs(Score)) then

                    begin

                    dX:= 0.005 * dmg + 0.01;

                    dY:= dX;

                    if (x and LAND_WIDTH_MASK = 0) and ((y+cHHRadius+2) and LAND_HEIGHT_MASK = 0) and

                       (Land[y+cHHRadius+2, x] and lfIndestructible <> 0) then

                         fallDmg:= trunc(TraceFall(x, y, pX, pY, dX, dY, 0) * dmgMod)

                    else fallDmg:= trunc(TraceFall(x, y, pX, pY, dX, dY, erasure) * dmgMod)

                    end;

                if fallDmg < 0 then // drowning. score healthier hogs higher, since their death is more likely to benefit the AI

                    if Score > 0 then

                        inc(rate, (KillScore + Score div 10) * 1024)   // Add a bit of a bonus for bigger hog drownings

                    else

                        dec(rate, (KillScore * friendlyfactor div 100 - Score div 10) * 1024) // and more of a punishment for drowning bigger friendly hogs

                else if (dmg+fallDmg) >= abs(Score) then

                    begin

                    dead:= true;

                    Targets.reset:= true;

                    if dX < 0.035 then

                        inc(Rate,RealRateExplosion(Me, round(pX), round(pY), 61, afErasesLand or (Flags and afTrackFall)));

                    if Score > 0 then

                        inc(rate, KillScore * 1024 + (dmg + fallDmg)) // tiny bonus for dealing more damage than needed to kill

                    else

                        dec(rate, KillScore * friendlyfactor div 100 * 1024)

                    end