|
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. |