author  unc0rr 
Thu, 08 May 2008 14:22:19 +0000  
changeset 913  a86f8af21b94 
parent 912  acab672fb1aa 
child 914  c2fcafbfc4aa 
permissions  rwrr 
4  1 
(* 
2 
* Hedgewars, a wormslike game 

883  3 
* Copyright (c) 20042008 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 
procedure doStepDrowningGear(Gear: PGear); forward; 

20 

21 
function CheckGearDrowning(Gear: PGear): boolean; 

22 
begin 

498  23 
if cWaterLine < hwRound(Gear^.Y) + Gear^.Radius then 
4  24 
begin 
351  25 
CheckGearDrowning:= true; 
26 
Gear^.State:= gstDrowning; 

27 
Gear^.doStep:= @doStepDrowningGear; 

28 
PlaySound(sndSplash, false) 

29 
end else 

30 
CheckGearDrowning:= false 

4  31 
end; 
32 

33 
procedure CheckCollision(Gear: PGear); 

34 
begin 

351  35 
if TestCollisionXwithGear(Gear, hwSign(Gear^.X)) or TestCollisionYwithGear(Gear, hwSign(Gear^.Y)) 
36 
then Gear^.State:= Gear^.State or gstCollision 

37 
else Gear^.State:= Gear^.State and not gstCollision 

4  38 
end; 
39 

40 
procedure CheckHHDamage(Gear: PGear); 

522  41 
var dmg: Longword; 
4  42 
begin 
522  43 
if _0_4 < Gear^.dY then 
44 
begin 

45 
dmg:= 1 + hwRound((hwAbs(Gear^.dY)  _0_4) * 70); 

46 
inc(Gear^.Damage, dmg); 

47 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y) + cHHRadius, dmg, Gear); 

48 
end 

4  49 
end; 
50 

51 
//////////////////////////////////////////////////////////////////////////////// 

52 
//////////////////////////////////////////////////////////////////////////////// 

53 
procedure CalcRotationDirAngle(Gear: PGear); 

776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
764
diff
changeset

54 
var dAngle: real; 
4  55 
begin 
776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
764
diff
changeset

56 
dAngle:= (hwAbs(Gear^.dX) + hwAbs(Gear^.dY)).QWordValue / $80000000; 
351  57 
if not Gear^.dX.isNegative then Gear^.DirAngle:= Gear^.DirAngle + dAngle 
58 
else Gear^.DirAngle:= Gear^.DirAngle  dAngle; 

776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
764
diff
changeset

59 
if Gear^.DirAngle < 0 then Gear^.DirAngle:= Gear^.DirAngle + 360 
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
764
diff
changeset

60 
else if 360 < Gear^.DirAngle then Gear^.DirAngle:= Gear^.DirAngle  360 
4  61 
end; 
62 

63 
//////////////////////////////////////////////////////////////////////////////// 

64 
procedure doStepDrowningGear(Gear: PGear); 

65 
begin 

66 
AllInactive:= false; 

351  67 
Gear^.Y:= Gear^.Y + cDrownSpeed; 
68 
if hwRound(Gear^.Y) > Gear^.Radius + cWaterLine + cVisibleWater then DeleteGear(Gear) 

4  69 
end; 
70 

71 
//////////////////////////////////////////////////////////////////////////////// 

72 
procedure doStepFallingGear(Gear: PGear); 

542  73 
var isFalling: boolean; 
4  74 
begin 
503  75 
Gear^.State:= Gear^.State and not gstCollision; 
76 

77 
if Gear^.dY.isNegative then 

4  78 
begin 
542  79 
isFalling:= true; 
503  80 
if TestCollisionYwithGear(Gear, 1) then 
81 
begin 

82 
Gear^.dX:= Gear^.dX * Gear^.Friction; 

83 
Gear^.dY:=  Gear^.dY * Gear^.Elasticity; 

84 
Gear^.State:= Gear^.State or gstCollision 

85 
end 

86 
end else 

87 
if TestCollisionYwithGear(Gear, 1) then 

88 
begin 

542  89 
isFalling:= false; 
503  90 
Gear^.dX:= Gear^.dX * Gear^.Friction; 
91 
Gear^.dY:=  Gear^.dY * Gear^.Elasticity; 

92 
Gear^.State:= Gear^.State or gstCollision 

542  93 
end else isFalling:= true; 
503  94 

351  95 
if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) then 
4  96 
begin 
351  97 
Gear^.dX:=  Gear^.dX * Gear^.Elasticity; 
98 
Gear^.State:= Gear^.State or gstCollision 

4  99 
end; 
503  100 

542  101 
if isFalling then Gear^.dY:= Gear^.dY + cGravity; 
503  102 

351  103 
Gear^.X:= Gear^.X + Gear^.dX; 
104 
Gear^.Y:= Gear^.Y + Gear^.dY; 

4  105 
CheckGearDrowning(Gear); 
503  106 
if (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) < _0_0002) and 
542  107 
(not isFalling) then Gear^.State:= Gear^.State and not gstMoving 
108 
else Gear^.State:= Gear^.State or gstMoving 

4  109 
end; 
110 

111 
//////////////////////////////////////////////////////////////////////////////// 

112 
procedure doStepBomb(Gear: PGear); 

371  113 
var i: LongInt; 
4  114 
begin 
115 
AllInactive:= false; 

116 
doStepFallingGear(Gear); 

351  117 
dec(Gear^.Timer); 
118 
if Gear^.Timer = 0 then 

4  119 
begin 
351  120 
case Gear^.Kind of 
121 
gtAmmo_Bomb: doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound); 

78  122 
gtClusterBomb: begin 
351  123 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 30, EXPLAutoSound); 
78  124 
for i:= 0 to 4 do 
498  125 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtCluster, 0, (getrandom  _0_5) * _0_2, (getrandom  _3) * _0_08, 0); 
78  126 
end 
127 
end; 

4  128 
DeleteGear(Gear); 
129 
exit 

130 
end; 

131 
CalcRotationDirAngle(Gear); 

351  132 
if (Gear^.State and (gstCollision or gstMoving)) = (gstCollision or gstMoving) then PlaySound(sndGrenadeImpact, false) 
4  133 
end; 
134 

78  135 
procedure doStepCluster(Gear: PGear); 
136 
begin 

137 
AllInactive:= false; 

138 
doStepFallingGear(Gear); 

351  139 
if (Gear^.State and gstCollision) <> 0 then 
78  140 
begin 
351  141 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 20, EXPLAutoSound); 
78  142 
DeleteGear(Gear); 
143 
exit 

144 
end; 

145 
if (GameTicks and $1F) = 0 then 

498  146 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtSmokeTrace, 0, _0, _0, 0) 
78  147 
end; 
148 

4  149 
//////////////////////////////////////////////////////////////////////////////// 
150 
procedure doStepGrenade(Gear: PGear); 

151 
begin 

152 
AllInactive:= false; 

351  153 
Gear^.dX:= Gear^.dX + cWindSpeed; 
4  154 
doStepFallingGear(Gear); 
351  155 
if (Gear^.State and gstCollision) <> 0 then 
4  156 
begin 
351  157 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound); 
4  158 
DeleteGear(Gear); 
159 
exit 

160 
end; 

161 
if (GameTicks and $3F) = 0 then 

498  162 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtSmokeTrace, 0, _0, _0, 0) 
4  163 
end; 
164 

165 
//////////////////////////////////////////////////////////////////////////////// 

95  166 
procedure doStepHealthTagWork(Gear: PGear); 
4  167 
begin 
522  168 
if Gear^.Kind = gtHealthTag then 
169 
AllInactive:= false; 

351  170 
dec(Gear^.Timer); 
522  171 
Gear^.Y:= Gear^.Y + Gear^.dY; 
351  172 
if Gear^.Timer = 0 then 
4  173 
begin 
522  174 
if Gear^.Kind = gtHealthTag then 
175 
PHedgehog(Gear^.Hedgehog)^.Gear^.Active:= true; // to let current hh die 

