(*

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

type TTarget = record

    Point: TPoint;

    Score: LongInt;

    skip: boolean;

    end;

TTargets = record

    Count: Longword;

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

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

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

function  RateShotgun(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;

implementation

const KillScore = 200;

var friendlyfactor: LongInt = 300;

    KnownExplosion: record

        X, Y, Radius: LongInt

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

procedure FillTargets;

var i, t: Longword;

    f, e: LongInt;

begin

Targets.Count:= 0;

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

                    begin

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

                        begin

                        skip:= false;

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

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

                        if Clan <> CurrentTeam^.Clan then

                            begin

                            Score:=  Gear^.Health;

                            inc(e)

                            end else

                            begin

                            Score:= -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 FillBonuses(isAfterAttack: boolean);

var Gear: PGear;

    MyClan: PClan;

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

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;

// 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 ((((x-MeX)*(x-MeX)) + ((y-MeY)*(y-MeY))) < 256) and ((Land[y, x] and $FF00) = 0) then

            exit(false);

    end;

    TestCollExcludingMe:= TestColl(x, y, r)

end;

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

var b: boolean;

begin

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x-r] and $FF00 <> 0);

    if b then

        exit(true);

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x-r] and $FF00 <> 0);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x+r] and $FF00 <> 0);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x+r] and $FF00 <> 0);

    if b then

        exit(true);

    TestCollExcludingObjects:= false;

end;

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

var b: boolean;

begin

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x-r] <> 0);

    if b then

        exit(true);

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x-r] <> 0);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x+r] <> 0);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x+r] <> 0);

    if b then

        exit(true);

    TestColl:= false;

end;

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

var b: boolean;

begin

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x-r] > 255);

    if b then

        exit(true);

    b:= (((x-r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x-r] > 255);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y-r) and LAND_HEIGHT_MASK) = 0) and (Land[y-r, x+r] > 255);

    if b then

        exit(true);

    b:= (((x+r) and LAND_WIDTH_MASK) = 0) and (((y+r) and LAND_HEIGHT_MASK) = 0) and (Land[y+r, x+r] > 255);

    if b then

        exit(true);

    TestCollWithLand:= false;

end;

function TraceFall(eX, eY: LongInt; x, y, 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 TestCollWithLand(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;

begin

    while true do

    begin

        x:= x + dX;

        y:= y + dY;

        dY:= dY + cGravityf;

        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;

begin

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

end;

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

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

    dX, dY, dmgMod: real;

begin

fallDmg:= 0;

dmgMod:= 0.01 * hwFloat2Float(cDamageModifier) * cDamagePercent;

rate:= 0;

// add our virtual position

with Targets.ar[Targets.Count] do

    begin

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

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

    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;

for i:= 0 to Targets.Count do

    with Targets.ar[i] do

        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

            if Flags and afTrackFall <> 0 then

                begin

                dX:= 0.005 * dmg + 0.01;

                dY:= dX;

                fallDmg:= trunc(TraceFall(x, y, Point.x, Point.y, 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)   // Add a bit of a bonus for bigger hog drownings

                else

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

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

                if Score > 0 then

                    inc(rate, KillScore)

                else

                    dec(rate, KillScore * friendlyfactor div 100)

            else

                if Score > 0 then

                    inc(rate, dmg+fallDmg)

                else dec(rate, (dmg+fallDmg) * friendlyfactor div 100)

            end;

        end;

RateExplosion:= rate * 1024;

end;

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

var i, fallDmg, dmg, rate: LongInt;

    dX, dY, dmgMod: real;

begin

fallDmg:= 0;

dmgMod:= 0.01 * hwFloat2Float(cDamageModifier) * cDamagePercent;

rate:= 0;

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

    with Targets.ar[i] do

      if skip then 

        if (Flags and afSetSkip = 0) then skip:= false else {still skip}

      else  

        begin

        dmg:= 0;

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

            dmg:= r - trunc(sqrt(sqr(Point.x - x)+sqr(Point.y - y)));

        if dmg > 0 then

            begin

            if (Flags and afSetSkip <> 0) then skip:= true;

            if (Flags and afTrackFall <> 0) then 

                fallDmg:= trunc(TraceShoveFall(Point.x, Point.y - 2, dX, dY) * dmgMod);

            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)   // Add a bit of a bonus for bigger hog drownings

                else

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

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

                if Score > 0 then

                    inc(rate, KillScore)

                else

                    dec(rate, KillScore * friendlyfactor div 100)

            else

                if Score > 0 then

                    inc(rate, power+fallDmg)

                else

                    dec(rate, (power+fallDmg) * friendlyfactor div 100)

            end;

        end;

RateShove:= rate * 1024

end;

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

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

    dX, dY, dmgMod: real;

begin

dmgMod:= 0.01 * hwFloat2Float(cDamageModifier) * cDamagePercent;

rate:= 0;

gdX:= gdX * 0.01;

gdY:= gdX * 0.01;

// add our virtual position