# HG changeset patch # User Wuzzy # Date 1591914047 -7200 # Node ID e21285b7c5e68d5cbb1d55ca14d87d469bb496f8 # Parent e4abca26f215b2407341770a6aaf1ad2e0300a06 Teach AI to use seduction diff -r e4abca26f215 -r e21285b7c5e6 ChangeLog.txt --- 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 diff -r e4abca26f215 -r e21285b7c5e6 hedgewars/uAIAmmoTests.pas --- 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; diff -r e4abca26f215 -r e21285b7c5e6 hedgewars/uAIMisc.pas --- 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;