(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2005-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;

type TTarget = record

    Point: TPoint;

    Score: LongInt;

    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; filter: TGearsType = []);

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

function RatePlace(Gear: PGear): LongInt;

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

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

function TraceShoveDrown(Me: PGear; x, y, dX, dY: Real): boolean;

function RateExplosion(Me: PGear; x, y, r: LongInt; Flags: LongWord = 0): 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

uses uCollisions, uVariables, uUtils, uDebug;

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

                        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

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

TryDo(bonuses.Count <= MAXBONUS, 'Bonuses overflow', true)

end;

procedure FillBonuses(isAfterAttack: boolean; filter: TGearsType);

var Gear: PGear;

    MyClan: PClan;

begin

bonuses.Count:= 0;

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

Gear:= GearsList;

while Gear <> nil do

    begin

    if (filter = []) or (Gear^.Kind in filter) then

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

begin

KnownExplosion.X:= x;

KnownExplosion.Y:= y;

KnownExplosion.Radius:= r

end;

function RatePlace(Gear: PGear): LongInt;

var i, r: LongInt;

    rate: LongInt;

begin

rate:= 0;

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

    with bonuses.ar[i] do

        begin

        r:= hwRound(Distance(Gear^.X - int2hwFloat(X), Gear^.Y - int2hwFloat(Y)));

        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;

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;

    exit(TestColl(x, y, r))

end;

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

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

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

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

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

end;

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

var skipLandCheck: boolean;

    rCorner: real;

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

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

        if not skipLandCheck and TestCollWithLand(trunc(x), trunc(y), cHHRadius) then exit(false);

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

        end;

end;

function TraceShoveDrown(Me: PGear; x, y, dX, dY: Real): boolean;

begin

    while true do

        begin

        x:= x + dX;

        y:= y + dY;

        dY:= dY + cGravityf;

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

        if TestCollExcludingMe(Me, trunc(x), trunc(y), cHHRadius) then exit(false);

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

        end;

end;

// Flags are not defined yet but 1 for checking drowning and 2 for assuming land erasure.

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

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

    dX, dY, dmgMod: real;

begin

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 2 <> 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 1 <> 0 then

                begin

                dX:= 0.005 * dmg + 0.01;

                dY:= dX;

                end;

            if (Flags and 1 <> 0) and TraceDrown(x, y, Point.x, Point.y, dX, dY, erasure) then

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

            else

                dec(rate, dmg * 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, dmg, rate: LongInt;

    dX, dY, dmgMod: real;

begin

dX:= gdX * 0.005 * kick;

dY:= gdY * 0.005 * kick;

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

Me:= Me; // avoid compiler hint

rate:= 0;

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

    with Targets.ar[i] do

        begin

        dmg:= 0;

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

            begin

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

            dmg:= trunc(dmg * dmgMod);

            end;

        if dmg > 0 then

            begin

            if (Flags and 1 <> 0) and TraceShoveDrown(Me, Point.x, Point.y, dX, dY) then

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

                else

                    dec(rate, power * friendlyfactor div 100)

            end;

        end;

RateShove:= rate * 1024

end;

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

var i, dmg, 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

with Targets.ar[Targets.Count] do

    begin

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

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

    Score:= - ThinkingHH^.Health

    end;

// rate shot

baseDmg:= cHHRadius + cShotgunRadius + 4;

if GameFlags and gfSolidLand = 0 then erasure:= cShotgunRadius

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

            begin

            dmg:= min(baseDmg - trunc(sqrt(sqr(Point.x - x)+sqr(Point.y - y))), 25);

            dmg:= trunc(dmg * dmgMod);

            end;

        if dmg > 0 then

            begin

            dX:= gdX * dmg;

            dY:= gdY * dmg;

            if dX < 0 then dX:= dX - 0.01

            else dX:= dX + 0.01;

            if TraceDrown(x, y, Point.x, Point.y, dX, dY, erasure) then

                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 >= abs(Score) then

                dmg := KillScore;

            if Score > 0 then

                inc(rate, dmg)

            else

                dec(rate, dmg * friendlyfactor div 100);

            end;

        end;        

RateShotgun:= rate * 1024;

end;

function RateHammer(Me: PGear): LongInt;

var x, y, i, r, rate: LongInt;

begin

// hammer hit shift against attecker hog is 10

x:= hwRound(Me^.X) + hwSign(Me^.dX) * 10;

y:= hwRound(Me^.Y);

rate:= 0;

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

    with Targets.ar[i] do

        begin

         // hammer hit radius is 8, shift is 10

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

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

        if r <= 18 then

            if Score > 0 then 

                inc(rate, Score div 3)

            else 

                inc(rate, Score div 3 * friendlyfactor div 100)

        end;

RateHammer:= rate * 1024;

end;

function HHJump(Gear: PGear; JumpType: TJumpType; var GoInfo: TGoInfo): boolean;

var bX, bY: LongInt;

    bRes: boolean;

begin

bRes:= false;

GoInfo.Ticks:= 0;

GoInfo.JumpType:= jmpNone;

bX:= hwRound(Gear^.X);

bY:= hwRound(Gear^.Y);

case JumpType of

    jmpNone:

    exit(bRes);

    jmpHJump:

    if TestCollisionYwithGear(Gear, -1) = 0 then

        begin

        Gear^.dY:= -_0_2;

        SetLittle(Gear^.dX);

        Gear^.State:= Gear^.State or gstMoving or gstHHJumping;

        end

    else

        exit(bRes);

    jmpLJump:

    begin