1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uAIMisc;

    35 interface

    36 uses uConsts, uGears, SDLh;

    37 {$INCLUDE options.inc}

    38 

    39 type TTargets = record

    40                 Count: integer;

    41                 ar: array[0..cMaxHHIndex*5] of TPoint;

    42                 end;

    43                 

    44 procedure FillTargets(var Targets: TTargets);

    45 function DxDy2Angle(const _dY, _dX: Extended): integer;

    46 function TestColl(x, y, r: integer): boolean;

    47 function NoMyHHNear(x, y, r: integer): boolean;

    48 function HHGo(Gear: PGear): boolean;

    49 

    50 implementation

    51 uses uTeams, uStore, uMisc, uLand, uCollisions;

    52 

    53 procedure FillTargets(var Targets: TTargets);

    54 var t: PTeam;

    55     i, k: integer;

    56     r: integer;

    57     MaxHealth: integer;

    58     score: array[0..cMaxHHIndex*5] of integer;

    59 

    60   procedure qSort(iLo, iHi: Integer);

    61   var

    62     Lo, Hi, Mid, T: Integer;

    63     P: TPoint;

    64   begin

    65     Lo := iLo;

    66     Hi := iHi;

    67     Mid := score[(Lo + Hi) div 2];

    68     repeat

    69       while score[Lo] > Mid do Inc(Lo);

    70       while score[Hi] < Mid do Dec(Hi);

    71       if Lo <= Hi then

    72       begin

    73         T := score[Lo];

    74         score[Lo] := score[Hi];

    75         score[Hi] := T;

    76         P := Targets.ar[Lo];

    77         Targets.ar[Lo] := Targets.ar[Hi];

    78         Targets.ar[Hi] := P;

    79         Inc(Lo);

    80         Dec(Hi)

    81       end;

    82     until Lo > Hi;

    83     if Hi > iLo then qSort(iLo, Hi);

    84     if Lo < iHi then qSort(Lo, iHi);

    85   end;

    86 

    87 begin

    88 Targets.Count:= 0;

    89 t:= TeamsList;

    90 MaxHealth:= 0;

    91 while t <> nil do

    92       begin

    93       if t <> CurrentTeam then

    94          for i:= 0 to cMaxHHIndex do

    95              if t.Hedgehogs[i].Gear <> nil then

    96                 begin

    97                 with Targets.ar[Targets.Count], t.Hedgehogs[i] do

    98                      begin

    99                      X:= Round(Gear.X);

   100                      Y:= Round(Gear.Y);

   101                      if integer(Gear.Health) > MaxHealth then MaxHealth:= Gear.Health;

   102                      score[Targets.Count]:= random(3) - integer(Gear.Health div 5)

   103                      end;

   104                 inc(Targets.Count)

   105                 end;

   106       t:= t.Next

   107       end;

   108 // выставляем оценку за попадание в ёжика:

   109 //  - если есть соседи-противники, то оценка увеличивается

   110 //  - чем меньше хелса у ёжика, тем больше оценка (код см. выше)

   111 //  - если есть соседи-"свои", то уменьшается

   112 with Targets do

   113      for i:= 0 to Targets.Count - 1 do

   114          begin

   115          for k:= Succ(i) to Pred(Targets.Count) do

   116              begin

   117              r:= 100 - round(sqrt(sqr(ar[i].X - ar[k].X) + sqr(ar[i].Y - ar[k].Y)));

   118              if r > 0 then

   119                 begin

   120                 inc(score[i], r);

   121                 inc(score[k], r)

   122                 end;

   123              end;

   124          for k:= 0 to cMaxHHIndex do

   125              with CurrentTeam.Hedgehogs[k] do

   126                   if Gear <> nil then

   127                      begin

   128                      r:= 100 - round(sqrt(sqr(ar[i].X - round(Gear.X)) + sqr(ar[i].Y - round(Gear.Y))));

   129                      if r > 0 then dec(score[i], (r * 3) div 2 + MaxHealth + 5 - integer(Gear.Health));

   130                      end;

   131          end;

   132 // сортируем по убыванию согласно оценке

   133 if Targets.Count >= 2 then qSort(0, Pred(Targets.Count));

   134 end;

   135 

   136 function DxDy2Angle(const _dY, _dX: Extended): integer;

   137 const piDIVMaxAngle: Extended = pi/cMaxAngle;

   138 asm

   139         fld     _dY

   140         fld     _dX

   141         fpatan

   142         fld     piDIVMaxAngle

   143         fdiv

   144         sub     esp, 4

   145         fistp   dword ptr [esp]

   146         pop     eax

   147 end;

   148 

   149 function TestColl(x, y, r: integer): boolean;

   150 begin

   151 Result:=(((x-r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x-r] <> 0);

   152 if Result then exit;

   153 Result:=(((x-r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x-r] <> 0);

   154 if Result then exit;

   155 Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);

   156 if Result then exit;

   157 Result:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0);

   158 end;

   159 

   160 function NoMyHHNear(x, y, r: integer): boolean;

   161 var i: integer;

   162 begin

   163 i:= 0;

   164 r:= sqr(r);

   165 Result:= true;

   166 repeat

   167   with CurrentTeam.Hedgehogs[i] do

   168        if Gear <> nil then

   169           if sqr(Gear.X - x) + sqr(Gear.Y - y) <= r then

   170              begin

   171              Result:= false;

   172              exit

   173              end;

   174 inc(i)

   175 until i > cMaxHHIndex

   176 end;

   177 

   178 function HHGo(Gear: PGear): boolean; // false если нельзя двигаться

   179 var pX, pY: integer;

   180 begin

   181 Result:= false;

   182 repeat

   183 pX:= round(Gear.X);

   184 pY:= round(Gear.Y);

   185 if pY + cHHHalfHeight >= cWaterLine then exit;

   186 if (Gear.State and gstFalling) <> 0 then

   187    begin

   188    Gear.dY:= Gear.dY + cGravity;

   189    if Gear.dY > 0.35 then exit;

   190    Gear.Y:= Gear.Y + Gear.dY;

   191    if HHTestCollisionYwithGear(Gear, 1) then

   192       begin

   193       Gear.State:= Gear.State and not (gstFalling or gstHHJumping);

   194       Gear.dY:= 0

   195       end;

   196    continue

   197    end;

   198    {if ((Gear.Message and gm_LJump )<>0) then

   199       begin

   200       Gear.Message:= 0;

   201       if not HHTestCollisionYwithGear(Gear, -1) then

   202          if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 2 else

   203          if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 1;

   204       if not (TestCollisionXwithGear(Gear, Sign(Gear.dX))

   205          or   HHTestCollisionYwithGear(Gear, -1)) then

   206          begin

   207          Gear.dY:= -0.15;

   208          Gear.dX:= Sign(Gear.dX) * 0.15;

   209          Gear.State:= Gear.State or gstFalling or gstHHJumping;

   210          exit

   211          end;

   212       end;}

   213    if (Gear.Message and gm_Left  )<>0 then Gear.dX:= -1.0 else

   214    if (Gear.Message and gm_Right )<>0 then Gear.dX:=  1.0 else exit;

   215    if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then

   216       begin

   217       if not (TestCollisionXwithXYShift(Gear, 0, -6, Sign(Gear.dX))

   218          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   219       if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX))

   220          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   221       if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX))

   222          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   223       if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX))

   224          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   225       if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX))

   226          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   227       if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX))

   228          or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;

   229       end;

   230 

   231    if not TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.X:= Gear.X + Gear.dX;

   232    if not HHTestCollisionYwithGear(Gear, 1) then

   233    begin

   234    Gear.Y:= Gear.Y + 1;

   235    if not HHTestCollisionYwithGear(Gear, 1) then

   236    begin

   237    Gear.Y:= Gear.Y + 1;

   238    if not HHTestCollisionYwithGear(Gear, 1) then

   239    begin

   240    Gear.Y:= Gear.Y + 1;

   241    if not HHTestCollisionYwithGear(Gear, 1) then

   242    begin

   243    Gear.Y:= Gear.Y + 1;

   244    if not HHTestCollisionYwithGear(Gear, 1) then

   245    begin

   246    Gear.Y:= Gear.Y + 1;

   247    if not HHTestCollisionYwithGear(Gear, 1) then

   248    begin

   249    Gear.Y:= Gear.Y + 1;

   250    if not HHTestCollisionYwithGear(Gear, 1) then

   251       begin

   252       Gear.Y:= Gear.Y - 6;

   253       Gear.dY:= 0;

   254       Gear.dX:= 0.0000001 * Sign(Gear.dX);

   255       Gear.State:= Gear.State or gstFalling

   256       end

   257    end

   258    end

   259    end

   260    end

   261    end

   262    end;

   263 if (pX <> round(Gear.X))and ((Gear.State and gstFalling) = 0) then

   264    begin

   265    Result:= true;

   266    exit

   267    end;

   268 until (pX = round(Gear.X)) and (pY = round(Gear.Y)) and ((Gear.State and gstFalling) = 0);

   269 end;

   270 

   271 end.