hedgewars/uCollisions.pas
changeset 1506 a4ab75470ce1
parent 1066 1f1b3686a2b0
child 1528 3fee15104c1d
equal deleted inserted replaced
1505:3a96e93572cb 1506:a4ab75470ce1
    21 uses uGears, uFloat;
    21 uses uGears, uFloat;
    22 {$INCLUDE options.inc}
    22 {$INCLUDE options.inc}
    23 const cMaxGearArrayInd = 255;
    23 const cMaxGearArrayInd = 255;
    24 
    24 
    25 type PGearArray = ^TGearArray;
    25 type PGearArray = ^TGearArray;
    26      TGearArray = record
    26 	TGearArray = record
    27                   ar: array[0..cMaxGearArrayInd] of PGear;
    27 			ar: array[0..cMaxGearArrayInd] of PGear;
    28                   Count: Longword
    28 			Count: Longword
    29                   end;
    29 			end;
    30 
    30 
    31 procedure AddGearCI(Gear: PGear);
    31 procedure AddGearCI(Gear: PGear);
    32 procedure DeleteCI(Gear: PGear);
    32 procedure DeleteCI(Gear: PGear);
    33 
    33 
    34 function CheckGearsCollision(Gear: PGear): PGearArray;
    34 function CheckGearsCollision(Gear: PGear): PGearArray;
    46 
    46 
    47 implementation
    47 implementation
    48 uses uMisc, uConsts, uLand, uLandGraphics, uConsole;
    48 uses uMisc, uConsts, uLand, uLandGraphics, uConsole;
    49 
    49 
    50 type TCollisionEntry = record
    50 type TCollisionEntry = record
    51                        X, Y, Radius: LongInt;
    51 			X, Y, Radius: LongInt;
    52                        cGear: PGear;
    52 			cGear: PGear;
    53                        end;
    53 			end;
    54 
    54 
    55 const MAXRECTSINDEX = 511;
    55 const MAXRECTSINDEX = 511;
    56 var Count: Longword = 0;
    56 var Count: Longword = 0;
    57     cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
    57 	cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry;
    58     ga: TGearArray;
    58 	ga: TGearArray;
    59 
    59 
    60 procedure AddGearCI(Gear: PGear);
    60 procedure AddGearCI(Gear: PGear);
    61 begin
    61 begin
    62 if Gear^.CollisionIndex >= 0 then exit;
    62 if Gear^.CollisionIndex >= 0 then exit;
    63 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
    63 TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
    64 with cinfos[Count] do
    64 with cinfos[Count] do
    65      begin
    65 	begin
    66      X:= hwRound(Gear^.X);
    66 	X:= hwRound(Gear^.X);
    67      Y:= hwRound(Gear^.Y);
    67 	Y:= hwRound(Gear^.Y);
    68      Radius:= Gear^.Radius;
    68 	Radius:= Gear^.Radius;
    69      ChangeRoundInLand(X, Y, Radius - 1, true);
    69 	ChangeRoundInLand(X, Y, Radius - 1, true);
    70      cGear:= Gear
    70 	cGear:= Gear
    71      end;
    71 	end;
    72 Gear^.CollisionIndex:= Count;
    72 Gear^.CollisionIndex:= Count;
    73 inc(Count)
    73 inc(Count)
    74 end;
    74 end;
    75 
    75 
    76 procedure DeleteCI(Gear: PGear);
    76 procedure DeleteCI(Gear: PGear);
    77 begin
    77 begin
    78 if Gear^.CollisionIndex >= 0 then
    78 if Gear^.CollisionIndex >= 0 then
    79    begin
    79 	begin
    80    with cinfos[Gear^.CollisionIndex] do
    80 	with cinfos[Gear^.CollisionIndex] do
    81         ChangeRoundInLand(X, Y, Radius - 1, false);
    81 		ChangeRoundInLand(X, Y, Radius - 1, false);
    82    cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
    82 	cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)];
    83    cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
    83 	cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex;
    84    Gear^.CollisionIndex:= -1;
    84 	Gear^.CollisionIndex:= -1;
    85    dec(Count)
    85 	dec(Count)
    86    end;
    86 	end;
    87 end;
    87 end;
    88 
    88 
    89 function CheckGearsCollision(Gear: PGear): PGearArray;
    89 function CheckGearsCollision(Gear: PGear): PGearArray;
    90 var mx, my: LongInt;
    90 var mx, my: LongInt;
    91     i: Longword;
    91 	i: Longword;
    92     Result: PGearArray;
    92 begin
    93 begin
    93 CheckGearsCollision:= @ga;
    94 Result:= @ga;
       
    95 ga.Count:= 0;
    94 ga.Count:= 0;
    96 if Count = 0 then exit;
    95 if Count = 0 then exit;
    97 mx:= hwRound(Gear^.X);
    96 mx:= hwRound(Gear^.X);
    98 my:= hwRound(Gear^.Y);
    97 my:= hwRound(Gear^.Y);
    99 
    98 
   100 for i:= 0 to Pred(Count) do
    99 for i:= 0 to Pred(Count) do
   101    with cinfos[i] do
   100 	with cinfos[i] do
   102       if (Gear <> cGear) and
   101 		if (Gear <> cGear) and
   103          (sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
   102 			(sqr(mx - x) + sqr(my - y) <= sqr(Radius + Gear^.Radius)) then
   104              begin
   103 				begin
   105              ga.ar[ga.Count]:= cinfos[i].cGear;
   104 				ga.ar[ga.Count]:= cinfos[i].cGear;
   106              inc(ga.Count)
   105 				inc(ga.Count)
   107              end;
   106 				end
   108 CheckGearsCollision:= Result
       
   109 end;
   107 end;
   110 
   108 
   111 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   109 function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean;
   112 var x, y, i: LongInt;
   110 var x, y, i: LongInt;
   113     TestWord: LongWord;
   111 	TestWord: LongWord;
   114 begin
   112 begin
   115 if Gear^.IntersectGear <> nil then
   113 if Gear^.IntersectGear <> nil then
   116    with Gear^ do
   114    with Gear^ do
   117         if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius) or
   115         if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X) - Radius) or
   118            (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then
   116            (hwRound(IntersectGear^.X) - IntersectGear^.Radius > hwRound(X) + Radius) then