(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

 *)

{$INCLUDE "options.inc"}

unit uAIMisc;

interface

uses SDLh, uConsts, uFloat, uTypes;

const MAXBONUS = 1024;

      afTrackFall  = $00000001;

      afErasesLand = $00000002;

      afSetSkip    = $00000004;

      afIgnoreMe   = $00000008;

      BadTurn = Low(LongInt) div 4;

type TTarget = record // starting to look more and more like a gear

    Point: TPoint;

    Score, Radius: LongInt;

    State: LongWord;

    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;

TBonuses = record

          activity: boolean;

          Count : LongInt;

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

       end;

Twalkbonuses =  record

        Count: Longword;

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

        end;

procedure initModule;

procedure freeModule;

procedure FillTargets;

procedure ResetTargets;

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

procedure FillBonuses(isAfterAttack: boolean);

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

function  RatePlace(Gear: PGear): LongInt;

function  CheckWrap(x: real): real;

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

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

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

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

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

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

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  RateSeduction(Me: PGear): LongInt;

function  RateResurrector(Me: PGear): LongInt;

function  RateHammer(Me: PGear): LongInt;

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

function  AIrndSign(num: LongInt): LongInt;

function  AIrndOffset(targ: TTarget; Level: LongWord): LongInt;

var ThinkingHH: PGear;

    Targets: TTargets;

    bonuses: TBonuses;

    walkbonuses: Twalkbonuses;

const KillScore = 200;

      ResurrectScore = 100;

var friendlyfactor: LongInt = 300;

var dmgMod: real = 1.0;

implementation

uses uCollisions, uVariables, uUtils, uGearsUtils, uAIAmmoTests, uLandUtils;

var

    KnownExplosion: record

        X, Y, Radius: LongInt

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

procedure ResetTargets;

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

            (Gear^.Health = 0)) or

        ((Gear^.Kind = gtExplosives) and

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

        ((Gear^.Kind = gtMine) and

            (Gear^.Health = 0) and

             (Gear^.Damage < 35))

             )  and

        (Targets.Count < 256) then

        begin

        with Targets.ar[Targets.Count] do

            begin

            skip:= false;

            dead:= false;

            Kind:= Gear^.Kind;

            Radius:= Gear^.Radius;

            Density:= hwFloat2Float(Gear^.Density)/3;

            State:= Gear^.State;

            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;

                end

            else if Gear^.Kind = gtGrave then

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

                    begin

                    Score:= ResurrectScore;

                    inc(f);

                    end

                else

                    begin

                    Score:= -ResurrectScore;

                    inc(e);

                    end

            else if Gear^.Kind = gtExplosives then

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

            else if Gear^.Kind = gtMine then

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

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

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

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;

bonuses.activity:= false;

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

Gear:= GearsList;

while Gear <> nil do

    begin

        case Gear^.Kind of

            gtAirAttack

            , gtAirBomb

            , gtBall

            , gtBee

            , gtBirdy

            , gtClusterBomb

            , gtCake

            , gtCluster

            , gtDrill

            , gtEgg

            , gtGasBomb

            , gtGrenade

            , gtHellishBomb

            , gtPiano

            , gtPoisonCloud

            , gtRCPlane

            , gtMelonPiece

            , gtMolotov

            , gtMortar

            , gtNapalmBomb

            , gtShell

            , gtSnowball

            , gtWatermelon: bonuses.activity:= true;

            gtCase:

                if (Gear^.AIHints and aihDoesntMatter) = 0 then

                    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: begin

                if (Gear^.State and gstMoving) <> 0 then bonuses.activity:= true;

                if ((Gear^.State and gstAttacking) = 0) and (((cMineDudPercent < 90) or ((Gear^.State and gstWait) <> 0) 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

                end;

            gtAirMine: if ((Gear^.State and gstFrozen) = 0) then AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), gear^.Angle+5, -30);

            gtExplosives:

                begin

                //if (Gear^.State and gstMoving) <> 0 then bonuses.activity:= true;

                if isAfterAttack then

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

                end;

            gtSMine: begin

                if (Gear^.State and (gstMoving or gstAttacking)) <> 0 then bonuses.activity:= true;

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

                end;

            gtDynamite:

                begin

                bonuses.activity:= true;

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

                end;

            gtHedgehog:

                begin

                if (ThinkingHH <> Gear)

                    and (((Gear^.State and (gstMoving or gstDrowning or gstHHDeath)) <> 0)

                        or (Gear^.Health = 0)

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

                    then begin

                    bonuses.activity:= true;

                    end;

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

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 CheckWrap(x: real): real;

begin

    if WorldEdge = weWrap then

        if (x < leftX) then

             x:= x + (rightX - leftX)

        else if x > rightX then

             x:= x - (rightX - leftX);

    CheckWrap:= x;

end;

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

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;

// Check for collision with anything

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (LandGet(y-r, x-r) <> 0) or

       (LandGet(y+r, x-r) <> 0) or

       (LandGet(y-r, x+r) <> 0) or

       (LandGet(y+r, x+r) <> 0) then

       exit(true);

    TestCollWithEverything := false;

end;

// Check for collision with non-objects

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (LandGet(y-r, x-r) > lfAllObjMask) or

       (LandGet(y+r, x-r) > lfAllObjMask) or

       (LandGet(y-r, x+r) > lfAllObjMask) or

       (LandGet(y+r, x+r) > lfAllObjMask) then

       exit(true);

    TestCollExcludingObjects:= false;

end;

// Check for collision with something other than current hedgehog or crate

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (LandGet(y-r, x-r) and lfNotCurHogCrate <> 0) or

       (LandGet(y+r, x-r) and lfNotCurHogCrate <> 0) or

       (LandGet(y-r, x+r) and lfNotCurHogCrate <> 0) or

       (LandGet(y+r, x+r) and lfNotCurHogCrate <> 0) then

       exit(true);

    TestColl:= false;

end;

// Check for collision with hedgehog or object

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

begin

    if not CheckBounds(x, y, r) then

        exit(false);

    if (LandGet(y-r, x-r) and lfAllObjMask <> 0) or

       (LandGet(y+r, x-r) and lfAllObjMask <> 0) or

       (LandGet(y-r, x+r) and lfAllObjMask <> 0) or

       (LandGet(y+r, x+r) and lfAllObjMask <> 0) then

       exit(true);

    TestCollHogsOrObjects:= false;

end;

// Check for collision with something other than the given "Me" gear.

// 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 ((sqr(x-MeX) + sqr(y-MeY)) < 256) and (LandGet(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; Target: TTarget): LongInt;

var skipLandCheck: boolean;

    rCorner, dxdy, odX, odY: real;

    dmg: LongInt;

begin

    odX:= dX;

    odY:= dY;

    skipLandCheck:= true;

    // 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:= CheckWrap(x);

        x:= x + dX;

        y:= y + dY;

        dY:= dY + aiGravityf;