4  176 
DeleteGear(Gear) 
177 
end 

178 
end; 

179 

263  180 
procedure doStepHealthTagWorkUnderWater(Gear: PGear); 
181 
begin 

182 
AllInactive:= false; 

351  183 
Gear^.Y:= Gear^.Y  _0_08; 
498  184 
if hwRound(Gear^.Y) < cWaterLine + 10 then 
263  185 
DeleteGear(Gear) 
186 
end; 

187 

95  188 
procedure doStepHealthTag(Gear: PGear); 
189 
var s: shortstring; 

522  190 
font: THWFont; 
95  191 
begin 
522  192 
if Gear^.Kind = gtHealthTag then 
193 
begin 

813  194 
AllInactive:= false; 
522  195 
font:= fnt16; 
196 
Gear^.dY:= _0_08 

197 
end else 

198 
begin 

199 
font:= fntSmall; 

200 
Gear^.dY:= _0_02 

201 
end; 

202 

351  203 
str(Gear^.State, s); 
762  204 
Gear^.Tex:= RenderStringTex(s, PHedgehog(Gear^.Hedgehog)^.Team^.Clan^.Color, font); 
498  205 
if hwRound(Gear^.Y) < cWaterLine then Gear^.doStep:= @doStepHealthTagWork 
522  206 
else Gear^.doStep:= @doStepHealthTagWorkUnderWater; 
762  207 
Gear^.Y:= Gear^.Y  int2hwFloat(Gear^.Tex^.h) 
95  208 
end; 
209 

4  210 
//////////////////////////////////////////////////////////////////////////////// 
211 
procedure doStepGrave(Gear: PGear); 

212 
begin 

213 
AllInactive:= false; 

498  214 
if Gear^.dY.isNegative then 
215 
if TestCollisionY(Gear, 1) then Gear^.dY:= _0; 

4  216 

351  217 
if not Gear^.dY.isNegative then 
68  218 
if TestCollisionY(Gear, 1) then 
4  219 
begin 
351  220 
Gear^.dY:=  Gear^.dY * Gear^.Elasticity; 
221 
if Gear^.dY >  _1div1024 then 

4  222 
begin 
351  223 
Gear^.Active:= false; 
4  224 
exit 
351  225 
end else if Gear^.dY <  _0_03 then PlaySound(sndGraveImpact, false) 
4  226 
end; 
351  227 
Gear^.Y:= Gear^.Y + Gear^.dY; 
4  228 
CheckGearDrowning(Gear); 
351  229 
Gear^.dY:= Gear^.dY + cGravity 
4  230 
end; 
231 

232 
//////////////////////////////////////////////////////////////////////////////// 

233 
procedure doStepUFOWork(Gear: PGear); 

351  234 
var t: hwFloat; 
374  235 
y: LongInt; 
4  236 
begin 
237 
AllInactive:= false; 

351  238 
t:= Distance(Gear^.dX, Gear^.dY); 
239 
Gear^.dX:= Gear^.Elasticity * (Gear^.dX + _0_000004 * (TargetPoint.X  hwRound(Gear^.X))); 

240 
Gear^.dY:= Gear^.Elasticity * (Gear^.dY + _0_000004 * (TargetPoint.Y  hwRound(Gear^.Y))); 

241 
t:= t / Distance(Gear^.dX, Gear^.dY); 

242 
Gear^.dX:= Gear^.dX * t; 

243 
Gear^.dY:= Gear^.dY * t; 

244 
Gear^.X:= Gear^.X + Gear^.dX; 

245 
Gear^.Y:= Gear^.Y + Gear^.dY; 

374  246 

247 
if (GameTicks and $3F) = 0 then 

248 
begin 

249 
y:= hwRound(Gear^.Y); 

250 
if y + Gear^.Radius < cWaterLine then 

498  251 
AddGear(hwRound(Gear^.X), y, gtSmokeTrace, 0, _0, _0, 0); 
374  252 
end; 
253 

4  254 
CheckCollision(Gear); 
351  255 
dec(Gear^.Timer); 
256 
if ((Gear^.State and gstCollision) <> 0) or (Gear^.Timer = 0) then 

4  257 
begin 
560  258 
StopSound(sndUFO); 
351  259 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound); 
4  260 
DeleteGear(Gear); 
261 
end; 

262 
end; 

263 

264 
procedure doStepUFO(Gear: PGear); 

265 
begin 

266 
AllInactive:= false; 

351  267 
Gear^.X:= Gear^.X + Gear^.dX; 
268 
Gear^.Y:= Gear^.Y + Gear^.dY; 

269 
Gear^.dY:= Gear^.dY + cGravity; 

4  270 
CheckCollision(Gear); 
351  271 
if (Gear^.State and gstCollision) <> 0 then 
4  272 
begin 
351  273 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound); 
4  274 
DeleteGear(Gear); 
275 
exit 

276 
end; 

351  277 
dec(Gear^.Timer); 
278 
if Gear^.Timer = 0 then 

4  279 
begin 
560  280 
PlaySound(sndUFO, true); 
351  281 
Gear^.Timer:= 5000; 
282 
Gear^.doStep:= @doStepUFOWork 

4  283 
end; 
284 
end; 

285 

286 
//////////////////////////////////////////////////////////////////////////////// 

876  287 
procedure doStepShotIdle(Gear: PGear); 
288 
begin 

289 
AllInactive:= false; 

290 
inc(Gear^.Timer); 

291 
if Gear^.Timer > 75 then 

292 
begin 

293 
DeleteGear(Gear); 

294 
AfterAttack 

295 
end 

296 
end; 

297 

4  298 
procedure doStepShotgunShot(Gear: PGear); 
299 
var i: LongWord; 

300 
begin 

301 
AllInactive:= false; 

876  302 

303 
if ((Gear^.State and gstAnimation) = 0) then 

304 
begin 

305 
dec(Gear^.Timer); 

306 
if Gear^.Timer = 0 then 

307 
begin 

308 
PlaySound(sndShotgunFire, false); 

309 
Gear^.State:= Gear^.State or gstAnimation 

310 
end; 

311 
exit 

312 
end 

313 
else inc(Gear^.Timer); 

314 

4  315 
i:= 200; 
316 
repeat 

351  317 
Gear^.X:= Gear^.X + Gear^.dX; 
318 
Gear^.Y:= Gear^.Y + Gear^.dY; 

4  319 
CheckCollision(Gear); 
351  320 
if (Gear^.State and gstCollision) <> 0 then 
876  321 
begin 
322 
Gear^.X:= Gear^.X + Gear^.dX * 8; 

323 
Gear^.Y:= Gear^.Y + Gear^.dY * 8; 

324 
ShotgunShot(Gear); 

325 
Gear^.doStep:= @doStepShotIdle; 

326 
exit 

327 
end; 

4  328 
dec(i) 
329 
until i = 0; 

498  330 
if (Gear^.X < _0) or (Gear^.Y < _0) or (Gear^.X > _2048) or (Gear^.Y > _1024) then 
876  331 
Gear^.doStep:= @doStepShotIdle 
4  332 
end; 
333 

334 
//////////////////////////////////////////////////////////////////////////////// 

559  335 
procedure doStepDEagleShotWork(Gear: PGear); 
38  336 
var i, x, y: LongWord; 
351  337 
oX, oY: hwFloat; 
38  338 
begin 
339 
AllInactive:= false; 

876  340 
inc(Gear^.Timer); 
37  341 
i:= 80; 
351  342 
oX:= Gear^.X; 
343 
oY:= Gear^.Y; 

37  344 
repeat 
351  345 
Gear^.X:= Gear^.X + Gear^.dX; 
346 
Gear^.Y:= Gear^.Y + Gear^.dY; 

347 
x:= hwRound(Gear^.X); 

348 
y:= hwRound(Gear^.Y); 

38  349 
if ((y and $FFFFFC00) = 0) and ((x and $FFFFF800) = 0) 
351  350 
and (Land[y, x] <> 0) then inc(Gear^.Damage); 
519  351 
if Gear^.Damage > 5 then AmmoShove(Gear, 7, 20); 
38  352 
dec(i) 
351  353 
until (i = 0) or (Gear^.Damage > Gear^.Health); 
354 
if Gear^.Damage > 0 then 

