hedgewars/uAIMisc.pas
changeset 66 9643d75baf1e
parent 64 9df467527ae5
child 70 82d93eeecebe
equal deleted inserted replaced
65:8c4c6ad6ca99 66:9643d75baf1e
     1 unit uAIMisc;
     1 unit uAIMisc;
     2 interface
     2 interface
     3 uses SDLh, uConsts;
     3 uses SDLh, uConsts, uGears;
     4 
     4 
     5 type TTarget = record
     5 type TTarget = record
     6                Point: TPoint;
     6                Point: TPoint;
     7                Score: integer;
     7                Score: integer;
     8                end;
     8                end;
     9      TTargets = record
     9      TTargets = record
    10                 Count: Longword;
    10                 Count: Longword;
    11                 ar: array[0..cMaxHHIndex*5] of TTarget;
    11                 ar: array[0..cMaxHHIndex*5] of TTarget;
    12                 end;
    12                 end;
    13 
    13 
    14 procedure FillTargets(var Targets: TTargets);
    14 procedure FillTargets;
       
    15 procedure FillBonuses;
       
    16 function CheckBonuses(Gear: PGear): integer;
    15 function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
    17 function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
    16 function TestColl(x, y, r: integer): boolean;
    18 function TestColl(x, y, r: integer): boolean;
    17 function NoMyHHNear(x, y, r: integer): boolean;
    19 function RateExplosion(Me: PGear; x, y, r: integer): integer;
       
    20 function HHGo(Gear: PGear): boolean;
       
    21 
       
    22 var ThinkingHH: PGear;
       
    23     Targets: TTargets;
    18 
    24 
    19 implementation
    25 implementation
    20 uses uTeams, uMisc, uLand;
    26 uses uTeams, uMisc, uLand, uCollisions;
    21 
    27 const KillScore = 200;
    22 procedure FillTargets(var Targets: TTargets);
    28       MAXBONUS = 1024;
       
    29       
       
    30 type TBonus = record
       
    31               X, Y: integer;
       
    32               Radius: Longword;
       
    33               Score: integer;
       
    34               end;
       
    35 var bonuses: record
       
    36              Count: Longword;
       
    37              ar: array[0..Pred(MAXBONUS)] of TBonus;
       
    38              end;
       
    39 
       
    40 procedure FillTargets;
    23 var t: PTeam;
    41 var t: PTeam;
    24     i: Longword;
    42     i: Longword;
    25 begin
    43 begin
    26 Targets.Count:= 0;
    44 Targets.Count:= 0;
    27 t:= TeamsList;
    45 t:= TeamsList;
    28 while t <> nil do
    46 while t <> nil do
    29       begin
    47       begin
    30       if t <> CurrentTeam then
    48       for i:= 0 to cMaxHHIndex do
    31          for i:= 0 to cMaxHHIndex do
    49           if (t.Hedgehogs[i].Gear <> nil)
    32              if t.Hedgehogs[i].Gear <> nil then
    50              and (t.Hedgehogs[i].Gear <> ThinkingHH) then
    33                 begin
    51              begin
    34                 with Targets.ar[Targets.Count], t.Hedgehogs[i] do
    52              with Targets.ar[Targets.Count], t.Hedgehogs[i] do
    35                      begin
    53                   begin
    36                      Point.X:= Round(Gear.X);
    54                   Point.X:= Round(Gear.X);
    37                      Point.Y:= Round(Gear.Y);
    55                   Point.Y:= Round(Gear.Y);
    38                      Score:= 100 - Gear.Health
    56                   if t <> CurrentTeam then Score:=  Gear.Health
    39                      end;
    57                                       else Score:= -Gear.Health
    40                 inc(Targets.Count)
    58                   end;
    41                 end;
    59              inc(Targets.Count)
       
    60              end;
    42       t:= t.Next
    61       t:= t.Next
    43       end
    62       end
       
    63 end;
       
    64 
       
    65 procedure FillBonuses;
       
    66 var Gear: PGear;
       
    67 
       
    68     procedure AddBonus(x, y: integer; r: Longword; s: integer);
       
    69     begin
       
    70     bonuses.ar[bonuses.Count].x:= x;
       
    71     bonuses.ar[bonuses.Count].y:= y;
       
    72     bonuses.ar[bonuses.Count].Radius:= r;
       
    73     bonuses.ar[bonuses.Count].Score:= s;
       
    74     inc(bonuses.Count);
       
    75     TryDo(bonuses.Count <= MAXBONUS, 'Bonuses overflow', true)
       
    76     end;
       
    77 
       
    78 begin
       
    79 bonuses.Count:= 0;
       
    80 Gear:= GearsList;
       
    81 while Gear <> nil do
       
    82       begin
       
    83       case Gear.Kind of
       
    84            gtCase: AddBonus(round(Gear.X), round(Gear.Y), 32, 25);
       
    85            gtMine: AddBonus(round(Gear.X), round(Gear.Y), 45, -50);
       
    86            gtAmmo_Bomb: AddBonus(round(Gear.X), round(Gear.Y), 50, -100);
       
    87            gtHedgehog: if Gear.Damage >= Gear.Health then AddBonus(round(Gear.X), round(Gear.Y), 50, -25);
       
    88            end;
       
    89       Gear:= Gear.NextGear
       
    90       end
       
    91 end;
       
    92 
       
    93 function CheckBonuses(Gear: PGear): integer;
       
    94 var i: integer;
       
    95 begin
       
    96 Result:= 0;
       
    97 for i:= 0 to Pred(bonuses.Count) do
       
    98     with bonuses.ar[i] do
       
    99          if sqrt(sqr(Gear.X - X) + sqr(Gear.Y - y)) <= Radius then
       
   100             inc(Result, Score) 
    44 end;
   101 end;
    45 
   102 
    46 function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
   103 function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
    47 const piDIVMaxAngle: Extended = pi/cMaxAngle;
   104 const piDIVMaxAngle: Extended = pi/cMaxAngle;
    48 asm
   105 asm
    65 Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);
   122 Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);
    66 if Result then exit;
   123 if Result then exit;
    67 Result:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0);
   124 Result:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0);
    68 end;
   125 end;
    69 
   126 
    70 function NoMyHHNear(x, y, r: integer): boolean;
   127 function RateExplosion(Me: PGear; x, y, r: integer): integer;
    71 var i: integer;
   128 var i, dmg: integer;
    72 begin
   129 begin
    73 i:= 0;
   130 Result:= 0;
    74 r:= sqr(r);
   131 // add our virtual position
    75 Result:= true;
   132 with Targets.ar[Targets.Count] do
       
   133      begin
       
   134      Point.x:= round(Me.X);
       
   135      Point.y:= round(Me.Y);
       
   136      Score:= - ThinkingHH.Health
       
   137      end;
       
   138 // rate explosion
       
   139 for i:= 0 to Targets.Count do
       
   140     with Targets.ar[i] do
       
   141          begin
       
   142          dmg:= r - Round(sqrt(sqr(Point.x - x) + sqr(Point.y - y)));
       
   143          if dmg > 0 then
       
   144             begin
       
   145             dmg:= dmg shr 1;
       
   146             if dmg > abs(Score) then
       
   147                if Score > 0 then inc(Result, KillScore)
       
   148                             else dec(Result, KillScore * 3)
       
   149             else
       
   150                if Score > 0 then inc(Result, dmg)
       
   151                             else dec(Result, dmg * 3)
       
   152             end;
       
   153          end;
       
   154 end;
       
   155 
       
   156 function HHGo(Gear: PGear): boolean;
       
   157 var pX, pY: integer;
       
   158 begin
       
   159 Result:= false;
    76 repeat
   160 repeat
    77   with CurrentTeam.Hedgehogs[i] do
   161 pX:= round(Gear.X);
    78        if Gear <> nil then
   162 pY:= round(Gear.Y);
    79           if sqr(Gear.X - x) + sqr(Gear.Y - y) <= r then
   163 if pY + cHHRadius >= cWaterLine then exit;
    80              begin
   164 if (Gear.State and gstFalling) <> 0 then
    81              Result:= false;
   165    begin
    82              exit
   166    Gear.dY:= Gear.dY + cGravity;
    83              end;
   167    if Gear.dY > 0.35 then exit;
    84 inc(i)
   168    Gear.Y:= Gear.Y + Gear.dY;
    85 until i > cMaxHHIndex
   169    if TestCollisionYwithGear(Gear, 1) then
       
   170       begin
       
   171       Gear.State:= Gear.State and not (gstFalling or gstHHJumping);
       
   172       Gear.dY:= 0
       
   173       end;
       
   174    continue
       
   175    end;
       
   176    {if ((Gear.Message and gm_LJump )<>0) then
       
   177       begin
       
   178       Gear.Message:= 0;
       
   179       if not HHTestCollisionYwithGear(Gear, -1) then
       
   180          if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 2 else
       
   181          if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 1;
       
   182       if not (TestCollisionXwithGear(Gear, Sign(Gear.dX))
       
   183          or   HHTestCollisionYwithGear(Gear, -1)) then
       
   184          begin
       
   185          Gear.dY:= -0.15;
       
   186          Gear.dX:= Sign(Gear.dX) * 0.15;
       
   187          Gear.State:= Gear.State or gstFalling or gstHHJumping;
       
   188          exit
       
   189          end;
       
   190       end;}
       
   191    if (Gear.Message and gm_Left  )<>0 then Gear.dX:= -1.0 else
       
   192    if (Gear.Message and gm_Right )<>0 then Gear.dX:=  1.0 else exit;
       
   193    if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
       
   194       begin
       
   195       if not (TestCollisionXwithXYShift(Gear, 0, -6, Sign(Gear.dX))
       
   196          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   197       if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX))
       
   198          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   199       if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX))
       
   200          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   201       if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX))
       
   202          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   203       if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX))
       
   204          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   205       if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX))
       
   206          or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
       
   207       end;
       
   208 
       
   209    if not TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.X:= Gear.X + Gear.dX;
       
   210    if not TestCollisionYwithGear(Gear, 1) then
       
   211    begin
       
   212    Gear.Y:= Gear.Y + 1;
       
   213    if not TestCollisionYwithGear(Gear, 1) then
       
   214    begin
       
   215    Gear.Y:= Gear.Y + 1;
       
   216    if not TestCollisionYwithGear(Gear, 1) then
       
   217    begin
       
   218    Gear.Y:= Gear.Y + 1;
       
   219    if not TestCollisionYwithGear(Gear, 1) then
       
   220    begin
       
   221    Gear.Y:= Gear.Y + 1;
       
   222    if not TestCollisionYwithGear(Gear, 1) then
       
   223    begin
       
   224    Gear.Y:= Gear.Y + 1;
       
   225    if not TestCollisionYwithGear(Gear, 1) then
       
   226    begin
       
   227    Gear.Y:= Gear.Y + 1;
       
   228    if not TestCollisionYwithGear(Gear, 1) then
       
   229       begin
       
   230       Gear.Y:= Gear.Y - 6;
       
   231       Gear.dY:= 0;
       
   232       Gear.dX:= 0.0000001 * Sign(Gear.dX);
       
   233       Gear.State:= Gear.State or gstFalling
       
   234       end
       
   235    end
       
   236    end
       
   237    end
       
   238    end
       
   239    end
       
   240    end;
       
   241 if (pX <> round(Gear.X))and ((Gear.State and gstFalling) = 0) then
       
   242    begin
       
   243    Result:= true;
       
   244    exit
       
   245    end;
       
   246 until (pX = round(Gear.X)) and (pY = round(Gear.Y)) and ((Gear.State and gstFalling) = 0);
    86 end;
   247 end;
    87 
   248 
    88 end.
   249 end.