--- a/hedgewars/uCollisions.pas Mon Jan 15 12:15:56 2018 -0500
+++ b/hedgewars/uCollisions.pas Wed Jan 31 13:42:52 2018 -0500
@@ -20,16 +20,31 @@
unit uCollisions;
interface
-uses uFloat, uTypes;
+uses uFloat, uTypes, uUtils;
const cMaxGearArrayInd = 1023;
+const cMaxGearHitOrderInd = 1023;
type PGearArray = ^TGearArray;
TGearArray = record
ar: array[0..cMaxGearArrayInd] of PGear;
+ cX: array[0..cMaxGearArrayInd] of LongInt;
+ cY: array[0..cMaxGearArrayInd] of LongInt;
Count: Longword
end;
+type PGearHitOrder = ^TGearHitOrder;
+ TGearHitOrder = record
+ ar: array[0..cMaxGearHitOrderInd] of PGear;
+ order: array[0..cMaxGearHitOrderInd] of LongInt;
+ Count: Longword
+ end;
+
+type TLineCollision = record
+ hasCollision: Boolean;
+ cX, cY: LongInt; //for visual effects only
+ end;
+
procedure initModule;
procedure freeModule;
@@ -37,6 +52,14 @@
procedure DeleteCI(Gear: PGear);
function CheckGearsCollision(Gear: PGear): PGearArray;
+function CheckAllGearsCollision(SourceGear: PGear): PGearArray;
+
+function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray;
+function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray;
+
+function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean;
+procedure ClearHitOrderLeq(MinOrder: LongInt);
+procedure ClearHitOrder();
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word;
@@ -73,6 +96,7 @@
var Count: Longword;
cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
ga: TGearArray;
+ ordera: TGearHitOrder;
procedure AddCI(Gear: PGear);
begin
@@ -130,10 +154,189 @@
(sqr(mx - x) + sqr(my - y) <= sqr(Radius + tr)) then
begin
ga.ar[ga.Count]:= cinfos[i].cGear;
+ ga.cX[ga.Count]:= hwround(Gear^.X);
+ ga.cY[ga.Count]:= hwround(Gear^.Y);
inc(ga.Count)
end
end;
+function CheckAllGearsCollision(SourceGear: PGear): PGearArray;
+var mx, my, tr: LongInt;
+ Gear: PGear;
+begin
+ CheckAllGearsCollision:= @ga;
+ ga.Count:= 0;
+
+ mx:= hwRound(SourceGear^.X);
+ my:= hwRound(SourceGear^.Y);
+
+ tr:= SourceGear^.Radius + 2;
+
+ Gear:= GearsList;
+
+ while Gear <> nil do
+ begin
+ if (Gear <> SourceGear) and
+ (sqr(mx - hwRound(Gear^.x)) + sqr(my - hwRound(Gear^.y)) <= sqr(Gear^.Radius + tr))then
+ begin
+ ga.ar[ga.Count]:= Gear;
+ ga.cX[ga.Count]:= hwround(SourceGear^.X);
+ ga.cY[ga.Count]:= hwround(SourceGear^.Y);
+ inc(ga.Count)
+ end;
+
+ Gear := Gear^.NextGear
+ end;
+end;
+
+function LineCollisionTest(oX, oY, dirX, dirY, dirNormSqr, dirNormBound: hwFloat;
+ width: LongInt; Gear: PGear):
+ TLineCollision; inline;
+var toCenterX, toCenterY, r,
+ b, bSqr, c, desc, t: hwFloat;
+ realT: extended;
+begin
+ LineCollisionTest.hasCollision:= false;
+ toCenterX:= (oX - Gear^.X);
+ toCenterY:= (oY - Gear^.Y);
+ r:= int2hwFloat(Gear^.Radius + width + 2);
+ // Early cull to avoid multiplying large numbers
+ if hwAbs(toCenterX) + hwAbs(toCenterY) > dirNormBound + r then
+ exit;
+ b:= dirX * toCenterX + dirY * toCenterY;
+ c:= hwSqr(toCenterX) + hwSqr(toCenterY) - hwSqr(r);
+ if (b > _0) and (c > _0) then
+ exit;
+ bSqr:= hwSqr(b);
+ desc:= bSqr - dirNormSqr * c;
+ if desc.isNegative then exit;
+
+ t:= -b - hwSqrt(desc);
+ if t.isNegative then t:= _0;
+ if t < dirNormSqr then
+ with LineCollisionTest do
+ begin
+ hasCollision:= true;
+ realT := hwFloat2Float(t) / hwFloat2Float(dirNormSqr);
+ cX:= round(hwFloat2Float(oX) + realT * hwFloat2Float(dirX));
+ cY:= round(hwFloat2Float(oY) + realT * hwFloat2Float(dirY));
+ end;
+end;
+
+function CheckGearsLineCollision(Gear: PGear; oX, oY, tX, tY: hwFloat): PGearArray;
+var dirX, dirY, dirNormSqr, dirNormBound: hwFloat;
+ test: TLineCollision;
+ i: Longword;
+begin
+ CheckGearsLineCollision:= @ga;
+ ga.Count:= 0;
+ if Count = 0 then
+ exit;
+ dirX:= (tX - oX);
+ dirY:= (tY - oY);
+ dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY));
+ dirNormSqr:= hwSqr(dirX) + hwSqr(dirY);
+ if dirNormSqr.isNegative then
+ exit;
+
+ for i:= 0 to Pred(Count) do
+ with cinfos[i] do if Gear <> cGear then
+ begin
+ test:= LineCollisionTest(
+ oX, oY, dirX, dirY, dirNormSqr, dirNormBound, Gear^.Radius, cGear);
+ if test.hasCollision then
+ begin
+ ga.ar[ga.Count] := cGear;
+ ga.cX[ga.Count] := test.cX;
+ ga.cY[ga.Count] := test.cY;
+ inc(ga.Count)
+ end
+ end
+end;
+
+function CheckAllGearsLineCollision(SourceGear: PGear; oX, oY, tX, tY: hwFloat): PGearArray;
+var dirX, dirY, dirNormSqr, dirNormBound: hwFloat;
+ test: TLineCollision;
+ Gear: PGear;
+begin
+ CheckAllGearsLineCollision:= @ga;
+ ga.Count:= 0;
+ dirX:= (tX - oX);
+ dirY:= (tY - oY);
+ dirNormBound:= _1_5 * (hwAbs(dirX) + hwAbs(dirY));
+ dirNormSqr:= hwSqr(dirX) + hwSqr(dirY);
+ if dirNormSqr.isNegative then
+ exit;
+
+ Gear:= GearsList;
+ while Gear <> nil do
+ begin
+ if SourceGear <> Gear then
+ begin
+ test:= LineCollisionTest(
+ oX, oY, dirX, dirY, dirNormSqr, dirNormBound, SourceGear^.Radius, Gear);
+ if test.hasCollision then
+ begin
+ ga.ar[ga.Count] := Gear;
+ ga.cX[ga.Count] := test.cX;
+ ga.cY[ga.Count] := test.cY;
+ inc(ga.Count)
+ end
+ end;
+ Gear := Gear^.NextGear
+ end;
+end;
+
+function UpdateHitOrder(Gear: PGear; Order: LongInt): boolean;
+var i: LongInt;
+begin
+UpdateHitOrder:= true;
+for i:= 0 to cMaxGearHitOrderInd do
+ if ordera.ar[i] = Gear then
+ begin
+ if Order <= ordera.order[i] then UpdateHitOrder:= false;
+ ordera.order[i]:= Max(ordera.order[i], order);
+ exit;
+ end;
+
+if ordera.Count > cMaxGearHitOrderInd then
+ UpdateHitOrder:= false
+else
+ begin
+ ordera.ar[ordera.Count]:= Gear;
+ ordera.order[ordera.Count]:= Order;
+ Inc(ordera.Count);
+ end
+end;
+
+procedure ClearHitOrderLeq(MinOrder: LongInt);
+var i, freeIndex: LongInt;
+begin;
+freeIndex:= 0;
+i:= 0;
+
+while i < ordera.Count do
+ begin
+ if ordera.order[i] <= MinOrder then
+ Dec(ordera.Count)
+ else
+ begin
+ if freeIndex < i then
+ begin
+ ordera.ar[freeIndex]:= ordera.ar[i];
+ ordera.order[freeIndex]:= ordera.order[i];
+ end;
+ Inc(freeIndex);
+ end;
+ Inc(i)
+ end
+end;
+
+procedure ClearHitOrder();
+begin
+ ordera.Count:= 0;
+end;
+
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): Word;
var x, y, i: LongInt;
begin