37  355 
begin 
351  356 
DrawTunnel(oX, oY, Gear^.dX, Gear^.dY, 82  i, 1); 
357 
dec(Gear^.Health, Gear^.Damage); 

358 
Gear^.Damage:= 0 

37  359 
end; 
498  360 
if (Gear^.Health <= 0) or (Gear^.X < _0) or (Gear^.Y < _0) or (Gear^.X > _2048) or (Gear^.Y > _1024) then 
876  361 
Gear^.doStep:= @doStepShotIdle 
37  362 
end; 
363 

559  364 
procedure doStepDEagleShot(Gear: PGear); 
365 
begin 

366 
PlaySound(sndGun, false); 

367 
Gear^.doStep:= @doStepDEagleShotWork 

368 
end; 

369 

37  370 
//////////////////////////////////////////////////////////////////////////////// 
4  371 
procedure doStepActionTimer(Gear: PGear); 
372 
begin 

351  373 
dec(Gear^.Timer); 
374 
case Gear^.Kind of 

83  375 
gtATStartGame: begin 
4  376 
AllInactive:= false; 
351  377 
if Gear^.Timer = 0 then 
83  378 
AddCaption(trmsg[sidStartFight], $FFFFFF, capgrpGameState); 
4  379 
end; 
83  380 
gtATSmoothWindCh: begin 
351  381 
if Gear^.Timer = 0 then 
6  382 
begin 
351  383 
if WindBarWidth < Gear^.Tag then inc(WindBarWidth) 
384 
else if WindBarWidth > Gear^.Tag then dec(WindBarWidth); 

385 
if WindBarWidth <> Gear^.Tag then Gear^.Timer:= 10; 

83  386 
end 
387 
end; 

388 
gtATFinishGame: begin 

389 
AllInactive:= false; 

351  390 
if Gear^.Timer = 0 then 
113  391 
begin 
392 
SendIPC('N'); 

324
f4c109c82a0c
Don't show game stats in case of interrupted by command '/quit' game
unc0rr
parents:
306
diff
changeset

393 
SendIPC('q'); 
83  394 
GameState:= gsExit 
113  395 
end 
6  396 
end; 
4  397 
end; 
351  398 
if Gear^.Timer = 0 then DeleteGear(Gear) 
4  399 
end; 
400 

401 
//////////////////////////////////////////////////////////////////////////////// 

402 
procedure doStepPickHammerWork(Gear: PGear); 

371  403 
var i, ei: LongInt; 
4  404 
HHGear: PGear; 
405 
begin 

70  406 
AllInactive:= false; 
351  407 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
408 
dec(Gear^.Timer); 

409 
if (Gear^.Timer = 0)or((Gear^.Message and gm_Destroy) <> 0)or((HHGear^.State and gstHHDriven) = 0) then 

4  410 
begin 
282  411 
StopSound(sndPickhammer); 
4  412 
DeleteGear(Gear); 
413 
AfterAttack; 

414 
exit 

415 
end; 

845  416 

422  417 
if (Gear^.Timer mod 33) = 0 then 
418 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y) + 6, 6, EXPLDontDraw); 

419 

420 
if (Gear^.Timer mod 47) = 0 then 

4  421 
begin 
371  422 
i:= hwRound(Gear^.X)  Gear^.Radius  LongInt(GetRandom(2)); 
423 
ei:= hwRound(Gear^.X) + Gear^.Radius + LongInt(GetRandom(2)); 

4  424 
while i <= ei do 
425 
begin 

422  426 
DrawExplosion(i, hwRound(Gear^.Y) + 3, 3); 
4  427 
inc(i, 1) 
428 
end; 

351  429 
Gear^.X:= Gear^.X + Gear^.dX; 
430 
Gear^.Y:= Gear^.Y + _1_9; 

42  431 
SetAllHHToActive; 
4  432 
end; 
433 
if TestCollisionYwithGear(Gear, 1) then 

434 
begin 

498  435 
Gear^.dY:= _0; 
351  436 
SetLittle(HHGear^.dX); 
498  437 
HHGear^.dY:= _0; 
4  438 
end else 
439 
begin 

351  440 
Gear^.dY:= Gear^.dY + cGravity; 
441 
Gear^.Y:= Gear^.Y + Gear^.dY; 

498  442 
if Gear^.Y > _1024 then Gear^.Timer:= 1 
4  443 
end; 
444 

351  445 
Gear^.X:= Gear^.X + HHGear^.dX; 
446 
HHGear^.X:= Gear^.X; 

498  447 
HHGear^.Y:= Gear^.Y  int2hwFloat(cHHRadius); 
4  448 

351  449 
if (Gear^.Message and gm_Attack) <> 0 then 
450 
if (Gear^.State and gsttmpFlag) <> 0 then Gear^.Timer:= 1 else else 

451 
if (Gear^.State and gsttmpFlag) = 0 then Gear^.State:= Gear^.State or gsttmpFlag; 

452 
if ((Gear^.Message and gm_Left) <> 0) then Gear^.dX:=  _0_3 else 

453 
if ((Gear^.Message and gm_Right) <> 0) then Gear^.dX:= _0_3 

498  454 
else Gear^.dX:= _0; 
4  455 
end; 
456 

457 
procedure doStepPickHammer(Gear: PGear); 

371  458 
var i, y: LongInt; 
4  459 
ar: TRangeArray; 
911
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

460 
HHGear: PGear; 
4  461 
begin 
462 
i:= 0; 

911
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

463 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

464 

498  465 
y:= hwRound(Gear^.Y)  cHHRadius * 2; 
351  466 
while y < hwRound(Gear^.Y) do 
4  467 
begin 
371  468 
ar[i].Left := hwRound(Gear^.X)  Gear^.Radius  LongInt(GetRandom(2)); 
469 
ar[i].Right:= hwRound(Gear^.X) + Gear^.Radius + LongInt(GetRandom(2)); 

4  470 
inc(y, 2); 
471 
inc(i) 

472 
end; 

911
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

473 

498  474 
DrawHLinesExplosions(@ar, 3, hwRound(Gear^.Y)  cHHRadius * 2, 2, Pred(i)); 
911
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

475 
Gear^.dY:= HHGear^.dY; 
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

476 
DeleteCI(HHGear); 
b709fe13ed69
Fix issue with hedgehog on top of the hedgehog with pickhammer
unc0rr
parents:
883
diff
changeset

477 

282  478 
PlaySound(sndPickhammer, true); 
4  479 
doStepPickHammerWork(Gear); 
351  480 
Gear^.doStep:= @doStepPickHammerWork 
4  481 
end; 
482 

483 
//////////////////////////////////////////////////////////////////////////////// 

371  484 
var BTPrevAngle, BTSteps: LongInt; 
302  485 

303
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

486 
procedure doStepBlowTorchWork(Gear: PGear); 
302  487 
var HHGear: PGear; 
305  488 
b: boolean; 
302  489 
begin 
490 
AllInactive:= false; 

351  491 
dec(Gear^.Timer); 
492 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

303
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

493 

1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

494 
HedgehogChAngle(HHGear); 
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

495 

305  496 
b:= false; 
497 

371  498 
if abs(LongInt(HHGear^.Angle)  BTPrevAngle) > 7 then 
305  499 
begin 
498  500 
Gear^.dX:= SignAs(AngleSin(HHGear^.Angle) * _0_5, HHGear^.dX); 
355  501 
Gear^.dY:= AngleCos(HHGear^.Angle) * (  _0_5); 
351  502 
BTPrevAngle:= HHGear^.Angle; 
358  503 
b:= true 
305  504 
end; 
505 

351  506 
if Gear^.Timer mod cHHStepTicks = 0 then 
302  507 
begin 
305  508 
b:= true; 
498  509 
if Gear^.dX.isNegative then HHGear^.Message:= (HHGear^.Message or gm_Left) and not gm_Right 
510 
else HHGear^.Message:= (HHGear^.Message or gm_Right) and not gm_Left; 

