Teach AI to use seduction
authorWuzzy <Wuzzy2@mail.ru>
Fri, 12 Jun 2020 00:20:47 +0200
changeset 15640 e21285b7c5e6
parent 15639 e4abca26f215
child 15641 99fe21754b3f
Teach AI to use seduction
ChangeLog.txt
hedgewars/uAIAmmoTests.pas
hedgewars/uAIMisc.pas
--- a/ChangeLog.txt	Tue Jun 09 07:56:59 2020 +0200
+++ b/ChangeLog.txt	Fri Jun 12 00:20:47 2020 +0200
@@ -11,7 +11,7 @@
  + Themes: Make Sudden Death flakes in Underwater theme rise
  + New taunt chat commands: /bubble, /happy
  + Teach computer players how to ...
- +   - use drill strike, piano strike, air mine, cleaver
+ +   - use drill strike, piano strike, air mine, cleaver, seduction
  +   - use mine strike (0 seconds only)
  +   - use RC plane (very basic)
  +   - drop mines from a cliff
--- a/hedgewars/uAIAmmoTests.pas	Tue Jun 09 07:56:59 2020 +0200
+++ b/hedgewars/uAIAmmoTests.pas	Fri Jun 12 00:20:47 2020 +0200
@@ -60,6 +60,7 @@
 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 TestSeduction(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;
 function TestKnife(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;
@@ -99,7 +100,7 @@
             (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: @TestSeduction;   flags: amtest_NoTarget), // amSeduction
             (proc: @TestWatermelon;  flags: 0), // amWatermelon
             (proc: nil;              flags: 0), // amHellishBomb
             (proc: nil;              flags: 0), // amNapalm
@@ -1834,6 +1835,27 @@
     TestCake:= valueResult;
 end;
 
+function TestSeduction(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;
+var rate: LongInt;
+begin
+Flags:= Flags; // avoid compiler hint
+Level:= Level; // avoid compiler hint
+Targ:= Targ;
+
+if (Level = 5) then
+    exit(BadTurn);
+
+ap.ExplR:= 0;
+ap.Time:= 0;
+ap.Power:= 1;
+ap.Angle:= 0;
+
+rate:= RateSeduction(Me);
+if rate <= 0 then
+    rate:= BadTurn;
+TestSeduction:= rate;
+end;
+
 function TestDynamite(Me: PGear; Targ: TTarget; Level: LongInt; var ap: TAttackParams; Flags: LongWord): LongInt;
 var valueResult: LongInt;
     x, y, dx, dy: real;
--- a/hedgewars/uAIMisc.pas	Tue Jun 09 07:56:59 2020 +0200
+++ b/hedgewars/uAIMisc.pas	Fri Jun 12 00:20:47 2020 +0200
@@ -87,6 +87,7 @@
 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  RateHammer(Me: PGear): LongInt;
 
 function  HHGo(Gear, AltGear: PGear; var GoInfo: TGoInfo): boolean;
@@ -836,6 +837,92 @@
 ResetTargets;
 end;
 
+function RateSeduction(Me: PGear): LongInt;
+var pX, pY, i, r, rate, subrate, fallDmg: LongInt;
+    diffX, diffY: LongInt;
+    meX, meY, dX, dY: hwFloat;
+    pXr, pYr: real;
+    hadSkips: boolean;
+begin
+meX:= Me^.X;
+meY:= Me^.Y;
+rate:= 0;
+for i:= 0 to Targets.Count do
+    if not Targets.ar[i].dead then
+        with Targets.ar[i] do
+            begin
+            pX:= Point.X;
+            pY:= Point.Y;
+            diffX:= pX - hwRound(meX);
+            diffY:= pY - hwRound(meY);
+            if (Me^.Hedgehog^.BotLevel < 4) and (abs(diffX) <= cHHRadius*2) and (diffY >= 0) and (diffY <= cHHRadius*2) then
+                // Don't use seduction if too close to other hog. We could be
+                // standing on it, so using seduction would remove the ground on
+                // which we stand on, which is dangerous
+                exit(BadTurn);
+
+            if (not matters) then
+                hadSkips:= true
+            else if matters and (Kind = gtHedgehog) and (abs(pX - hwRound(meX)) + abs(pY - hwRound(meY)) < cSeductionDist) then
+                begin
+                r:= trunc(sqrt(sqr(abs(pX - hwRound(meX)))+sqr(abs(pY - hwRound(meY)))));
+                if r < cSeductionDist then
+                    begin
+
+                    if (WorldEdge <> weWrap) or (not (hwAbs(meX - int2hwFloat(pX)) > int2hwFloat(cSeductionDist))) then
+                        dX:= _50 * cGravity * (meX - int2hwFloat(pX)) / _25
+                    else if (not (hwAbs(meX + int2hwFloat((RightX-LeftX) - pX)) > int2hwFloat(cSeductionDist))) then
+                        dX:= _50 * cGravity * (meX + (int2hwFloat((RightX-LeftX) - pX))) / _25
+                    else
+                        dX:= _50 * cGravity * (meX - (int2hwFloat((RightX-LeftX) - pX))) / _25;
+                    dY:= -_450 * cMaxWindSpeed * 2;
+
+
+                    pXr:= pX;
+                    pYr:= pY;
+                    fallDmg:= trunc(TraceShoveFall(pXr, pYr, hwFloat2Float(dX), hwFloat2Float(dY), Targets.ar[i]) * dmgMod);
+
+                    // rate damage
+                    if fallDmg < 0 then // drowning
+                        begin
+                        if Score > 0 then
+                            inc(rate, (KillScore + Score div 10) * 1024) // Add a bit of a bonus for bigger hog drownings
+                        else
+                            dec(rate, (KillScore * friendlyfactor div 100 - Score div 10) * 1024) // and more of a punishment for drowning bigger friendly hogs
+                        end
+                    else if (fallDmg) >= abs(Score) then // deadly fall damage
+                        begin
+                        dead:= true;
+                        Targets.reset:= true;
+                        if (hwFloat2Float(dX) < 0.035) then
+                            begin
+                            subrate:= RealRateExplosion(Me, round(pX), round(pY), 61, afErasesLand or afTrackFall); // hog explodes
+                            if abs(subrate) > 2000 then
+                                inc(rate, subrate)
+                            end;
+                        if Score > 0 then
+                             inc(rate, KillScore * 1024 + (fallDmg)) // tiny bonus for dealing more damage than needed to kill
+                        else
+                             dec(rate, KillScore * friendlyfactor div 100 * 1024)
+                        end
+                    else if (fallDmg <> 0) then // non-deadly fall damage
+                        if Score > 0 then
+                             inc(rate, fallDmg * 1024)
+                        else
+                             dec(rate, fallDmg * friendlyfactor div 100 * 1024)
+                    else // no damage, just shoved
+                        if (Score < 0) then
+                            dec(rate, 100); // small penalty for shoving friendly hogs as it might be dangerous
+                    end;
+                end;
+            end;
+
+if hadSkips and (rate <= 0) then
+    RateSeduction:= BadTurn
+else
+    RateSeduction:= rate * 1024;
+end;
+
 function RateHammer(Me: PGear): LongInt;
 var x, y, i, r, rate: LongInt;
     hadSkips: boolean;