18 |
18 |
19 {$INCLUDE "options.inc"} |
19 {$INCLUDE "options.inc"} |
20 |
20 |
21 unit uCollisions; |
21 unit uCollisions; |
22 interface |
22 interface |
23 uses uFloat, uTypes; |
23 uses uFloat, uTypes, uUtils; |
24 |
24 |
25 const cMaxGearArrayInd = 1023; |
25 const cMaxGearArrayInd = 1023; |
|
26 const cMaxGearHitOrderInd = 1023; |
26 |
27 |
27 type PGearArray = ^TGearArray; |
28 type PGearArray = ^TGearArray; |
28 TGearArray = record |
29 TGearArray = record |
29 ar: array[0..cMaxGearArrayInd] of PGear; |
30 ar: array[0..cMaxGearArrayInd] of PGear; |
|
31 cX: array[0..cMaxGearArrayInd] of LongInt; |
|
32 cY: array[0..cMaxGearArrayInd] of LongInt; |
30 Count: Longword |
33 Count: Longword |
|
34 end; |
|
35 |
|
36 type PGearHitOrder = ^TGearHitOrder; |
|
37 TGearHitOrder = record |
|
38 ar: array[0..cMaxGearHitOrderInd] of PGear; |
|
39 order: array[0..cMaxGearHitOrderInd] of LongInt; |
|
40 Count: Longword |
|
41 end; |
|
42 |
|
43 type TLineCollision = record |
|
44 hasCollision: Boolean; |
|
45 cX, cY: LongInt; //for visual effects only |
31 end; |
46 end; |
32 |
47 |
33 procedure initModule; |
48 procedure initModule; |
34 procedure freeModule; |
49 procedure freeModule; |
35 |
50 |
36 procedure AddCI(Gear: PGear); |
51 procedure AddCI(Gear: PGear); |
37 procedure DeleteCI(Gear: PGear); |
52 procedure DeleteCI(Gear: PGear); |
38 |
53 |
39 function CheckGearsCollision(Gear: PGear): PGearArray; |
54 function CheckGearsCollision(Gear: PGear): PGearArray; |
|
55 function CheckAllGearsCollision(SourceGear: PGear): PGearArray; |
|
56 |
|
57 function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; |
|
58 function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; |
|
59 |
|
60 function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean; |
|
61 procedure ClearHitOrderLeq(MinOrder: LongInt); |
|
62 procedure ClearHitOrder(); |
40 |
63 |
41 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; |
64 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; |
42 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; |
65 function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; |
43 |
66 |
44 function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word; |
67 function TestCollisionXKick(Gear: PGear; Dir: LongInt): Word; |
128 with cinfos[i] do |
152 with cinfos[i] do |
129 if (Gear <> cGear) and |
153 if (Gear <> cGear) and |
130 (sqr(mx - x) + sqr(my - y) <= sqr(Radius + tr)) then |
154 (sqr(mx - x) + sqr(my - y) <= sqr(Radius + tr)) then |
131 begin |
155 begin |
132 ga.ar[ga.Count]:= cinfos[i].cGear; |
156 ga.ar[ga.Count]:= cinfos[i].cGear; |
|
157 ga.cX[ga.Count]:= hwround(Gear^.X); |
|
158 ga.cY[ga.Count]:= hwround(Gear^.Y); |
133 inc(ga.Count) |
159 inc(ga.Count) |
134 end |
160 end |
|
161 end; |
|
162 |
|
163 function CheckAllGearsCollision(SourceGear: PGear): PGearArray; |
|
164 var mx, my, tr: LongInt; |
|
165 Gear: PGear; |
|
166 begin |
|
167 CheckAllGearsCollision:= @ga; |
|
168 ga.Count:= 0; |
|
169 |
|
170 mx:= hwRound(SourceGear^.X); |
|
171 my:= hwRound(SourceGear^.Y); |
|
172 |
|
173 tr:= SourceGear^.Radius + 2; |
|
174 |
|
175 Gear:= GearsList; |
|
176 |
|
177 while Gear <> nil do |
|
178 begin |
|
179 if (Gear <> SourceGear) and |
|
180 (sqr(mx - hwRound(Gear^.x)) + sqr(my - hwRound(Gear^.y)) <= sqr(Gear^.Radius + tr))then |
|
181 begin |
|
182 ga.ar[ga.Count]:= Gear; |
|
183 ga.cX[ga.Count]:= hwround(SourceGear^.X); |
|
184 ga.cY[ga.Count]:= hwround(SourceGear^.Y); |
|
185 inc(ga.Count) |
|
186 end; |
|
187 |
|
188 Gear := Gear^.NextGear |
|
189 end; |
|
190 end; |
|
191 |
|
192 function LineCollisionTest(oX, oY, dirX, dirY, dirNormSqr, dirNormBound: hwFloat; |
|
193 width: LongInt; Gear: PGear): |
|
194 TLineCollision; inline; |
|
195 var toCenterX, toCenterY, r, |
|
196 b, bSqr, c, desc, t: hwFloat; |
|
197 realT: extended; |
|
198 begin |
|
199 LineCollisionTest.hasCollision:= false; |
|
200 toCenterX:= (oX - Gear^.X); |
|
201 toCenterY:= (oY - Gear^.Y); |
|
202 r:= int2hwFloat(Gear^.Radius + width + 2); |
|
203 // Early cull to avoid multiplying large numbers |
|
204 if hwAbs(toCenterX) + hwAbs(toCenterY) > dirNormBound + r then |
|
205 exit; |
|
206 b:= dirX * toCenterX + dirY * toCenterY; |
|
207 c:= hwSqr(toCenterX) + hwSqr(toCenterY) - hwSqr(r); |
|
208 if (b > _0) and (c > _0) then |
|
209 exit; |
|
210 bSqr:= hwSqr(b); |
|
211 desc:= bSqr - dirNormSqr * c; |
|
212 if desc.isNegative then exit; |
|
213 |
|
214 t:= -b - hwSqrt(desc); |
|
215 if t.isNegative then t:= _0; |
|
216 if t < dirNormSqr then |
|
217 with LineCollisionTest do |
|
218 begin |
|
219 hasCollision:= true; |
|
220 realT := hwFloat2Float(t) / hwFloat2Float(dirNormSqr); |
|
221 cX:= round(hwFloat2Float(oX) + realT * hwFloat2Float(dirX)); |
|
222 cY:= round(hwFloat2Float(oY) + realT * hwFloat2Float(dirY)); |
|
223 end; |
|
224 end; |
|
225 |
|
226 function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; |
|
227 var dirX, dirY, dirNormSqr, dirNormBound: hwFloat; |
|
228 test: TLineCollision; |
|
229 i: Longword; |
|
230 begin |
|
231 CheckGearsLineCollision:= @ga; |
|
232 ga.Count:= 0; |
|
233 if Count = 0 then |
|
234 exit; |
|
235 dirX:= (tX - oX); |
|
236 dirY:= (tY - oY); |
|
237 dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY)); |
|
238 dirNormSqr:= hwSqr(dirX) + hwSqr(dirY); |
|
239 if dirNormSqr.isNegative then |
|
240 exit; |
|
241 |
|
242 for i:= 0 to Pred(Count) do |
|
243 with cinfos[i] do if Gear <> cGear then |
|
244 begin |
|
245 test:= LineCollisionTest( |
|
246 oX, oY, dirX, dirY, dirNormSqr, dirNormBound, Gear^.Radius, cGear); |
|
247 if test.hasCollision then |
|
248 begin |
|
249 ga.ar[ga.Count] := cGear; |
|
250 ga.cX[ga.Count] := test.cX; |
|
251 ga.cY[ga.Count] := test.cY; |
|
252 inc(ga.Count) |
|
253 end |
|
254 end |
|
255 end; |
|
256 |
|
257 function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray; |
|
258 var dirX, dirY, dirNormSqr, dirNormBound: hwFloat; |
|
259 test: TLineCollision; |
|
260 Gear: PGear; |
|
261 begin |
|
262 CheckAllGearsLineCollision:= @ga; |
|
263 ga.Count:= 0; |
|
264 dirX:= (tX - oX); |
|
265 dirY:= (tY - oY); |
|
266 dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY)); |
|
267 dirNormSqr:= hwSqr(dirX) + hwSqr(dirY); |
|
268 if dirNormSqr.isNegative then |
|
269 exit; |
|
270 |
|
271 Gear:= GearsList; |
|
272 while Gear <> nil do |
|
273 begin |
|
274 if SourceGear <> Gear then |
|
275 begin |
|
276 test:= LineCollisionTest( |
|
277 oX, oY, dirX, dirY, dirNormSqr, dirNormBound, SourceGear^.Radius, Gear); |
|
278 if test.hasCollision then |
|
279 begin |
|
280 ga.ar[ga.Count] := Gear; |
|
281 ga.cX[ga.Count] := test.cX; |
|
282 ga.cY[ga.Count] := test.cY; |
|
283 inc(ga.Count) |
|
284 end |
|
285 end; |
|
286 Gear := Gear^.NextGear |
|
287 end; |
|
288 end; |
|
289 |
|
290 function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean; |
|
291 var i: LongInt; |
|
292 begin |
|
293 UpdateHitOrder:= true; |
|
294 for i:= 0 to cMaxGearHitOrderInd do |
|
295 if ordera.ar[i] = Gear then |
|
296 begin |
|
297 if Order <= ordera.order[i] then UpdateHitOrder:= false; |
|
298 ordera.order[i]:= Max(ordera.order[i], order); |
|
299 exit; |
|
300 end; |
|
301 |
|
302 if ordera.Count > cMaxGearHitOrderInd then |
|
303 UpdateHitOrder:= false |
|
304 else |
|
305 begin |
|
306 ordera.ar[ordera.Count]:= Gear; |
|
307 ordera.order[ordera.Count]:= Order; |
|
308 Inc(ordera.Count); |
|
309 end |
|
310 end; |
|
311 |
|
312 procedure ClearHitOrderLeq(MinOrder: LongInt); |
|
313 var i, freeIndex: LongInt; |
|
314 begin; |
|
315 freeIndex:= 0; |
|
316 i:= 0; |
|
317 |
|
318 while i < ordera.Count do |
|
319 begin |
|
320 if ordera.order[i] <= MinOrder then |
|
321 Dec(ordera.Count) |
|
322 else |
|
323 begin |
|
324 if freeIndex < i then |
|
325 begin |
|
326 ordera.ar[freeIndex]:= ordera.ar[i]; |
|
327 ordera.order[freeIndex]:= ordera.order[i]; |
|
328 end; |
|
329 Inc(freeIndex); |
|
330 end; |
|
331 Inc(i) |
|
332 end |
|
333 end; |
|
334 |
|
335 procedure ClearHitOrder(); |
|
336 begin |
|
337 ordera.Count:= 0; |
135 end; |
338 end; |
136 |
339 |
137 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; |
340 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word; |
138 var x, y, i: LongInt; |
341 var x, y, i: LongInt; |
139 begin |
342 begin |