357  511 

512 
HHGear^.State:= HHGear^.State and not gstAttacking; 

302  513 
HedgehogStep(HHGear); 
357  514 
HHGear^.State:= HHGear^.State or gstAttacking; 
305  515 

516 
inc(BTSteps); 

511  517 
if BTSteps = 7 then 
305  518 
begin 
519 
BTSteps:= 0; 

511  520 
Gear^.X:= HHGear^.X + Gear^.dX * (cHHRadius + cBlowTorchC); 
521 
Gear^.Y:= HHGear^.Y + Gear^.dY * (cHHRadius + cBlowTorchC); 

351  522 
HHGear^.State:= HHGear^.State or gstNoDamage; 
511  523 
AmmoShove(Gear, 2, 14); 
351  524 
HHGear^.State:= HHGear^.State and not gstNoDamage 
305  525 
end; 
526 

542  527 
if (HHGear^.State and gstMoving) <> 0 then Gear^.Timer:= 0 
302  528 
end; 
305  529 

530 
if b then 

498  531 
DrawTunnel(HHGear^.X  Gear^.dX * cHHRadius, HHGear^.Y  _4  Gear^.dY * cHHRadius + hwAbs(Gear^.dY) * 7, 
351  532 
Gear^.dX, Gear^.dY, 
306  533 
cHHRadius * 5, cHHRadius * 2 + 6); 
305  534 

351  535 
if (Gear^.Timer = 0) or ((HHGear^.Message and gm_Attack) <> 0) then 
302  536 
begin 
351  537 
HHGear^.Message:= 0; 
302  538 
DeleteGear(Gear); 
539 
AfterAttack 

540 
end 

541 
end; 

542 

303
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

543 
procedure doStepBlowTorch(Gear: PGear); 
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

544 
var HHGear: PGear; 
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

545 
begin 
371  546 
BTPrevAngle:= High(LongInt); 
305  547 
BTSteps:= 0; 
351  548 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
549 
HHGear^.Message:= 0; 

550 
Gear^.doStep:= @doStepBlowTorchWork 

303
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

551 
end; 
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

552 

302  553 
//////////////////////////////////////////////////////////////////////////////// 
554 

4  555 
procedure doStepRopeWork(Gear: PGear); 
70  556 
const flCheck: boolean = false; 
4  557 
var HHGear: PGear; 
789  558 
len, cs, cc, tx, ty, nx, ny: hwFloat; 
108  559 
lx, ly: LongInt; 
4  560 

561 
procedure DeleteMe; 

562 
begin 

563 
with HHGear^ do 

564 
begin 

565 
Message:= Message and not gm_Attack; 

542  566 
State:= State or gstMoving; 
4  567 
end; 
568 
DeleteGear(Gear); 

534  569 
OnUsedAmmo(PHedgehog(HHGear^.Hedgehog)^); 
351  570 
ApplyAmmoChanges(PHedgehog(HHGear^.Hedgehog)^) 
4  571 
end; 
572 

573 
begin 

351  574 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
108  575 

351  576 
if ((HHGear^.State and gstHHDriven) = 0) 
80  577 
or (CheckGearDrowning(HHGear)) then 
4  578 
begin 
579 
DeleteMe; 

580 
exit 

581 
end; 

351  582 
Gear^.dX:= HHGear^.X  Gear^.X; 
583 
Gear^.dY:= HHGear^.Y  Gear^.Y; 

4  584 

351  585 
if (Gear^.Message and gm_Left <> 0) then HHGear^.dX:= HHGear^.dX  _0_0002 else 
586 
if (Gear^.Message and gm_Right <> 0) then HHGear^.dX:= HHGear^.dX + _0_0002; 

4  587 

351  588 
if not TestCollisionYwithGear(HHGear, 1) then HHGear^.dY:= HHGear^.dY + cGravity; 
4  589 

351  590 
cs:= Gear^.dY + HHGear^.dY; 
591 
cc:= Gear^.dX + HHGear^.dX; 

498  592 
len:= _1 / Distance(cc, cs); 
789  593 
cc:= cc * len; // rope vector plus hedgehog direction vector normalized 
108  594 
cs:= cs * len; 
4  595 

789  596 
nx:= hwAbs(cs) * hwSign(HHGear^.dX) * 3; // hedgehog direction normalized with length 3 
597 
ny:= hwAbs(cc) * hwSign(HHGear^.dY) * 3; 

598 

4  599 
flCheck:= not flCheck; 
600 
if flCheck then // check whether rope needs dividing 

601 
begin 

498  602 
len:= Gear^.Elasticity  _20; 
603 
while len > _5 do 

4  604 
begin 
605 
tx:= cc*len; 

606 
ty:= cs*len; 

789  607 
lx:= hwRound(Gear^.X + tx + nx); 
608 
ly:= hwRound(Gear^.Y + ty + ny); 

652  609 
if ((ly and $FFFFFC00) = 0) and ((lx and $FFFFF800) = 0) and (Land[ly, lx] <> 0) then 
4  610 
begin 
611 
with RopePoints.ar[RopePoints.Count] do 

612 
begin 

351  613 
X:= Gear^.X; 
614 
Y:= Gear^.Y; 

776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
764
diff
changeset

615 
if RopePoints.Count = 0 then RopePoints.HookAngle:= DxDy2Angle(Gear^.dY, Gear^.dX); 
351  616 
b:= (cc * HHGear^.dY) > (cs * HHGear^.dX); 
4  617 
dLen:= len 
618 
end; 

351  619 
Gear^.X:= Gear^.X + tx; 
620 
Gear^.Y:= Gear^.Y + ty; 

4  621 
inc(RopePoints.Count); 
789  622 
TryDo(RopePoints.Count <= MAXROPEPOINTS, 'Rope points overflow', true); 
351  623 
Gear^.Elasticity:= Gear^.Elasticity  len; 
624 
Gear^.Friction:= Gear^.Friction  len; 

4  625 
break 
626 
end; 

789  627 
len:= len  _2 
4  628 
end; 
629 
end else 

630 
if RopePoints.Count > 0 then // check whether the last dividing point could be removed 

631 
begin 

632 
tx:= RopePoints.ar[Pred(RopePoints.Count)].X; 

633 
ty:= RopePoints.ar[Pred(RopePoints.Count)].Y; 

351  634 
if RopePoints.ar[Pred(RopePoints.Count)].b xor ((tx  Gear^.X) * (ty  HHGear^.Y) > (tx  HHGear^.X) * (ty  Gear^.Y)) then 
4  635 
begin 
636 
dec(RopePoints.Count); 

351  637 
Gear^.X:=RopePoints.ar[RopePoints.Count].X; 
638 
Gear^.Y:=RopePoints.ar[RopePoints.Count].Y; 

639 
Gear^.Elasticity:= Gear^.Elasticity + RopePoints.ar[RopePoints.Count].dLen; 

640 
Gear^.Friction:= Gear^.Friction + RopePoints.ar[RopePoints.Count].dLen 

4  641 
end 
642 
end; 

643 

351  644 
Gear^.dX:= HHGear^.X  Gear^.X; 
645 
Gear^.dY:= HHGear^.Y  Gear^.Y; 

108  646 

351  647 
cs:= Gear^.dY + HHGear^.dY; 
648 
cc:= Gear^.dX + HHGear^.dX; 

498  649 
len:= _1 / Distance(cc, cs); 
108  650 
cc:= cc * len; 
651 
cs:= cs * len; 

4  652 

351  653 
HHGear^.dX:= HHGear^.X; 
654 
HHGear^.dY:= HHGear^.Y; 

4  655 

351  656 
if ((Gear^.Message and gm_Down) <> 0) and (Gear^.Elasticity < Gear^.Friction) then 
657 
if not (TestCollisionXwithGear(HHGear, hwSign(Gear^.dX)) 

658 
or TestCollisionYwithGear(HHGear, hwSign(Gear^.dY))) then Gear^.Elasticity:= Gear^.Elasticity + _0_3; 

