author  unc0rr 
Wed, 18 Mar 2009 15:48:43 +0000  
changeset 1899  5763f46d7486 
parent 1753  2ccba26f1aa4 
child 1966  31e449e1d9dd 
permissions  rwrr 
4  1 
(* 
1066  2 
* Hedgewars, a free turn based strategy game 
883  3 
* Copyright (c) 20052008 Andrey Korotaev <unC0Rr@gmail.com> 
4  4 
* 
183  5 
* This program is free software; you can redistribute it and/or modify 
6 
* it under the terms of the GNU General Public License as published by 

7 
* the Free Software Foundation; version 2 of the License 

4  8 
* 
183  9 
* This program is distributed in the hope that it will be useful, 
10 
* but WITHOUT ANY WARRANTY; without even the implied warranty of 

11 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 

12 
* GNU General Public License for more details. 

4  13 
* 
183  14 
* You should have received a copy of the GNU General Public License 
15 
* along with this program; if not, write to the Free Software 

16 
* Foundation, Inc., 59 Temple Place  Suite 330, Boston, MA 021111307, USA 

4  17 
*) 
18 

19 
unit uCollisions; 

20 
interface 

351  21 
uses uGears, uFloat; 
4  22 
{$INCLUDE options.inc} 
53  23 
const cMaxGearArrayInd = 255; 
4  24 

70  25 
type PGearArray = ^TGearArray; 
1506  26 
TGearArray = record 
27 
ar: array[0..cMaxGearArrayInd] of PGear; 

28 
Count: Longword 

29 
end; 

4  30 

53  31 
procedure AddGearCI(Gear: PGear); 
32 
procedure DeleteCI(Gear: PGear); 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

33 

53  34 
function CheckGearsCollision(Gear: PGear): PGearArray; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

35 

371  36 
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean; 
37 
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean; 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

38 

69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

39 
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

40 
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

41 

371  42 
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

43 

498  44 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; 
371  45 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean; 
4  46 

47 
implementation 

511  48 
uses uMisc, uConsts, uLand, uLandGraphics, uConsole; 
4  49 

53  50 
type TCollisionEntry = record 
1506  51 
X, Y, Radius: LongInt; 
52 
cGear: PGear; 

53 
end; 

351  54 

906  55 
const MAXRECTSINDEX = 511; 
4  56 
var Count: Longword = 0; 
1506  57 
cinfos: array[0..MAXRECTSINDEX] of TCollisionEntry; 
58 
ga: TGearArray; 

4  59 

53  60 
procedure AddGearCI(Gear: PGear); 
61 
begin 

511  62 
if Gear^.CollisionIndex >= 0 then exit; 
4  63 
TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); 
53  64 
with cinfos[Count] do 
1506  65 
begin 
66 
X:= hwRound(Gear^.X); 

67 
Y:= hwRound(Gear^.Y); 

68 
Radius:= Gear^.Radius; 

69 
ChangeRoundInLand(X, Y, Radius  1, true); 

70 
cGear:= Gear 

71 
end; 

511  72 
Gear^.CollisionIndex:= Count; 
4  73 
inc(Count) 
74 
end; 

75 

53  76 
procedure DeleteCI(Gear: PGear); 
4  77 
begin 
511  78 
if Gear^.CollisionIndex >= 0 then 
1506  79 
begin 
80 
with cinfos[Gear^.CollisionIndex] do 

81 
ChangeRoundInLand(X, Y, Radius  1, false); 

82 
cinfos[Gear^.CollisionIndex]:= cinfos[Pred(Count)]; 

83 
cinfos[Gear^.CollisionIndex].cGear^.CollisionIndex:= Gear^.CollisionIndex; 

84 
Gear^.CollisionIndex:= 1; 

85 
dec(Count) 

86 
end; 

4  87 
end; 
88 

53  89 
function CheckGearsCollision(Gear: PGear): PGearArray; 
371  90 
var mx, my: LongInt; 
1506  91 
i: Longword; 
4  92 
begin 
1506  93 
CheckGearsCollision:= @ga; 
53  94 
ga.Count:= 0; 
12
366adfa1a727
Fix reading out of bounds of the collisions array. This fixes flying hedgehogs and not moving after explosion
unc0rr
parents:
4
diff
changeset

95 
if Count = 0 then exit; 
351  96 
mx:= hwRound(Gear^.X); 
97 
my:= hwRound(Gear^.Y); 

4  98 

99 
for i:= 0 to Pred(Count) do 

1506  100 
with cinfos[i] do 
101 
if (Gear <> cGear) and 

102 
(sqr(mx  x) + sqr(my  y) <= sqr(Radius + Gear^.Radius)) then 

103 
begin 

104 
ga.ar[ga.Count]:= cinfos[i].cGear; 

105 
inc(ga.Count) 

106 
end 

4  107 
end; 
108 

