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