4  659 

498  660 
if ((Gear^.Message and gm_Up) <> 0) and (Gear^.Elasticity > _30) then 
351  661 
if not (TestCollisionXwithGear(HHGear, hwSign(Gear^.dX)) 
662 
or TestCollisionYwithGear(HHGear, hwSign(Gear^.dY))) then Gear^.Elasticity:= Gear^.Elasticity  _0_3; 

4  663 

351  664 
HHGear^.X:= Gear^.X + cc*Gear^.Elasticity; 
665 
HHGear^.Y:= Gear^.Y + cs*Gear^.Elasticity; 

4  666 

351  667 
HHGear^.dX:= HHGear^.X  HHGear^.dX; 
668 
HHGear^.dY:= HHGear^.Y  HHGear^.dY; 

4  669 

351  670 
if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then 
671 
HHGear^.dX:= _0_6 * HHGear^.dX; 

672 
if TestCollisionYwithGear(HHGear, hwSign(HHGear^.dY)) then 

673 
HHGear^.dY:= _0_6 * HHGear^.dY; 

4  674 

789  675 
len:= Distance(HHGear^.dX, HHGear^.dY); 
676 
if len > _0_5 then 

677 
begin 

678 
len:= _0_5 / len; 

679 
HHGear^.dX:= HHGear^.dX * len; 

680 
HHGear^.dY:= HHGear^.dY * len; 

681 
end; 

682 

351  683 
if (Gear^.Message and gm_Attack) <> 0 then 
684 
if (Gear^.State and gsttmpFlag) <> 0 then DeleteMe else 

685 
else if (Gear^.State and gsttmpFlag) = 0 then Gear^.State:= Gear^.State or gsttmpFlag; 

4  686 
end; 
687 

688 

689 
procedure doStepRopeAttach(Gear: PGear); 

690 
var HHGear: PGear; 

351  691 
tx, ty, tt: hwFloat; 
4  692 
begin 
351  693 
Gear^.X:= Gear^.X  Gear^.dX; 
694 
Gear^.Y:= Gear^.Y  Gear^.dY; 

498  695 
Gear^.Elasticity:= Gear^.Elasticity + _1; 
351  696 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
517  697 
DeleteCI(HHGear); 
542  698 
if (HHGear^.State and gstMoving) <> 0 then 
68  699 
if TestCollisionYwithGear(HHGear, 1) then 
4  700 
begin 
820
a26537586400
Fix fall without damage trick, which could be performed with not attached rope
unc0rr
parents:
819
diff
changeset

701 
CheckHHDamage(HHGear); 
498  702 
HHGear^.dY:= _0; 
542  703 
HHGear^.State:= HHGear^.State and not (gstMoving or gstHHJumping); 
4  704 
end else 
705 
begin 

351  706 
if TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then SetLittle(HHGear^.dX); 
707 
HHGear^.X:= HHGear^.X + HHGear^.dX; 

708 
HHGear^.Y:= HHGear^.Y + HHGear^.dY; 

709 
Gear^.X:= Gear^.X + HHGear^.dX; 

710 
Gear^.Y:= Gear^.Y + HHGear^.dY; 

711 
HHGear^.dY:= HHGear^.dY + cGravity; 

712 
tt:= Gear^.Elasticity; 

498  713 
tx:= _0; 
714 
ty:= _0; 

715 
while tt > _20 do 

4  716 
begin 
517  717 
if TestCollisionXwithXYShift(Gear, tx, hwRound(ty), hwSign(Gear^.dX)) 
718 
or TestCollisionYwithXYShift(Gear, hwRound(tx), hwRound(ty), hwSign(Gear^.dY)) then 

4  719 
begin 
351  720 
Gear^.X:= Gear^.X + tx; 
721 
Gear^.Y:= Gear^.Y + ty; 

722 
Gear^.Elasticity:= tt; 

723 
Gear^.doStep:= @doStepRopeWork; 

4  724 
with HHGear^ do State:= State and not gstAttacking; 
498  725 
tt:= _0 
4  726 
end; 
517  727 
tx:= tx + Gear^.dX + Gear^.dX; 
728 
ty:= ty + Gear^.dY + Gear^.dY; 

498  729 
tt:= tt  _2; 
4  730 
end; 
731 
end; 

732 
CheckCollision(Gear); 

351  733 
if (Gear^.State and gstCollision) <> 0 then 
4  734 
begin 
351  735 
Gear^.doStep:= @doStepRopeWork; 
4  736 
with HHGear^ do State:= State and not gstAttacking; 
498  737 
if Gear^.Elasticity < _10 then 
738 
Gear^.Elasticity:= _10000; 

4  739 
end; 
740 

351  741 
if (Gear^.Elasticity > Gear^.Friction) or ((Gear^.Message and gm_Attack) = 0) then 
4  742 
begin 
351  743 
with PHedgehog(Gear^.Hedgehog)^.Gear^ do 
4  744 
begin 
745 
State:= State and not gstAttacking; 

746 
Message:= Message and not gm_Attack 

747 
end; 

748 
DeleteGear(Gear) 

749 
end 

750 
end; 

751 

752 
procedure doStepRope(Gear: PGear); 

753 
begin 

351  754 
Gear^.dX:=  Gear^.dX; 
755 
Gear^.dY:=  Gear^.dY; 

756 
Gear^.doStep:= @doStepRopeAttach 

4  757 
end; 
758 

759 
//////////////////////////////////////////////////////////////////////////////// 

760 
procedure doStepSmokeTrace(Gear: PGear); 

761 
begin 

351  762 
inc(Gear^.Timer); 
763 
if Gear^.Timer > 64 then 

4  764 
begin 
351  765 
Gear^.Timer:= 0; 
766 
dec(Gear^.State) 

4  767 
end; 
351  768 
Gear^.dX:= Gear^.dX + cWindSpeed; 
769 
Gear^.X:= Gear^.X + Gear^.dX; 

770 
if Gear^.State = 0 then DeleteGear(Gear) 

4  771 
end; 
9  772 

773 
//////////////////////////////////////////////////////////////////////////////// 

774 
procedure doStepExplosion(Gear: PGear); 

775 
begin 

351  776 
inc(Gear^.Timer); 
777 
if Gear^.Timer > 75 then 

9  778 
begin 
351  779 
inc(Gear^.State); 
780 
Gear^.Timer:= 0; 

781 
if Gear^.State > 5 then DeleteGear(Gear) 

9  782 
end; 
783 
end; 

10  784 

785 
//////////////////////////////////////////////////////////////////////////////// 

786 
procedure doStepMine(Gear: PGear); 

787 
begin 

542  788 
if (Gear^.State and gstMoving) <> 0 then 
10  789 
begin 
503  790 
DeleteCI(Gear); 
10  791 
doStepFallingGear(Gear); 
542  792 
if (Gear^.State and gstMoving) = 0 then 
13  793 
begin 
503  794 
AddGearCI(Gear); 
498  795 
Gear^.dX:= _0; 
796 
Gear^.dY:= _0 

13  797 
end; 
798 
CalcRotationDirAngle(Gear); 

10  799 
AllInactive:= false 
800 
end; 

351  801 

802 
if ((Gear^.State and gsttmpFlag) <> 0) then 

803 
if ((Gear^.State and gstAttacking) = 0) then 

14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

804 
begin 
39  805 
if ((GameTicks and $F) = 0) then 
351  806 
if CheckGearNear(Gear, gtHedgehog, 46, 32) <> nil then Gear^.State:= Gear^.State or gstAttacking 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

807 
end else // gstAttacking <> 0 
10  808 
begin 
809 
AllInactive:= false; 

351  810 
if (Gear^.Timer and $FF) = 0 then PlaySound(sndMineTick, false); 
811 
if Gear^.Timer = 0 then 

10  812 
begin 
351  813 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, EXPLAutoSound); 
521  814 
DeleteGear(Gear); 
815 
exit 