371  109 
function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean; 
110 
var x, y, i: LongInt; 

1506  111 
TestWord: LongWord; 
4  112 
begin 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

113 
if Gear^.IntersectGear <> nil then 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

114 
with Gear^ do 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

115 
if (hwRound(IntersectGear^.X) + IntersectGear^.Radius < hwRound(X)  Radius) or 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

116 
(hwRound(IntersectGear^.X)  IntersectGear^.Radius > hwRound(X) + Radius) then 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

117 
begin 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

118 
IntersectGear:= nil; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

119 
TestWord:= 0 
838  120 
end else 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

121 
TestWord:= COLOR_LAND  1 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

122 
else TestWord:= 0; 
838  123 

351  124 
x:= hwRound(Gear^.X); 
125 
if Dir < 0 then x:= x  Gear^.Radius 

126 
else x:= x + Gear^.Radius; 

1753  127 
if (x and LAND_WIDTH_MASK) = 0 then 
4  128 
begin 
351  129 
y:= hwRound(Gear^.Y)  Gear^.Radius + 1; 
130 
i:= y + Gear^.Radius * 2  2; 

4  131 
repeat 
1753  132 
if (y and LAND_HEIGHT_MASK) = 0 then 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

133 
if Land[y, x] > TestWord then exit(true); 
4  134 
inc(y) 
351  135 
until (y > i); 
136 
end; 

137 
TestCollisionXwithGear:= false 

4  138 
end; 
139 

505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

140 
function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): boolean; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

141 
var x, y, i: LongInt; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

142 
TestWord: LongWord; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

143 
begin 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

144 
if Gear^.IntersectGear <> nil then 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

145 
with Gear^ do 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

146 
if (hwRound(IntersectGear^.Y) + IntersectGear^.Radius < hwRound(Y)  Radius) or 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

147 
(hwRound(IntersectGear^.Y)  IntersectGear^.Radius > hwRound(Y) + Radius) then 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

148 
begin 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

149 
IntersectGear:= nil; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

150 
TestWord:= 0 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

151 
end else 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

152 
TestWord:= COLOR_LAND  1 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

153 
else TestWord:= 0; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

154 

fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

155 
y:= hwRound(Gear^.Y); 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

156 
if Dir < 0 then y:= y  Gear^.Radius 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

157 
else y:= y + Gear^.Radius; 
1753  158 
if (y and LAND_HEIGHT_MASK) = 0 then 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

159 
begin 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

160 
x:= hwRound(Gear^.X)  Gear^.Radius + 1; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

161 
i:= x + Gear^.Radius * 2  2; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

162 
repeat 
1753  163 
if (x and LAND_WIDTH_MASK) = 0 then 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

164 
if Land[y, x] > TestWord then exit(true); 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

165 
inc(x) 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

166 
until (x > i); 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

167 
end; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

168 
TestCollisionYwithGear:= false 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

169 
end; 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
504
diff
changeset

170 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

171 
function TestCollisionXKick(Gear: PGear; Dir: LongInt): boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

172 
var x, y, mx, my, i: LongInt; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

173 
flag: boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

174 
begin 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

175 
flag:= false; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

176 
x:= hwRound(Gear^.X); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

177 
if Dir < 0 then x:= x  Gear^.Radius 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

178 
else x:= x + Gear^.Radius; 
1753  179 
if (x and LAND_WIDTH_MASK) = 0 then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

180 
begin 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

181 
y:= hwRound(Gear^.Y)  Gear^.Radius + 1; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

182 
i:= y + Gear^.Radius * 2  2; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

183 
repeat 
1753  184 
if (y and LAND_HEIGHT_MASK) = 0 then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

185 
if Land[y, x] = COLOR_LAND then exit(true) 
536  186 
else if Land[y, x] <> 0 then flag:= true; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

187 
inc(y) 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

188 
until (y > i); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

189 
end; 
538  190 
TestCollisionXKick:= flag; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

191 

536  192 
if flag then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

193 
begin 
538  194 
if hwAbs(Gear^.dX) < cHHKick then exit; 
967  195 
if (Gear^.State and gstHHJumping <> 0) 
196 
and (hwAbs(Gear^.dX) < _0_4) then exit; 

197 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

198 
mx:= hwRound(Gear^.X); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

199 
my:= hwRound(Gear^.Y); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

200 

69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

201 
for i:= 0 to Pred(Count) do 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

202 
with cinfos[i] do 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

203 
if (Gear <> cGear) and 
855
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
839
diff
changeset

204 
(sqr(mx  x) + sqr(my  y) <= sqr(Radius + Gear^.Radius + 2)) and 
517  205 
((mx > x) xor (Dir > 0)) then 
1528  206 
if (cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0) then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

207 
begin 
521  208 
with cGear^ do 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

209 
begin 
536  210 
dX:= Gear^.dX; 
542  211 
dY:= Gear^.dY * _0_5; 
521  212 
State:= State or gstMoving; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

