(*

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

interface

uses uConsts, uFloat, uTypes, uAIMisc;

const

    amtest_Rare            = $00000001; // check only several positions

    amtest_NoTarget        = $00000002; // each pos, but no targetting

    amtest_MultipleAttacks = $00000004; // test could result in multiple attacks, set AttacksNum

    amtest_NoTrackFall     = $00000008; // skip fall tracing.  

var windSpeed: real;

type TAttackParams = record

        Time, Bounce, AttacksNum: Longword;

        Angle, Power: LongInt;

        ExplX, ExplY, ExplR: LongInt;

        AttackPutX, AttackPutY: LongInt;

        end;

function TestBazooka(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestBee(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestSnowball(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestGrenade(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestMolotov(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestClusterBomb(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestWatermelon(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestDrillRocket(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestRCPlane(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestMortar(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestShotgun(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestDesertEagle(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestSniperRifle(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestBaseballBat(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestFirePunch(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestWhip(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestKamikaze(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestAirAttack(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestDrillStrike(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestMineStrike(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestPiano(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestTeleport(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestHammer(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestCake(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestDynamite(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

function TestMine(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

type TAmmoTestProc = function (Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

    TAmmoTest = record

            proc: TAmmoTestProc;

            flags: Longword;

            end;

const AmmoTests: array[TAmmoType] of TAmmoTest =

            (

            (proc: nil;              flags: 0), // amNothing

            (proc: @TestGrenade;     flags: 0), // amGrenade

            (proc: @TestClusterBomb; flags: 0), // amClusterBomb

            (proc: @TestBazooka;     flags: 0), // amBazooka

            (proc: @TestBee;         flags: amtest_Rare), // amBee

            (proc: @TestShotgun;     flags: 0), // amShotgun

            (proc: nil;              flags: 0), // amPickHammer

            (proc: nil;              flags: 0), // amSkip

            (proc: nil;              flags: 0), // amRope

            (proc: @TestMine;        flags: amtest_NoTarget), // amMine

            (proc: @TestDesertEagle; flags: amtest_MultipleAttacks), // amDEagle

            (proc: @TestDynamite;    flags: amtest_NoTarget), // amDynamite

            (proc: @TestFirePunch;   flags: amtest_NoTarget), // amFirePunch

            (proc: @TestWhip;        flags: amtest_NoTarget), // amWhip

            (proc: @TestBaseballBat; flags: amtest_NoTarget), // amBaseballBat

            (proc: nil;              flags: 0), // amParachute

            (proc: @TestAirAttack;   flags: amtest_Rare), // amAirAttack

            (proc: @TestMineStrike;  flags: amtest_Rare), // amMineStrike

            (proc: nil;              flags: 0), // amBlowTorch

            (proc: nil;              flags: 0), // amGirder

            (proc: nil;              flags: 0), // amTeleport

            //(proc: @TestTeleport;    flags: amtest_OnTurn), // amTeleport

            (proc: nil;              flags: 0), // amSwitch

            (proc: @TestMortar;      flags: 0), // amMortar

            (proc: @TestKamikaze;    flags: 0), // amKamikaze

            (proc: @TestCake;        flags: amtest_Rare or amtest_NoTarget), // amCake

            (proc: nil;              flags: 0), // amSeduction

            (proc: @TestWatermelon;  flags: 0), // amWatermelon

            (proc: nil;              flags: 0), // amHellishBomb

            (proc: nil;              flags: 0), // amNapalm

            (proc: @TestDrillRocket; flags: 0), // amDrill

            (proc: nil;              flags: 0), // amBallgun

            (proc: @TestRCPlane;     flags: 0), // amRCPlane

            (proc: nil;              flags: 0), // amLowGravity

            (proc: nil;              flags: 0), // amExtraDamage

            (proc: nil;              flags: 0), // amInvulnerable

            (proc: nil;              flags: 0), // amExtraTime

            (proc: nil;              flags: 0), // amLaserSight

            (proc: nil;              flags: 0), // amVampiric

            (proc: @TestSniperRifle; flags: 0), // amSniperRifle

            (proc: nil;              flags: 0), // amJetpack

            (proc: @TestMolotov;     flags: 0), // amMolotov

            (proc: nil;              flags: 0), // amBirdy

            (proc: nil;              flags: 0), // amPortalGun

            (proc: @TestPiano;       flags: amtest_Rare), // amPiano

            (proc: @TestGrenade;     flags: amtest_NoTrackFall), // amGasBomb

            (proc: @TestShotgun;     flags: 0), // amSineGun

            (proc: nil;              flags: 0), // amFlamethrower

            (proc: @TestGrenade;     flags: 0), // amSMine

            (proc: @TestHammer;      flags: amtest_NoTarget), // amHammer

            (proc: nil;              flags: 0), // amResurrector

            (proc: @TestDrillStrike; flags: amtest_Rare), // amDrillStrike

            (proc: nil;              flags: 0), // amSnowball

            (proc: nil;              flags: 0), // amTardis

            (proc: nil;              flags: 0), // amLandGun

            (proc: nil;              flags: 0), // amIceGun

            (proc: nil;              flags: 0), // amKnife

            (proc: nil;              flags: 0), // amRubber

            (proc: nil;              flags: 0), // amCreeper

            (proc: @TestShotgun;     flags: 0)  // amMinigun

            );

implementation

uses uVariables, uUtils, uGearsHandlers;

function Metric(x1, y1, x2, y2: LongInt): LongInt; inline;

begin

Metric:= abs(x1 - x2) + abs(y1 - y2)

end;

function TestBazooka(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

const cExtraTime = 300;

var Vx, Vy, r, mX, mY: real;

    rTime: LongInt;

    EX, EY: LongInt;

    valueResult: LongInt;

    targXWrap, x, y, dX, dY: real;

    t: LongInt;

    value: LongInt;

begin

Flags:= Flags; // avoid compiler hint

mX:= hwFloat2Float(Me^.X);

mY:= hwFloat2Float(Me^.Y);

ap.Time:= 0;

rTime:= 350;

ap.ExplR:= 0;

if (WorldEdge = weWrap) then

    if (Targ.Point.X < mX) then

         targXWrap:= Targ.Point.X + (RightX-LeftX)

    else targXWrap:= Targ.Point.X - (RightX-LeftX);

valueResult:= BadTurn;

repeat

    rTime:= rTime + 300 + Level * 50 + random(300);

    if (WorldEdge = weWrap) and (random(2)=0) then

         Vx:= - windSpeed * rTime * 0.5 + (targXWrap + AIrndSign(2) + AIrndOffset(Targ, Level) - mX) / rTime

    else Vx:= - windSpeed * rTime * 0.5 + (Targ.Point.X + AIrndSign(2) + AIrndOffset(Targ, Level) - mX) / rTime;

    Vy:= cGravityf * rTime * 0.5 - (Targ.Point.Y + 1 - mY) / rTime;

    r:= sqr(Vx) + sqr(Vy);

    if not (r > 1) then

        begin

        x:= mX;

        y:= mY;

        dX:= Vx;

        dY:= -Vy;

        t:= rTime;

        repeat

            x:= CheckWrap(x);

            x:= x + dX;

            y:= y + dY;

            dX:= dX + windSpeed;

            //dX:= CheckBounce(x,dX);

            dY:= dY + cGravityf;

            dec(t)

        until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or

               ((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me^.Hedgehog^.Gear, trunc(x), trunc(y), 5))) or (t < -cExtraTime);

        EX:= trunc(x);

        EY:= trunc(y);

        if t >= -cExtraTime then

            begin

                if Level = 1 then

                    value:= RateExplosion(Me, EX, EY, 101, afTrackFall or afErasesLand)

                else

                    value:= RateExplosion(Me, EX, EY, 101);

            end else

                value:= BadTurn;

        if (value = 0) and (Targ.Kind = gtHedgehog) and (Targ.Score > 0) then

            if GameFlags and gfSolidLand = 0 then

                 value := 1024 - Metric(Targ.Point.X, Targ.Point.Y, EX, EY) div 64

            else value := BadTurn;

        if (valueResult < value) or ((valueResult = value) and (Level < 3)) then

            begin

            ap.Angle:= DxDy2AttackAnglef(Vx, Vy) + AIrndSign(random((Level - 1) * 9));

            ap.Power:= trunc(sqrt(r) * cMaxPower) - random((Level - 1) * 17 + 1);

            ap.ExplR:= 100;

            ap.ExplX:= EX;

            ap.ExplY:= EY;

            valueResult:= value

            end;

        end

until rTime > 5050 - Level * 800;

TestBazooka:= valueResult

end;

function calcBeeFlight(Me: PGear; x, y, dx, dy, tX, tY: real; var eX, eY: LongInt): LongInt;

var t: Longword;

    f: boolean;

    speed, d: real;

begin

    // parabola flight before activation

    t:= 500;

    repeat

        x:= x + dx;

        y:= y + dy;

        dy:= dy + cGravityf;

        f:= ((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or

           ((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me^.Hedgehog^.Gear, trunc(x), trunc(y), 5));

        dec(t)

    until (t = 0) or (y >= cWaterLine) or f;

    if f then

    begin

        eX:= trunc(x);

        eY:= trunc(y);

        exit(RateExplosion(Me, eX, eY, 101, afTrackFall or afErasesLand));

    end;

    // activated

    t:= 5000;

    speed:= sqrt(sqr(dx) + sqr(dy));

    repeat

        if (t and $F) = 0 then

        begin

            dx:= dx + 0.000064 * (tX - x);

            dy:= dy + 0.000064 * (tY - y);

            d := speed / sqrt(sqr(dx) + sqr(dy));

            dx:= dx * d;

            dy:= dy * d;

        end;

        x:= x + dx;

        y:= y + dy;

        f:= ((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or

           ((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me^.Hedgehog^.Gear, trunc(x), trunc(y), 5));

        dec(t)

    until (t = 0) or f;

    if f then

    begin

        eX:= trunc(x);

        eY:= trunc(y);

        exit(RateExplosion(Me, eX, eY, 101, afTrackFall or afErasesLand));

    end

    else

        calcBeeFlight:= BadTurn

end;

function TestBee(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

var i, j: LongInt;

    valueResult, v, a, p: LongInt;

    mX, mY: real;

    eX, eY: LongInt;

begin

Flags:= Flags; // avoid compiler hint

    if Level > 1 then

        exit(BadTurn);

    eX:= 0;

    eY:= 0;

    mX:= hwFloat2Float(Me^.X);

    mY:= hwFloat2Float(Me^.Y);

    valueResult:= BadTurn;

    for i:= 0 to 8 do

        for j:= 0 to 1 do

            begin

            a:= i * 120;

            p:= random(cMaxPower - 200) + 180;

            if j = 0 then

                a:= -a;

            v:= calcBeeFlight(Me

                    , mX

                    , mY

                    , sin(a * pi / 2048) * p / cPowerDivisor

                    , -cos(a * pi / 2048) * p / cPowerDivisor

                    , Targ.Point.X

                    , Targ.Point.Y

                    , eX

                    , eY);

            if v > valueResult then

                begin

                ap.ExplR:= 100;

                ap.ExplX:= eX;

                ap.ExplY:= eY;

                ap.Angle:= a;

                ap.Power:= p;

                valueResult:= v

                end

            end;

    ap.AttackPutX:= Targ.Point.X;

    ap.AttackPutY:= Targ.Point.Y;

    if valueResult > 0 then

        TestBee:= valueResult - 5000

    else

        TestBee:= BadTurn // no digging

end;

function TestDrillRocket(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

var Vx, Vy, r, mX, mY: real;

    rTime: LongInt;

    EX, EY: LongInt;

    valueResult: LongInt;

    targXWrap, x, y, dX, dY: real;

    t: LongInt;

    value: LongInt;

    t2: real;

    timer: Longint;

begin

Flags:= Flags; // avoid compiler hint

    if (Level > 3) then exit(BadTurn);

    mX:= hwFloat2Float(Me^.X);

    mY:= hwFloat2Float(Me^.Y);

    ap.Time:= 0;

    rTime:= 350;

    ap.ExplR:= 0;

    valueResult:= BadTurn;

    if (WorldEdge = weWrap) then

        if (Targ.Point.X < mX) then

             targXWrap:= Targ.Point.X + (RightX-LeftX)

        else targXWrap:= Targ.Point.X - (RightX-LeftX);

    timer:= 0;

    repeat

        rTime:= rTime + 300 + Level * 50 + random(300);

        if (WorldEdge = weWrap) and (random(2)=0) then

             Vx:= - windSpeed * rTime * 0.5 + (targXWrap + AIrndSign(2) - mX) / rTime

        else Vx:= - windSpeed * rTime * 0.5 + (Targ.Point.X + AIrndSign(2) - mX) / rTime;

        Vy:= cGravityf * rTime * 0.5 - (Targ.Point.Y - 35 - mY) / rTime;

        r:= sqr(Vx) + sqr(Vy);

        if not (r > 1) then

            begin

            x:= mX;

            y:= mY;

            dX:= Vx;

            dY:= -Vy;

            t:= rTime;

            repeat

                x:= CheckWrap(x);

                x:= x + dX;

                y:= y + dY;

                dX:= dX + windSpeed;

                dY:= dY + cGravityf;

                dec(t)

            until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or

                   ((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me^.Hedgehog^.Gear, trunc(x), trunc(y), 5))) or (y > cWaterLine);

            if TestCollExcludingObjects(trunc(x), trunc(y), 5) and (Abs(Targ.Point.X - trunc(x)) + Abs(Targ.Point.Y - trunc(y)) > 21) then

                begin

                timer := 500;

                t2 := 0.5 / sqrt(sqr(dX) + sqr(dY));

                dX := dX * t2;

                dY := dY * t2;

                repeat

                    x:= x + dX;

                    y:= y + dY;

                    dec(timer);

                until (Abs(Targ.Point.X - trunc(x)) + Abs(Targ.Point.Y - trunc(y)) < 22)

                    or (x < 0)

                    or (y < 0)

                    or (trunc(x) > LAND_WIDTH)

                    or (trunc(y) > LAND_HEIGHT)

                    or (not TestCollExcludingObjects(trunc(x), trunc(y), 5))

                    or (timer = 0)

                end;

            EX:= trunc(x);

            EY:= trunc(y);

            // Try to prevent AI from thinking firing into water will cause a drowning

            if (EY < cWaterLine-5) and (timer > 0) and (Abs(Targ.Point.X - trunc(x)) + Abs(Targ.Point.Y - trunc(y)) > 21) then exit(BadTurn);

            if Level = 1 then

                value:= RateExplosion(Me, EX, EY, 101, afTrackFall or afErasesLand)

            else value:= RateExplosion(Me, EX, EY, 101);

            if valueResult <= value then

                begin

                ap.Angle:= DxDy2AttackAnglef(Vx, Vy) + AIrndSign(random((Level - 1) * 9));

                ap.Power:= trunc(sqrt(r) * cMaxPower) - random((Level - 1) * 17 + 1);

                ap.ExplR:= 100;

                ap.ExplX:= EX;

                ap.ExplY:= EY;

                valueResult:= value-2500 // trying to make it slightly less attractive than a bazooka, to prevent waste.  AI could use awareness of weapon count

                end;

            end

    until rTime > 5050 - Level * 800;

    TestDrillRocket:= valueResult

end;

function TestRCPlane(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;

const

    MIN_RANGE =  200;

var Vx, Vy, meX, meY, x, y: real;

    rx, ry, valueResult: LongInt;

    range, maxRange: integer;

begin

// This is a very simple test to let a RC plane fly in a straight line, without dropping any bombs

// TODO: Teach AI how to steer

// TODO: Teach AI how to drop bombs

// TODO: Teach AI how to predict fire behavior

Flags:= Flags; // avoid compiler hint

if Level = 5 then

    exit(BadTurn)

else if Level = 4 then

    maxRange:= 2200

else if Level = 3 then

    maxRange:= 2900

else if Level = 2 then

    maxRange:= 3500

else

    maxRange:= 3900;

TestRCPlane:= BadTurn;

ap.ExplR:= 0;

ap.Time:= 0;

ap.Power:= 1;

meX:= hwFloat2Float(Me^.X);

meY:= hwFloat2Float(Me^.Y);

x:= meX;

y:= meY;

range:= Metric(trunc(x), trunc(y), Targ.Point.X, Targ.Point.Y);

if ( range < MIN_RANGE ) or ( range > maxRange) then

    exit(BadTurn);

Vx:= (Targ.Point.X - x) * 1 / 1024;

Vy:= (Targ.Point.Y - y) * 1 / 1024;

ap.Angle:= DxDy2AttackAnglef(Vx, -Vy);

repeat

    x:= x + vX;

    y:= y + vY;

    rx:= trunc(x);

    ry:= trunc(y);

    if ((Me = CurrentHedgehog^.Gear) and TestColl(rx, ry, 8)) or

        ((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me^.Hedgehog^.Gear, rx, ry, 8)) then

        begin

        x:= x + vX * 8;

        y:= y + vY * 8;

        // Intentionally low rating to discourage use

        if Level = 1 then

            valueResult:= RateExplosion(Me, rx, ry, 26, afTrackFall or afErasesLand)

        else

            valueResult:= RateExplosion(Me, rx, ry, 26);

        // Check range again in case the plane collided before target

        range:= Metric(trunc(meX), trunc(meY), rx, ry);

        if ( range < MIN_RANGE ) or ( range > maxRange) then

            exit(BadTurn);

        // If impact location is close, above us and wind blows in our direction,

        // there's a risk of fire flying towards us, so fail in this case.

        if (Level < 3) and (range <= 600) and (meY >= ry) and

            (((ap.Angle < 0) and (windSpeed > 0)) or ((ap.Angle > 0) and (windSpeed < 0))) then

            exit(BadTurn);