(*

 * 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  TraceShoveFall(x, y, dX, dY: Real; Kind: TGearType): 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(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;

begin

Targets.Count:= 0;

Targets.reset:= false;

f:= 0;

e:= 0;

    begin

        (Targets.Count < 256) then

        begin

        with Targets.ar[Targets.Count] do

            begin

            skip:= false;

            dead:= false;

                begin

                    begin

                    inc(f)

                    end

                else 

                    begin

                    inc(e)

                    end;

                Density:= 1;

                end

                begin

                Density:= 2

                end

                begin

                Density:= 1/3

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

var skipLandCheck: boolean;

    rCorner: real;

    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

// so. the problem w/ explosives is it only uses dX or dY depending on impact, and we don't know which we hit.  Maybe we didn't even hit, given TestColl check corners.

            else 

                begin

                if ((dY > 0.2) and (Land[trunc(y)+radius, trunc(x)] > lfAllObjMask)) or 

                   ((dY < -0.2) and (Land[trunc(y)-radius, trunc(x)] > lfAllObjMask)) then

                    begin

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

                    if dmg >= 1 then exit(dmg)

                    end

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

                else if ((Kind = gtMine) or (abs(dX) > 0.15) or ((abs(dY) > 0.15) and  (abs(dX) > 0.02))) and

                        (((dX > 0.2) and (Land[trunc(y), trunc(x)+radius] > lfAllObjMask)) or 

                         ((dX < -0.2) and (Land[trunc(y), trunc(x)-radius] > lfAllObjMask))) then

                    begin

                    dmg := 1 + trunc(abs(dX) * 70);

                    if dmg >= 1 then exit(dmg)

                    end

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