# HG changeset patch # User mbait # Date 1272372689 0 # Node ID 37f4f83fedb190df3289348ae11085af66a23c46 # Parent c7289e42f0ee688b80024f1529c1a84e98497d3f Teleport AI: * basic implementation of teleport using in order to take crates * filter option to get certain types of gears in FillBonuses diff -r c7289e42f0ee -r 37f4f83fedb1 hedgewars/uAIAmmoTests.pas --- a/hedgewars/uAIAmmoTests.pas Mon Apr 26 01:55:26 2010 +0000 +++ b/hedgewars/uAIAmmoTests.pas Tue Apr 27 12:51:29 2010 +0000 @@ -41,6 +41,7 @@ function TestBaseballBat(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; function TestFirePunch(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; function TestAirAttack(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; +function TestTeleport(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; type TAmmoTestProc = function (Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; TAmmoTest = record @@ -70,7 +71,7 @@ (proc: nil; flags: 0), // amMineStrike (proc: nil; flags: 0), // amBlowTorch (proc: nil; flags: 0), // amGirder - (proc: nil; flags: amtest_OnTurn), // amTeleport + (proc: @TestTeleport; flags: amtest_OnTurn), // amTeleport (proc: nil; flags: 0), // amSwitch (proc: @TestMortar; flags: 0), // amMortar (proc: nil; flags: 0), // amKamikaze @@ -635,4 +636,20 @@ TestAirAttack:= valueResult; end; + +function TestTeleport(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt; +var + i: longword; +begin + FillBonuses(true, [gtCase]); + if bonuses.Count = 0 then + TestTeleport := BadTurn + else begin + i := random(bonuses.Count); + ap.AttackPutX := bonuses.ar[i].X; + ap.AttackPutY := bonuses.ar[i].Y - 50; + TestTeleport := 0; + end; +end; + end. diff -r c7289e42f0ee -r 37f4f83fedb1 hedgewars/uAIMisc.pas --- a/hedgewars/uAIMisc.pas Mon Apr 26 01:55:26 2010 +0000 +++ b/hedgewars/uAIMisc.pas Tue Apr 27 12:51:29 2010 +0000 @@ -22,6 +22,8 @@ interface uses SDLh, uConsts, uGears, uFloat; +const MAXBONUS = 1024; + type TTarget = record Point: TPoint; Score: LongInt; @@ -36,12 +38,17 @@ FallPix: Longword; JumpType: TJumpType; end; + TBonus = record + X, Y: LongInt; + Radius: LongInt; + Score: LongInt; + end; procedure initModule; procedure freeModule; procedure FillTargets; -procedure FillBonuses(isAfterAttack: boolean); +procedure FillBonuses(isAfterAttack: boolean; filter: TGearsType = []); procedure AwareOfExplosion(x, y, r: LongInt); function RatePlace(Gear: PGear): LongInt; function TestCollExcludingMe(Me: PGear; x, y, r: LongInt): boolean; @@ -55,27 +62,21 @@ var ThinkingHH: PGear; Targets: TTargets; -implementation -uses uTeams, uMisc, uLand, uCollisions; - -type TBonus = record - X, Y: LongInt; - Radius: LongInt; - Score: LongInt; - end; - -const KillScore = 200; - MAXBONUS = 1024; - -var friendlyfactor: LongInt = 300; - KnownExplosion: record - X, Y, Radius: LongInt - end = (X: 0; Y: 0; Radius: 0); bonuses: record Count: Longword; ar: array[0..Pred(MAXBONUS)] of TBonus; end; +implementation +uses uTeams, uMisc, uLand, uCollisions; + + +const KillScore = 200; + +var friendlyfactor: LongInt = 300; + KnownExplosion: record + X, Y, Radius: LongInt + end = (X: 0; Y: 0; Radius: 0); procedure FillTargets; var i, t: Longword; @@ -114,7 +115,7 @@ else friendlyfactor:= max(30, 300 - f * 80 div e) end; -procedure FillBonuses(isAfterAttack: boolean); +procedure FillBonuses(isAfterAttack: boolean; filter: TGearsType); var Gear: PGear; MyClan: PClan; @@ -134,26 +135,27 @@ Gear:= GearsList; while Gear <> nil do begin - case Gear^.Kind of - gtCase: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 33, 25); - gtFlame: if (Gear^.State and gsttmpFlag) <> 0 then - AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 20, -50); - gtMine: if (Gear^.State and gstAttacking) = 0 then - AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 50, -50) - else - AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, -50); // mine is on - gtDynamite: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -75); - gtHedgehog: begin - if Gear^.Damage >= Gear^.Health then - AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 60, -25) - else - if isAfterAttack and (ThinkingHH^.Hedgehog <> Gear^.Hedgehog) then - if (MyClan = PHedgehog(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; + if (filter = []) or (Gear^.Kind in filter) then + case Gear^.Kind of + gtCase: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 33, 25); + gtFlame: if (Gear^.State and gsttmpFlag) <> 0 then + AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 20, -50); + gtMine: if (Gear^.State and gstAttacking) = 0 then + AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 50, -50) + else + AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, -50); // mine is on + gtDynamite: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -75); + gtHedgehog: begin + if Gear^.Damage >= Gear^.Health then + AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 60, -25) + else + if isAfterAttack and (ThinkingHH^.Hedgehog <> Gear^.Hedgehog) then + if (MyClan = PHedgehog(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