10  816 
end; 
351  817 
dec(Gear^.Timer); 
13  818 
end else // gsttmpFlag = 0 
351  819 
if TurnTimeLeft = 0 then Gear^.State:= Gear^.State or gsttmpFlag; 
10  820 
end; 
57  821 

39  822 
//////////////////////////////////////////////////////////////////////////////// 
823 
procedure doStepDynamite(Gear: PGear); 

824 
begin 

43  825 
doStepFallingGear(Gear); 
826 
AllInactive:= false; 

351  827 
if Gear^.Timer mod 166 = 0 then inc(Gear^.Tag); 
828 
if Gear^.Timer = 0 then 

39  829 
begin 
351  830 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 75, EXPLAutoSound); 
43  831 
DeleteGear(Gear); 
832 
exit 

39  833 
end; 
351  834 
dec(Gear^.Timer); 
39  835 
end; 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

836 

351  837 
/////////////////////////////////////////////////////////////////////////////// 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

838 
procedure doStepCase(Gear: PGear); 
371  839 
var i, x, y: LongInt; 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

840 
begin 
351  841 
if (Gear^.Message and gm_Destroy) > 0 then 
15  842 
begin 
843 
DeleteGear(Gear); 

435  844 
FreeActionsList; 
913  845 
SetAllToActive; // something (hh, mine, etc...) could be on top of the case 
602  846 
with CurrentHedgehog^ do 
441  847 
if Gear <> nil then Gear^.Message:= Gear^.Message and not (gm_LJump or gm_HJump); 
15  848 
exit 
849 
end; 

850 

351  851 
if Gear^.Damage > 0 then 
79  852 
begin 
351  853 
x:= hwRound(Gear^.X); 
854 
y:= hwRound(Gear^.Y); 

79  855 
DeleteGear(Gear); 
590  856 
if Gear^.Kind = gtCase then 
857 
begin 

858 
doMakeExplosion(x, y, 25, EXPLAutoSound); 

859 
for i:= 0 to 63 do 

860 
AddGear(x, y, gtFlame, 0, _0, _0, 0); 

861 
end; 

79  862 
exit 
863 
end; 

864 

351  865 
if (Gear^.dY.QWordValue <> 0) or (not TestCollisionYwithGear(Gear, 1)) then 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

866 
begin 
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

867 
AllInactive:= false; 
351  868 
Gear^.dY:= Gear^.dY + cGravity; 
869 
Gear^.Y:= Gear^.Y + Gear^.dY; 

498  870 
if (Gear^.dY.isNegative) and TestCollisionYwithGear(Gear, 1) then Gear^.dY:= _0 else 
439  871 
if (not Gear^.dY.isNegative) and TestCollisionYwithGear(Gear, 1) then 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

872 
begin 
351  873 
Gear^.dY:=  Gear^.dY * Gear^.Elasticity; 
498  874 
if Gear^.dY >  _0_001 then Gear^.dY:= _0 
351  875 
else if Gear^.dY <  _0_03 then PlaySound(sndGraveImpact, false); 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

876 
end; 
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

877 
CheckGearDrowning(Gear); 
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

878 
end; 
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

879 

511  880 
if (Gear^.dY.QWordValue = 0) then AddGearCI(Gear) 
881 
else if (Gear^.dY.QWordValue <> 0) then DeleteCI(Gear) 

14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
13
diff
changeset

882 
end; 
49  883 

884 
//////////////////////////////////////////////////////////////////////////////// 

557  885 
const cSorterWorkTime = 640; 
886 
var thexchar: array[0..cMaxTeams] of 

887 
record 

888 
dy, ny, dw: LongInt; 

49  889 
team: PTeam; 
557  890 
SortFactor: QWord; 
49  891 
end; 
601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
590
diff
changeset

892 
currsorter: PGear = nil; 
49  893 

894 
procedure doStepTeamHealthSorterWork(Gear: PGear); 

371  895 
var i: LongInt; 
49  896 
begin 
897 
AllInactive:= false; 

351  898 
dec(Gear^.Timer); 
899 
if (Gear^.Timer and 15) = 0 then 

557  900 
for i:= 0 to Pred(TeamsCount) do 
49  901 
with thexchar[i] do 
557  902 
begin 
49  903 
{$WARNINGS OFF} 
557  904 
team^.DrawHealthY:= ny + dy * Gear^.Timer div 640; 
905 
team^.TeamHealthBarWidth:= team^.NewTeamHealthBarWidth + dw * Gear^.Timer div cSorterWorkTime; 

49  906 
{$WARNINGS ON} 
557  907 
end; 
351  908 
if (Gear^.Timer = 0) or (currsorter <> Gear) then 
143  909 
begin 
910 
if currsorter = Gear then currsorter:= nil; 

49  911 
DeleteGear(Gear) 
143  912 
end 
49  913 
end; 
914 

915 
procedure doStepTeamHealthSorter(Gear: PGear); 

547  916 
var i, t: Longword; 
557  917 
b: boolean; 
49  918 
begin 
919 
AllInactive:= false; 

557  920 

547  921 
for t:= 0 to Pred(TeamsCount) do 
557  922 
with thexchar[t] do 
49  923 
begin 
557  924 
dy:= TeamsArray[t]^.DrawHealthY; 
925 
dw:= TeamsArray[t]^.TeamHealthBarWidth  TeamsArray[t]^.NewTeamHealthBarWidth; 

926 
team:= TeamsArray[t]; 

927 
SortFactor:= TeamsArray[t]^.Clan^.ClanHealth; 

928 
SortFactor:= (SortFactor shl 3) + TeamsArray[t]^.Clan^.ClanIndex; 

929 
SortFactor:= (SortFactor shl 30) + TeamsArray[t]^.TeamHealth; 

49  930 
end; 
547  931 

601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
590
diff
changeset

932 
if TeamsCount > 1 then 
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
590
diff
changeset

933 
repeat 
557  934 
b:= true; 
935 
for t:= 0 to TeamsCount  2 do 

936 
if (thexchar[t].SortFactor > thexchar[Succ(t)].SortFactor) then 

49  937 
begin 
557  938 
thexchar[cMaxTeams]:= thexchar[t]; 
49  939 
thexchar[t]:= thexchar[Succ(t)]; 
557  940 
thexchar[Succ(t)]:= thexchar[cMaxTeams]; 
941 
b:= false 

942 
end 

601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
590
diff
changeset

943 
until b; 
557  944 

49  945 
t:= cScreenHeight  4; 
557  946 
for i:= 0 to Pred(TeamsCount) do 
49  947 
with thexchar[i] do 
948 
begin 

764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset

949 
dec(t, team^.HealthTex^.h + 2); 
557  950 
ny:= t; 
951 
dy:= dy  ny 

49  952 
end; 
764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset

953 

557  954 
Gear^.Timer:= cSorterWorkTime; 
351  955 
Gear^.doStep:= @doStepTeamHealthSorterWork; 
143  956 
currsorter:= Gear 
49  957 
end; 
958 

79  959 
//////////////////////////////////////////////////////////////////////////////// 
854  960 
procedure doStepIdle(Gear: PGear); 
961 
begin 

962 
AllInactive:= false; 

963 
dec(Gear^.Timer);addfilelog(inttostr(Gear^.Timer)); 

964 
if Gear^.Timer = 0 then 

965 
begin 

966 
DeleteGear(Gear); 

967 
AfterAttack 

968 
end 

969 
end; 

970 

79  971 
procedure doStepShover(Gear: PGear); 
972 
var HHGear: PGear; 

973 
begin 

351  974 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
975 
HHGear^.State:= HHGear^.State or gstNoDamage; 

79  976 
AmmoShove(Gear, 30, 115); 
351  977 
HHGear^.State:= HHGear^.State and not gstNoDamage; 
854  978 
Gear^.Timer:= 250; 
979 
Gear^.doStep:= @doStepIdle 

79  980 
end; 
981 

982 
//////////////////////////////////////////////////////////////////////////////// 

983 
procedure doStepFlame(Gear: PGear); 

984 
begin 

985 
AllInactive:= false; 

