(*

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

    Density: real;

    skip, matters, dead: boolean;

    Kind: TGearType;

    end;

TTargets = record

    Count: Longword;

    ar: array[0..Pred(256)] 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  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(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;

    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;

    Gear: PGear;

begin

Targets.Count:= 0;

Targets.reset:= false;

f:= 0;

e:= 0;

Gear:= GearsList;

while Gear <> nil do

    begin

    if  ((Gear^.Kind = gtHedgehog) and

            (Gear <> ThinkingHH) and

            (Gear^.Health > Gear^.Damage) and

            not(Gear^.Hedgehog^.Team^.hasgone)) or

        ((Gear^.Kind = gtExplosives) and

            (Gear^.Health > Gear^.Damage)) or

        ((Gear^.Kind = gtMine) and

            ((Gear^.Health = 0) and

             (Gear^.Damage < 35)) or

            ((Gear^.Health > 0) and 

             (cMineDudPercent > 95) and

             (cMinesTime < 3000)) 

             ) and

        (Targets.Count < 256) then

        begin

        with Targets.ar[Targets.Count] do

            begin

            skip:= false;

            dead:= false;

            Kind:= Gear^.Kind;

            matters:= (Gear^.AIHints and aihDoesntMatter) = 0;

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

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

            if (Gear^.Kind = gtHedgehog) then

                begin

                if (Gear^.Hedgehog^.Team^.Clan = CurrentTeam^.Clan) then

                    begin

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

                    inc(f)

                    end

                else 

                    begin

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

                    inc(e)

                    end;

                Density:= 1;

                end

            else if Gear^.Kind = gtExplosives then

                begin

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

                Density:= 2

                end

            else if Gear^.Kind = gtMine then 

                begin

                Score:= max(0,35-Gear^.Damage);

                Density:= 1/3

                end

            end;

        inc(Targets.Count)

        end;

    Gear:= Gear^.NextGear

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

       exit(true);

    TestCollWithEverything := false;

end;

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

       exit(true);

    TestCollExcludingObjects:= false;

end;

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

       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; Kind: TGearType): LongInt;

var skipLandCheck: boolean;

    dmg, radius: 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

    if Kind = gtHedgehog then 

        radius:= cHHRadius

    else if Kind = gtExplosives then

        radius:= 16

    else if Kind = gtMine then

        radius:= 2;

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

            begin

            if (Kind = gtHedgehog) and (0.4 < dY) then

                begin

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

                if dmg >= 1 then exit(dmg)

                end

            else 

                begin

// so we don't know at present if a barrel is already rolling.  Would need to add that to target info I guess

                    begin

                    end

                end;

            exit(0)

            end;

        end

end;

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

var dmg, radius: LongInt;

begin

//v:= random($FFFFFFFF);

    if Kind = gtHedgehog then 

        radius:= cHHRadius

    else if Kind = gtExplosives then

        radius:= 16

    else if Kind = gtMine then

        radius:= 2;

    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 (Kind = gtHedgehog) and (0.4 < dY) then

                begin

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

                if dmg >= 1 then

                    exit(dmg);

                end

            else 

                begin

// so we don't know at present if a barrel is already rolling.  Would need to add that to target info I guess

                    begin

                    end

                end;

            exit(0)

        end;

            // 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, subrate, erasure: LongInt;

    pX, pY, dX, dY: real;