diff -r 856570ddd409 -r 8a40ce061d94 hedgewars/uCollisions.pas --- 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