1 (* |
|
2 * Hedgewars, a worms-like game |
|
3 * Copyright (c) 2005, 2006 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; |
1 unit uAIAmmoTests; |
35 interface |
2 interface |
36 uses uConsts, SDLh; |
3 uses 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 function TestDEagle(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
|
45 |
4 |
46 type TAmmoTestProc = function (Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
5 function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer; |
47 const AmmoTests: array[TAmmoType] of |
|
48 record |
|
49 Test: TAmmoTestProc; |
|
50 Flags: Longword; |
|
51 end = ( |
|
52 ( Test: TestGrenade; |
|
53 Flags: ctfNotFull; |
|
54 ), |
|
55 ( Test: TestBazooka; |
|
56 Flags: ctfNotFull or ctfBreach; |
|
57 ), |
|
58 ( Test: nil; |
|
59 Flags: 0; |
|
60 ), |
|
61 ( Test: TestShotgun; |
|
62 Flags: ctfBreach; |
|
63 ), |
|
64 ( Test: nil; |
|
65 Flags: 0; |
|
66 ), |
|
67 ( Test: nil; |
|
68 Flags: 0; |
|
69 ), |
|
70 ( Test: nil; |
|
71 Flags: 0; |
|
72 ), |
|
73 ( Test: nil; |
|
74 Flags: 0; |
|
75 ), |
|
76 ( Test: TestDEagle; |
|
77 Flags: 0; |
|
78 ), |
|
79 ( Test: nil; |
|
80 Flags: 0; |
|
81 ) |
|
82 ); |
|
83 |
6 |
84 implementation |
7 implementation |
85 uses uMisc, uAIMisc, uLand; |
8 uses uMisc, uAIMisc; |
|
9 const cMyHHDamageScore = -3000; |
86 |
10 |
87 function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
11 function Metric(x1, y1, x2, y2: integer): integer; |
88 var Vx, Vy, r: real; |
|
89 flHasTrace: boolean; |
|
90 |
|
91 function CheckTrace: boolean; |
|
92 var x, y, dY: real; |
|
93 t: integer; |
|
94 begin |
|
95 x:= Me.X; |
|
96 y:= Me.Y; |
|
97 dY:= -Vy; |
|
98 Result:= false; |
|
99 if (Flags and ctfNotFull) = 0 then t:= Time |
|
100 else t:= Time - 100; |
|
101 repeat |
|
102 x:= x + Vx; |
|
103 y:= y + dY; |
|
104 dY:= dY + cGravity; |
|
105 if TestColl(round(x), round(y), 5) then exit; |
|
106 dec(t); |
|
107 until t <= 0; |
|
108 Result:= true |
|
109 end; |
|
110 |
|
111 begin |
12 begin |
112 Result:= false; |
13 Result:= abs(x1 - x2) + abs(y1 - y2) |
113 Time:= 0; |
|
114 flHasTrace:= false; |
|
115 repeat |
|
116 inc(Time, 1000); |
|
117 Vx:= (Targ.X - Me.X) / Time; |
|
118 Vy:= cGravity*(Time div 2) - (Targ.Y - Me.Y) / Time; |
|
119 r:= sqr(Vx) + sqr(Vy); |
|
120 if r <= 1 then flHasTrace:= CheckTrace |
|
121 else exit |
|
122 until flHasTrace or (Time = 5000); |
|
123 if not flHasTrace then exit; |
|
124 r:= sqrt(r); |
|
125 Angle:= DxDy2Angle(Vx, Vy); |
|
126 Power:= round(r * cMaxPower); |
|
127 Result:= true |
|
128 end; |
14 end; |
129 |
15 |
130 function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
16 function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer; |
131 var Vx, Vy, r: real; |
17 var Vx, Vy, r: real; |
132 rTime: real; |
18 rTime: real; |
133 flHasTrace: boolean; |
19 Score: integer; |
134 |
20 |
135 function CheckTrace: boolean; |
21 function CheckTrace: integer; |
136 var x, y, dX, dY: real; |
22 var x, y, dX, dY: real; |
137 t: integer; |
23 t: integer; |
138 begin |
24 begin |
139 x:= Me.X; |
25 x:= Me.X; |
140 y:= Me.Y; |
26 y:= Me.Y; |
141 dX:= Vx; |
27 dX:= Vx; |
142 dY:= -Vy; |
28 dY:= -Vy; |
143 Result:= false; |
29 t:= trunc(rTime); |
144 if (Flags and ctfNotFull) = 0 then t:= trunc(rTime) |
|
145 else t:= trunc(rTime) - 100; |
|
146 repeat |
30 repeat |
147 x:= x + dX; |
31 x:= x + dX; |
148 y:= y + dY; |
32 y:= y + dY; |
149 dX:= dX + cWindSpeed; |
33 dX:= dX + cWindSpeed; |
150 dY:= dY + cGravity; |
34 dY:= dY + cGravity; |
151 if TestColl(round(x), round(y), 5) then |
|
152 begin |
|
153 if (Flags and ctfBreach) <> 0 then |
|
154 Result:= NoMyHHNear(round(x), round(y), 110); |
|
155 exit |
|
156 end; |
|
157 dec(t) |
35 dec(t) |
158 until t <= 0; |
36 until TestColl(round(x), round(y), 5) or (t <= 0); |
159 Result:= true |
37 if NoMyHHNear(round(x), round(y), 110) then |
|
38 Result:= - Metric(round(x), round(y), Targ.x, Targ.y) div 16 |
|
39 else Result:= cMyHHDamageScore; |
160 end; |
40 end; |
161 |
41 |
162 begin |
42 begin |
163 Time:= 0; |
43 Time:= 0; |
164 Result:= false; |
|
165 rTime:= 10; |
44 rTime:= 10; |
166 flHasTrace:= false; |
45 Result:= Low(integer); |
167 repeat |
46 repeat |
168 rTime:= rTime + 100 + random*300; |
47 rTime:= rTime + 70 + random*200; |
169 Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime; |
48 Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime; |
170 Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime; |
49 Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime; |
171 r:= sqr(Vx) + sqr(Vy); |
50 r:= sqr(Vx) + sqr(Vy); |
172 if r <= 1 then flHasTrace:= CheckTrace |
51 if r <= 1 then |
173 until flHasTrace or (rTime >= 5000); |
|
174 if not flHasTrace then exit; |
|
175 r:= sqrt(r); |
|
176 Angle:= DxDy2Angle(Vx, Vy); |
|
177 Power:= round(r * cMaxPower); |
|
178 Result:= true |
|
179 end; |
|
180 |
|
181 function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
|
182 var Vx, Vy, x, y: real; |
|
183 begin |
|
184 if abs(Me.X - Targ.X) + abs(Me.Y - Targ.Y) < 80 then |
|
185 begin |
|
186 Result:= false; |
|
187 exit |
|
188 end; |
|
189 Time:= 0; |
|
190 Power:= 1; |
|
191 Vx:= (Targ.X - Me.X)/1024; |
|
192 Vy:= (Targ.Y - Me.Y)/1024; |
|
193 x:= Me.X; |
|
194 y:= Me.Y; |
|
195 Angle:= DxDy2Angle(Vx, -Vy); |
|
196 repeat |
|
197 x:= x + vX; |
|
198 y:= y + vY; |
|
199 if TestColl(round(x), round(y), 2) then |
|
200 begin |
52 begin |
201 if (Flags and ctfBreach) <> 0 then |
53 Score:= CheckTrace; |
202 Result:= NoMyHHNear(round(x), round(y), 27) |
54 if Result <= Score then |
203 else Result:= false; |
55 begin |
204 exit |
56 r:= sqrt(r); |
|
57 Angle:= DxDy2AttackAngle(Vx, Vy); |
|
58 Power:= round(r * cMaxPower); |
|
59 Result:= Score |
|
60 end; |
205 end |
61 end |
206 until (abs(Targ.X - x) + abs(Targ.Y - y) < 4) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024); |
62 until (rTime >= 5000) |
207 Result:= true |
|
208 end; |
|
209 |
|
210 function TestDEagle(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; |
|
211 var Vx, Vy, x, y: real; |
|
212 d: Longword; |
|
213 begin |
|
214 if abs(Me.X - Targ.X) + abs(Me.Y - Targ.Y) < 80 then |
|
215 begin |
|
216 Result:= false; |
|
217 exit |
|
218 end; |
|
219 Time:= 0; |
|
220 Power:= 1; |
|
221 Vx:= (Targ.X - Me.X)/1024; |
|
222 Vy:= (Targ.Y - Me.Y)/1024; |
|
223 x:= Me.X; |
|
224 y:= Me.Y; |
|
225 Angle:= DxDy2Angle(Vx, -Vy); |
|
226 d:= 0; |
|
227 repeat |
|
228 x:= x + vX; |
|
229 y:= y + vY; |
|
230 if ((round(x) and $FFFFF800) = 0)and((round(y) and $FFFFFC00) = 0) |
|
231 and (Land[round(y), round(x)] <> 0) then inc(d); |
|
232 until (abs(Targ.X - x) + abs(Targ.Y - y) < 2) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024); |
|
233 Result:= d < 50 |
|
234 end; |
63 end; |
235 |
64 |
236 end. |
65 end. |