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 uAIAmmoTests;

    35 interface

    36 uses uConsts, SDLh;

    37 {$INCLUDE options.inc}

    38 const ctfNotFull = $00000001;

    39       ctfBreach  = $00000002;

    40       

    41 function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

    42 function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

    43 function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

    44 

    45 type TAmmoTestProc = function (Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

    46 const AmmoTests: array[TAmmoType] of

    47                     record

    48                     Test: TAmmoTestProc;

    49                     Flags: Longword;

    50                     end = (

    51                     ( Test: TestGrenade;

    52                       Flags: ctfNotFull;

    53                     ),

    54                     ( Test: TestBazooka;

    55                       Flags: ctfNotFull or ctfBreach;

    56                     ),

    57                     ( Test: nil;

    58                       Flags: 0;

    59                     ),

    60                     ( Test: TestShotgun;

    61                       Flags: ctfBreach;

    62                     ),

    63                     ( Test: nil;

    64                       Flags: 0;

    65                     ),

    66                     ( Test: nil;

    67                       Flags: 0;

    68                     ),

    69                     ( Test: nil;

    70                       Flags: 0;

    71                     )

    72                     );

    73 

    74 implementation

    75 uses uMisc, uAIMisc;

    76 

    77 function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

    78 var Vx, Vy, r: real;

    79     flHasTrace: boolean;

    80 

    81     function CheckTrace: boolean;

    82     var x, y, dY: real;

    83         t: integer;

    84     begin

    85     x:= Me.X;

    86     y:= Me.Y;

    87     dY:= -Vy;

    88     Result:= false;

    89     if (Flags and ctfNotFull) = 0 then t:= Time

    90                                   else t:= Time - 100;

    91     repeat

    92       x:= x + Vx;

    93       y:= y + dY;

    94       dY:= dY + cGravity;

    95       if TestColl(round(x), round(y), 5) then exit;

    96       dec(t);

    97     until t <= 0;

    98     Result:= true

    99     end;

   100 

   101 begin

   102 Result:= false;

   103 Time:= 0;

   104 flHasTrace:= false;

   105 repeat

   106   inc(Time, 1000);

   107   Vx:= (Targ.X - Me.X) / Time;

   108   Vy:= cGravity*(Time div 2) - (Targ.Y - Me.Y) / Time;

   109   r:= sqr(Vx) + sqr(Vy);

   110   if r <= 1 then flHasTrace:= CheckTrace

   111             else exit

   112 until flHasTrace or (Time = 5000);

   113 if not flHasTrace then exit;

   114 r:= sqrt(r);

   115 Angle:= DxDy2Angle(Vx, Vy);

   116 Power:= round(r * cMaxPower);

   117 Result:= true

   118 end;

   119 

   120 function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

   121 var Vx, Vy, r: real;

   122     rTime: real;

   123     flHasTrace: boolean;

   124 

   125     function CheckTrace: boolean;

   126     var x, y, dX, dY: real;

   127         t: integer;

   128     begin

   129     x:= Me.X + Vx*20;

   130     y:= Me.Y + Vy*20;

   131     dX:= Vx;

   132     dY:= -Vy;

   133     Result:= false;

   134     if (Flags and ctfNotFull) = 0 then t:= trunc(rTime)

   135                                   else t:= trunc(rTime) - 100;

   136     repeat

   137       x:= x + dX;

   138       y:= y + dY;

   139       dX:= dX + cWindSpeed;

   140       dY:= dY + cGravity;

   141       if TestColl(round(x), round(y), 5) then

   142          begin

   143          if (Flags and ctfBreach) <> 0 then

   144             Result:= NoMyHHNear(round(x), round(y), 110);

   145          exit

   146          end;

   147       dec(t)

   148     until t <= 0;

   149     Result:= true

   150     end;

   151 

   152 begin

   153 Time:= 0;

   154 Result:= false;

   155 rTime:= 10;

   156 flHasTrace:= false;

   157 repeat

   158   rTime:= rTime + 100 + random*300;

   159   Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime;

   160   Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime;

   161   r:= sqr(Vx) + sqr(Vy);

   162   if r <= 1 then flHasTrace:= CheckTrace

   163 until flHasTrace or (rTime >= 5000);

   164 if not flHasTrace then exit;

   165 r:= sqrt(r);

   166 Angle:= DxDy2Angle(Vx, Vy);

   167 Power:= round(r * cMaxPower);

   168 Result:= true

   169 end;

   170 

   171 function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;

   172 var Vx, Vy, x, y: real;

   173 begin

   174 Time:= 0;

   175 Power:= 1;

   176 Vx:= (Targ.X - Me.X)/1024;

   177 Vy:= (Targ.Y - Me.Y)/1024;

   178 x:= Me.X;

   179 y:= Me.Y;

   180 Angle:= DxDy2Angle(Vx, -Vy);

   181 repeat

   182   x:= x + vX;

   183   y:= y + vY;

   184   if TestColl(round(x), round(y), 2) then

   185      begin

   186      if (Flags and ctfBreach) <> 0 then

   187         Result:= NoMyHHNear(round(x), round(y), 27)

   188         else Result:= false;

   189      exit

   190      end

   191 until (abs(Targ.X - x) + abs(Targ.Y - y) < 4) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024);

   192 Result:= true

   193 end;

   194 

   195 

   196 end.