986 
if not TestCollisionYwithGear(Gear, 1) then 

987 
begin 

351  988 
Gear^.dX:= Gear^.dX + cWindSpeed; 
989 
Gear^.dY:= Gear^.dY + cGravity; 

990 
if hwAbs(Gear^.dX) > _0_1 then Gear^.dX:= Gear^.dX * _0_5; 

991 
if Gear^.dY > _0_1 then Gear^.dY:= Gear^.dY * _0_995; 

992 
Gear^.X:= Gear^.X + Gear^.dX; 

993 
Gear^.Y:= Gear^.Y + Gear^.dY; 

498  994 
if not (Gear^.Y < _1024) then 
79  995 
begin 
996 
DeleteGear(Gear); 

997 
exit 

998 
end 

999 
end else begin 

351  1000 
if Gear^.Timer > 0 then dec(Gear^.Timer) 
79  1001 
else begin 
506  1002 
// doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 2, 0); 
351  1003 
dec(Gear^.Health); 
1004 
Gear^.Timer:= 1250  Gear^.Angle * 12 

79  1005 
end 
1006 
end; 

1007 

351  1008 
if (((GameTicks div 8) mod 64) = Gear^.Angle) then 
79  1009 
AmmoFlameWork(Gear); 
1010 

351  1011 
if Gear^.Health = 0 then 
79  1012 
DeleteGear(Gear) 
1013 
end; 

82  1014 

1015 
//////////////////////////////////////////////////////////////////////////////// 

1016 
procedure doStepFirePunchWork(Gear: PGear); 

1017 
var HHGear: PGear; 

1018 
begin 

1019 
AllInactive:= false; 

351  1020 
if ((Gear^.Message and gm_Destroy) <> 0) then 
82  1021 
begin 
1022 
DeleteGear(Gear); 

1023 
AfterAttack; 

1024 
exit 

1025 
end; 

1026 

351  1027 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
1028 
if hwRound(HHGear^.Y) <= Gear^.Tag  2 then 

82  1029 
begin 
351  1030 
Gear^.Tag:= hwRound(HHGear^.Y); 
498  1031 
DrawTunnel(HHGear^.X  int2hwFloat(cHHRadius), HHGear^.Y  _1, _0_5, _0, cHHRadius * 4, 2); 
351  1032 
HHGear^.State:= HHGear^.State or gstNoDamage; 
1033 
Gear^.Y:= HHGear^.Y; 

82  1034 
AmmoShove(Gear, 30, 40); 
351  1035 
HHGear^.State:= HHGear^.State and not gstNoDamage 
82  1036 
end; 
351  1037 

1038 
HHGear^.dY:= HHGear^.dY + cGravity; 

1039 
if not (HHGear^.dY.isNegative) then 

82  1040 
begin 
542  1041 
HHGear^.State:= HHGear^.State or gstMoving; 
82  1042 
DeleteGear(Gear); 
1043 
AfterAttack; 

1044 
exit 

1045 
end; 

351  1046 
HHGear^.Y:= HHGear^.Y + HHGear^.dY 
82  1047 
end; 
1048 

1049 
procedure doStepFirePunch(Gear: PGear); 

1050 
var HHGear: PGear; 

1051 
begin 

1052 
AllInactive:= false; 

351  1053 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
514  1054 
DeleteCI(HHGear); 
498  1055 
HHGear^.X:= int2hwFloat(hwRound(HHGear^.X))  _0_5; 
351  1056 
SetLittle(HHGear^.dX); 
1057 
HHGear^.dY:=  _0_3; 

82  1058 

351  1059 
Gear^.X:= HHGear^.X; 
498  1060 
Gear^.dX:= SignAs(_0_45, HHGear^.dX); 
351  1061 
Gear^.dY:=  _0_9; 
1062 
Gear^.doStep:= @doStepFirePunchWork; 

498  1063 
DrawTunnel(HHGear^.X  int2hwFloat(cHHRadius), HHGear^.Y + _1, _0_5, _0, cHHRadius * 4, 5); 
82  1064 
end; 
1065 

263  1066 
//////////////////////////////////////////////////////////////////////////////// 
1067 

211  1068 
procedure doStepParachute(Gear: PGear); 
1069 
var HHGear: PGear; 

817  1070 
Timer: Longword; 
211  1071 
begin 
351  1072 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 
1073 
HHGear^.State:= HHGear^.State and not gstAttacking; 

517  1074 
DeleteCI(HHGear); 
82  1075 

516  1076 
inc(Gear^.Timer); 
1077 

212  1078 
if TestCollisionYwithGear(HHGear, 1) 
351  1079 
or ((HHGear^.State and gstHHDriven) = 0) 
212  1080 
or CheckGearDrowning(HHGear) then 
211  1081 
begin 
1082 
with HHGear^ do 

1083 
begin 

1084 
Message:= 0; 

568  1085 
SetLittle(dX); 
498  1086 
dY:= _0; 
211  1087 
State:= State and not (gstAttacking or gstAttacked); 
542  1088 
State:= State or gstMoving; 
211  1089 
end; 
817  1090 
Timer:= Gear^.Timer; 
211  1091 
DeleteGear(Gear); 
817  1092 
if Timer > 10 then 
516  1093 
begin 
534  1094 
OnUsedAmmo(PHedgehog(HHGear^.Hedgehog)^); 
516  1095 
ApplyAmmoChanges(PHedgehog(HHGear^.Hedgehog)^) 
1096 
end; 

211  1097 
exit 
1098 
end; 

1099 

351  1100 
if not TestCollisionXwithGear(HHGear, hwSign(HHGear^.dX)) then 
1101 
HHGear^.X:= HHGear^.X + cWindSpeed * 200; 

211  1102 

351  1103 
if (Gear^.Message and gm_Left) <> 0 then HHGear^.X:= HHGear^.X  cMaxWindSpeed * 40 
1104 
else if (Gear^.Message and gm_Right) <> 0 then HHGear^.X:= HHGear^.X + cMaxWindSpeed * 40; 

1105 
if (Gear^.Message and gm_Up) <> 0 then HHGear^.Y:= HHGear^.Y  cGravity * 40 

1106 
else if (Gear^.Message and gm_Down) <> 0 then HHGear^.Y:= HHGear^.Y + cGravity * 40; 

211  1107 

351  1108 
HHGear^.Y:= HHGear^.Y + cGravity * 100; 
568  1109 
Gear^.X:= HHGear^.X; 
1110 
Gear^.Y:= HHGear^.Y 

263  1111 
end; 
211  1112 

263  1113 
//////////////////////////////////////////////////////////////////////////////// 
1114 
procedure doStepAirAttackWork(Gear: PGear); 

1115 
begin 

1116 
AllInactive:= false; 

498  1117 
Gear^.X:= Gear^.X + cAirPlaneSpeed * Gear^.Tag; 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1118 
if (Gear^.Health > 0)and(not (Gear^.X < Gear^.dX))and(Gear^.X < Gear^.dX + cAirPlaneSpeed) then 
263  1119 
begin 
351  1120 
dec(Gear^.Health); 
1121 
case Gear^.State of 

498  1122 
0: FollowGear:= AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtAirBomb, 0, cBombsSpeed * Gear^.Tag, _0, 0); 
1123 
1: FollowGear:= AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtMine, 0, cBombsSpeed * Gear^.Tag, _0, 0); 

285  1124 
end; 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1125 
Gear^.dX:= Gear^.dX + int2hwFloat(30 * Gear^.Tag) 
263  1126 
end; 
498  1127 
if (hwRound(Gear^.X) > 3072) or (hwRound(Gear^.X) < 1024) then DeleteGear(Gear) 
263  1128 
end; 
1129 

1130 
procedure doStepAirAttack(Gear: PGear); 

1131 
begin 

1132 
AllInactive:= false; 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1133 

408  1134 
if Gear^.X.QWordValue = 0 then Gear^.Tag:= 1 
1135 
else Gear^.Tag:= 1; 