213 
Active:= true 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

214 
end; 
521  215 
DeleteCI(cGear); 
538  216 
exit(false) 
217 
end 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

218 
end 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

219 
end; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

220 

69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

221 
function TestCollisionYKick(Gear: PGear; Dir: LongInt): boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

222 
var x, y, mx, my, i: LongInt; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

223 
flag: boolean; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

224 
begin 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

225 
flag:= false; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

226 
y:= hwRound(Gear^.Y); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

227 
if Dir < 0 then y:= y  Gear^.Radius 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

228 
else y:= y + Gear^.Radius; 
1753  229 
if (y and LAND_HEIGHT_MASK) = 0 then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

230 
begin 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

231 
x:= hwRound(Gear^.X)  Gear^.Radius + 1; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

232 
i:= x + Gear^.Radius * 2  2; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

233 
repeat 
1753  234 
if (x and LAND_WIDTH_MASK) = 0 then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

235 
if Land[y, x] > 0 then 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

236 
if Land[y, x] = COLOR_LAND then exit(true) 
536  237 
else if Land[y, x] <> 0 then flag:= true; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

238 
inc(x) 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

239 
until (x > i); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

240 
end; 
538  241 
TestCollisionYKick:= flag; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

242 

536  243 
if flag then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

244 
begin 
839  245 
if hwAbs(Gear^.dY) < cHHKick then exit(true); 
967  246 
if (Gear^.State and gstHHJumping <> 0) 
247 
and (not Gear^.dY.isNegative) 

248 
and (Gear^.dY < _0_4) then exit; 

249 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

250 
mx:= hwRound(Gear^.X); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

251 
my:= hwRound(Gear^.Y); 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

252 

69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

253 
for i:= 0 to Pred(Count) do 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

254 
with cinfos[i] do 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

255 
if (Gear <> cGear) and 
855
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
839
diff
changeset

256 
(sqr(mx  x) + sqr(my  y) <= sqr(Radius + Gear^.Radius + 2)) and 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

257 
((my > y) xor (Dir > 0)) then 
1528  258 
if (cGear^.Kind in [gtHedgehog, gtMine]) and ((Gear^.State and gstNotKickable) = 0) then 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

259 
begin 
521  260 
with cGear^ do 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

261 
begin 
542  262 
dX:= Gear^.dX * _0_5; 
263 
dY:= Gear^.dY; 

521  264 
State:= State or gstMoving; 
513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

265 
Active:= true 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

266 
end; 
521  267 
DeleteCI(cGear); 
538  268 
exit(false) 
269 
end 

513
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

270 
end 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

271 
end; 
69e06d710d46
Moving hedgehog could get another hedgehog moving forward
unc0rr
parents:
511
diff
changeset

272 

498  273 
function TestCollisionXwithXYShift(Gear: PGear; ShiftX: hwFloat; ShiftY: LongInt; Dir: LongInt): boolean; 
4  274 
begin 
351  275 
Gear^.X:= Gear^.X + ShiftX; 
498  276 
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY); 
351  277 
TestCollisionXwithXYShift:= TestCollisionXwithGear(Gear, Dir); 
278 
Gear^.X:= Gear^.X  ShiftX; 

498  279 
Gear^.Y:= Gear^.Y  int2hwFloat(ShiftY) 
4  280 
end; 
281 

371  282 
function TestCollisionY(Gear: PGear; Dir: LongInt): boolean; 
283 
var x, y, i: LongInt; 

68  284 
begin 
351  285 
y:= hwRound(Gear^.Y); 
286 
if Dir < 0 then y:= y  Gear^.Radius 

287 
else y:= y + Gear^.Radius; 

1753  288 
if (y and LAND_HEIGHT_MASK) = 0 then 
68  289 
begin 
351  290 
x:= hwRound(Gear^.X)  Gear^.Radius + 1; 
291 
i:= x + Gear^.Radius * 2  2; 

68  292 
repeat 
1753  293 
if (x and LAND_WIDTH_MASK) = 0 then 
351  294 
if Land[y, x] = COLOR_LAND then exit(true); 
68  295 
inc(x) 
351  296 
until (x > i); 
297 
end; 

298 
TestCollisionY:= false 

68  299 
end; 
300 

371  301 
function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: LongInt; Dir: LongInt): boolean; 
4  302 
begin 
498  303 
Gear^.X:= Gear^.X + int2hwFloat(ShiftX); 
304 
Gear^.Y:= Gear^.Y + int2hwFloat(ShiftY); 

351  305 
TestCollisionYwithXYShift:= TestCollisionYwithGear(Gear, Dir); 
498  306 
Gear^.X:= Gear^.X  int2hwFloat(ShiftX); 
307 
Gear^.Y:= Gear^.Y  int2hwFloat(ShiftY) 

4  308 
end; 
309 

310 
end. 