Teleport AI:
authormbait
Tue, 27 Apr 2010 12:51:29 +0000
changeset 3370 37f4f83fedb1
parent 3369 c7289e42f0ee
child 3371 da73f471798f
Teleport AI: * basic implementation of teleport using in order to take crates * filter option to get certain types of gears in FillBonuses
hedgewars/uAIAmmoTests.pas
hedgewars/uAIMisc.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.
--- 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