498  1136 
Gear^.X:= _1024  _2048 * Gear^.Tag; 
1137 
Gear^.Y:= _128; 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1138 
Gear^.dX:= int2hwFloat(TargetPoint.X  5 * Gear^.Tag * 15); 
357  1139 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1140 
if int2hwFloat(TargetPoint.Y)  Gear^.Y > _0 then 
498  1141 
Gear^.dX:= Gear^.dX  cBombsSpeed * hwSqrt((int2hwFloat(TargetPoint.Y)  Gear^.Y) * 2 / cGravity) * Gear^.Tag; 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

1142 

351  1143 
Gear^.Health:= 6; 
801  1144 
Gear^.doStep:= @doStepAirAttackWork; 
1145 
PlaySound(sndIncoming, false) 

263  1146 
end; 
1147 

1148 
//////////////////////////////////////////////////////////////////////////////// 

1149 

1150 
procedure doStepAirBomb(Gear: PGear); 

1151 
begin 

1152 
AllInactive:= false; 

1153 
doStepFallingGear(Gear); 

351  1154 
if (Gear^.State and gstCollision) <> 0 then 
263  1155 
begin 
351  1156 
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 30, EXPLAutoSound); 
263  1157 
DeleteGear(Gear); 
1158 
exit 

1159 
end; 

1160 
if (GameTicks and $3F) = 0 then 

498  1161 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtSmokeTrace, 0, _0, _0, 0) 
211  1162 
end; 
409  1163 

1164 
//////////////////////////////////////////////////////////////////////////////// 

1165 

1166 
procedure doStepGirder(Gear: PGear); 

415  1167 
var HHGear: PGear; 
409  1168 
begin 
1169 
AllInactive:= false; 

415  1170 

1171 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

409  1172 
if not TryPlaceOnLand(TargetPoint.X  SpritesData[sprAmGirder].Width div 2, 
1173 
TargetPoint.Y  SpritesData[sprAmGirder].Height div 2, 

520  1174 
sprAmGirder, Gear^.State, true) then 
409  1175 
begin 
415  1176 
HHGear^.Message:= HHGear^.Message and not gm_Attack; 
1177 
HHGear^.State:= HHGear^.State and not gstAttacking; 

1178 
HHGear^.State:= HHGear^.State or gstHHChooseTarget; 

1179 
DeleteGear(Gear); 

1180 
isCursorVisible:= true 

409  1181 
end 
415  1182 
else begin 
1183 
DeleteGear(Gear); 

1184 
AfterAttack 

1185 
end; 

1186 
TargetPoint.X:= NoPointX 

409  1187 
end; 
520  1188 

1189 
//////////////////////////////////////////////////////////////////////////////// 

525  1190 
procedure doStepTeleportAfter(Gear: PGear); 
912  1191 
var HHGear: PGear; 
1192 
begin 

1193 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

1194 
HHGear^.Y:= HHGear^.Y + HHGear^.dY; // hedgehog falling to collect cases 

1195 
HHGear^.dY:= HHGear^.dY + cGravity; 

1196 
if TestCollisionYwithGear(HHGear, 1) then 

1197 
begin 

1198 
DeleteGear(Gear); 

1199 
AfterAttack 

1200 
end 

1201 
end; 

1202 

1203 
procedure doStepTeleportAnim(Gear: PGear); 

525  1204 
begin 
853  1205 
inc(Gear^.Timer); 
1206 
if Gear^.Timer = 65 then 

1207 
begin 

1208 
Gear^.Timer:= 0; 

1209 
inc(Gear^.Pos); 

1210 
if Gear^.Pos = 11 then 

912  1211 
Gear^.doStep:= @doStepTeleportAfter 
853  1212 
end 
525  1213 
end; 
520  1214 

1215 
procedure doStepTeleport(Gear: PGear); 

1216 
var HHGear: PGear; 

1217 
begin 

1218 
AllInactive:= false; 

1219 

1220 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

1221 
if not TryPlaceOnLand(TargetPoint.X  SpritesData[sprHHTelepMask].Width div 2, 

1222 
TargetPoint.Y  SpritesData[sprHHTelepMask].Height div 2, 

1223 
sprHHTelepMask, 0, false) then 

853  1224 
begin 
1225 
HHGear^.Message:= HHGear^.Message and not gm_Attack; 

1226 
HHGear^.State:= HHGear^.State and not gstAttacking; 

1227 
HHGear^.State:= HHGear^.State or gstHHChooseTarget; 

1228 
DeleteGear(Gear); 

1229 
isCursorVisible:= true 

1230 
end 

1231 
else begin 

1232 
DeleteCI(HHGear); 

1233 
SetAllHHToActive; 

912  1234 
Gear^.doStep:= @doStepTeleportAnim; 
853  1235 
Gear^.X:= HHGear^.X; 
1236 
Gear^.Y:= HHGear^.Y; 

1237 
HHGear^.X:= int2hwFloat(TargetPoint.X); 

1238 
HHGear^.Y:= int2hwFloat(TargetPoint.Y); 

1239 
HHGear^.State:= HHGear^.State or gstMoving 

1240 
end; 

520  1241 
TargetPoint.X:= NoPointX 
1242 
end; 

534  1243 

1244 
//////////////////////////////////////////////////////////////////////////////// 

1245 
procedure doStepSwitcherWork(Gear: PGear); 

1246 
var HHGear: PGear; 

1247 
Msg, State: Longword; 

1248 
begin 

1249 
AllInactive:= false; 

1250 

540  1251 
if ((Gear^.Message and not gm_Switch) <> 0) or (TurnTimeLeft = 0) then 
534  1252 
begin 
1253 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

1254 
Msg:= Gear^.Message and not gm_Switch; 

1255 
DeleteGear(Gear); 

538  1256 
OnUsedAmmo(PHedgehog(HHGear^.Hedgehog)^); 
1257 
ApplyAmmoChanges(PHedgehog(HHGear^.Hedgehog)^); 

534  1258 

602  1259 
HHGear:= CurrentHedgehog^.Gear; 
538  1260 
ApplyAmmoChanges(PHedgehog(HHGear^.Hedgehog)^); 
534  1261 
HHGear^.Message:= Msg; 
1262 
exit 

1263 
end; 

1264 

1265 
if (Gear^.Message and gm_Switch) <> 0 then 

1266 
begin 

602  1267 
HHGear:= CurrentHedgehog^.Gear; 
534  1268 
HHGear^.Message:= HHGear^.Message and not gm_Switch; 
809  1269 
Gear^.Message:= Gear^.Message and not gm_Switch; 
534  1270 
State:= HHGear^.State; 
1271 
HHGear^.State:= 0; 

1272 
HHGear^.Active:= false; 

1273 
HHGear^.Z:= cHHZ; 

1274 
RemoveGearFromList(HHGear); 

1275 
InsertGearToList(HHGear); 

1276 

1277 
repeat 

551  1278 
CurrentTeam^.CurrHedgehog:= Succ(CurrentTeam^.CurrHedgehog) mod (CurrentTeam^.HedgehogsNumber); 
652  1279 
until (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil); 
1280 

1281 
CurrentHedgehog:= @CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]; 

534  1282 

602  1283 
HHGear:= CurrentHedgehog^.Gear; 
534  1284 
HHGear^.State:= State; 
1285 
HHGear^.Active:= true; 

1286 
FollowGear:= HHGear; 

1287 
HHGear^.Z:= cCurrHHZ; 

1288 
RemoveGearFromList(HHGear); 

1289 
InsertGearToList(HHGear); 

1290 
Gear^.X:= HHGear^.X; 

1291 
Gear^.Y:= HHGear^.Y 

1292 
end; 

1293 
end; 

1294 

1295 
procedure doStepSwitcher(Gear: PGear); 

1296 
var HHGear: PGear; 

1297 
begin 

1298 
Gear^.doStep:= @doStepSwitcherWork; 

1299 

1300 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

1301 
with HHGear^ do 

1302 
begin 

1303 
State:= State and not gstAttacking; 

1304 
Message:= Message and not gm_Attack 

1305 
end 

1306 
end; 