1 (*
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4 *
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
8 *
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.
13 *
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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 *)
18
19 {$INCLUDE "options.inc"}
20
21 unit uGearsUtils;
22 interface
23 uses uTypes, uFloat;
24
25 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword); inline;
26 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
27 procedure AddSplashForGear(Gear: PGear; justSkipping: boolean);
28 procedure AddBounceEffectForGear(Gear: PGear; imageScale: Single);
29 procedure AddBounceEffectForGear(Gear: PGear);
30
ModifyDamagenull31 function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
32 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
33 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
34 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource; Damage: Longword);
35 procedure HHHeal(Hedgehog: PHedgehog; healthBoost: LongInt; showMessage: boolean; vgTint: Longword);
36 procedure HHHeal(Hedgehog: PHedgehog; healthBoost: LongInt; showMessage: boolean);
IncHogHealthnull37 function IncHogHealth(Hedgehog: PHedgehog; healthBoost: LongInt): LongInt;
38 procedure CheckHHDamage(Gear: PGear);
39 procedure CalcRotationDirAngle(Gear: PGear);
40 procedure ResurrectHedgehog(var gear: PGear);
41
42 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
43 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
44
CheckGearNearnull45 function CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
CheckGearNearnull46 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
CheckGearDrowningnull47 function CheckGearDrowning(var Gear: PGear): boolean;
48 procedure CheckCollision(Gear: PGear); inline;
49 procedure CheckCollisionWithLand(Gear: PGear); inline;
50
51 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt);
52 procedure AmmoShoveCache(Ammo: PGear; Damage, Power: LongInt);
53 procedure AmmoShoveLine(Ammo: PGear; Damage, Power: LongInt; oX, oY, tX, tY: hwFloat);
GearsNearnull54 function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS;
SpawnBoxOfSmthnull55 function SpawnBoxOfSmth: PGear;
56 procedure PlayBoxSpawnTaunt(Gear: PGear);
57 procedure ShotgunShot(Gear: PGear);
CanUseTardisnull58 function CanUseTardis(HHGear: PGear): boolean;
59
60 procedure SetAllToActive;
61 procedure SetAllHHToActive(Ice: boolean);
62 procedure SetAllHHToActive(); inline;
63
GetAmmonull64 function GetAmmo(Hedgehog: PHedgehog): TAmmoType;
GetUtilitynull65 function GetUtility(Hedgehog: PHedgehog): TAmmoType;
66
WorldWrapnull67 function WorldWrap(var Gear: PGear): boolean;
HomingWrapnull68 function HomingWrap(var Gear: PGear): boolean;
69
IsHogFacingLeftnull70 function IsHogFacingLeft(Gear: PGear): boolean;
IsHogLocalnull71 function IsHogLocal(HH: PHedgehog): boolean;
72
73
MakeHedgehogsStepnull74 function MakeHedgehogsStep(Gear: PGear) : boolean;
75
76 var doStepHandlers: array[TGearType] of TGearStepProcedure;
77
78 implementation
79 uses uSound, uCollisions, uUtils, uConsts, uVisualGears, uAIMisc,
80 uVariables, uLandGraphics, uScript, uStats, uCaptions, uTeams, uStore,
81 uLocale, uTextures, uRenderUtils, uRandom, SDLh, uDebug,
82 uGearsList, Math, uVisualGearsList, uGearsHandlersMess,
83 uGearsHedgehog;
84
85 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword); inline;
86 begin
87 doMakeExplosion(X, Y, Radius, AttackingHog, Mask, $FFFFFFFF);
88 end;
89
90 procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
91 var Gear: PGear;
92 dmg, dmgBase: LongInt;
93 fX, fY, tdX, tdY: hwFloat;
94 vg: PVisualGear;
95 i, cnt: LongInt;
96 wrap: boolean;
97 bubble: PVisualGear;
98 s: ansistring;
99 begin
100 if Radius > 4 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');
101 if Radius > 25 then KickFlakes(Radius, X, Y);
102
103 if ((Mask and EXPLNoGfx) = 0) then
104 begin
105 vg:= nil;
106 if CheckCoordInWater(X, Y - Radius) then
107 begin
108 cnt:= 2 * Radius;
109 for i:= (Radius * Radius) div 4 downto 0 do
110 begin
111 bubble := AddVisualGear(X - Radius + random(cnt), Y - Radius + random(cnt), vgtBubble);
112 if bubble <> nil then
113 bubble^.dY:= 0.1 + random(20)/10;
114 end
115 end
116 else if Radius > 50 then vg:= AddVisualGear(X, Y, vgtBigExplosion)
117 else if Radius > 10 then vg:= AddVisualGear(X, Y, vgtExplosion);
118 if vg <> nil then
119 vg^.Tint:= Tint;
120 end;
121 if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion);
122
123 dmgBase:= Radius shl 1 + cHHRadius div 2;
124
125 // we might have to run twice if weWrap is enabled
126 wrap:= false;
127 repeat
128
129 fX:= int2hwFloat(X);
130 fY:= int2hwFloat(Y);
131 Gear:= GearsList;
132
133 while Gear <> nil do
134 begin
135 dmg:= 0;
136 if (Gear^.State and gstNoDamage) = 0 then
137 begin
138 case Gear^.Kind of
139 gtHedgehog,
140 gtMine,
141 gtBall,
142 gtMelonPiece,
143 gtGrenade,
144 gtClusterBomb,
145 gtSMine,
146 gtAirMine,
147 gtCase,
148 gtTarget,
149 gtFlame,
150 gtKnife,
151 gtExplosives: begin
152 // Run the calcs only once we know we have a type that will need damage
153 tdX:= Gear^.X-fX;
154 tdY:= Gear^.Y-fY;
155 if LongInt(tdX.Round + tdY.Round + 2) < dmgBase then
156 dmg:= dmgBase - hwRound(Distance(tdX, tdY));
157 if dmg > 1 then
158 begin
159 dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
160 //AddFileLog('Damage: ' + inttostr(dmg));
161 if (Mask and EXPLNoDamage) = 0 then
162 begin
163 if (Gear^.Kind <> gtHedgehog) or (Gear^.Hedgehog^.Effects[heInvulnerable] = 0) then
164 ApplyDamage(Gear, AttackingHog, dmg, dsExplosion)
165 else
166 Gear^.State:= Gear^.State or gstWinner;
167 end;
168 if ((Mask and EXPLDoNotTouchAny) = 0) and (((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog)) then
169 begin
170 DeleteCI(Gear);
171 Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, tdX)/(Gear^.Density/_3);
172 Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, tdY)/(Gear^.Density/_3);
173
174 Gear^.State:= (Gear^.State or gstMoving) and (not gstLoser);
175 if Gear^.Kind = gtKnife then Gear^.State:= Gear^.State and (not gstCollision);
176 if (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog^.Effects[heInvulnerable] = 0) then
177 begin
178 Gear^.State:= (Gear^.State or gstMoving) and (not (gstHHJumping or gstHHHJump));
179 if (not GameOver) then
180 Gear^.State:= (Gear^.State and (not gstWinner));
181 end;
182 Gear^.Active:= true;
183 if Gear^.Kind <> gtFlame then FollowGear:= Gear;
184 if Gear^.Kind = gtAirMine then
185 begin
186 Gear^.Tag:= 1;
187 Gear^.FlightTime:= 5000;
188 end
189 end;
190 if ((Mask and EXPLPoisoned) <> 0) and (Gear^.Kind = gtHedgehog) and
191 (Gear^.Hedgehog^.Effects[heInvulnerable] = 0) and (Gear^.Hedgehog^.Effects[heFrozen] = 0) and
192 (Gear^.State and gstHHDeath = 0) then
193 begin
194 if Gear^.Hedgehog^.Effects[hePoisoned] = 0 then
195 begin
196 s:= ansistring(Gear^.Hedgehog^.Name);
197 AddCaption(FormatA(GetEventString(eidPoisoned), s), capcolDefault, capgrpMessage);
198 uStats.HedgehogPoisoned(Gear, AttackingHog)
199 end;
200 Gear^.Hedgehog^.Effects[hePoisoned] := 5;
201 end
202 end;
203
204 end;
205 gtGrave: if Mask and EXPLDoNotTouchAny = 0 then
206 // Run the calcs only once we know we have a type that will need damage
207 begin
208 tdX:= Gear^.X-fX;
209 tdY:= Gear^.Y-fY;
210 if LongInt(tdX.Round + tdY.Round + 2) < dmgBase then
211 dmg:= dmgBase - hwRound(Distance(tdX, tdY));
212 if dmg > 1 then
213 begin
214 dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
215 Gear^.dY:= - _0_004 * dmg;
216 Gear^.Active:= true
217 end
218 end;
219 end;
220 end;
221 Gear:= Gear^.NextGear
222 end;
223
224 if (Mask and EXPLDontDraw) = 0 then
225 if ((GameFlags and gfSolidLand) = 0) or ((Mask and EXPLForceDraw) <> 0) then
226 begin
227 cnt:= DrawExplosion(X, Y, Radius) div 1608; // approx 2 16x16 circles to erase per chunk
228 if (cnt > 0) and (SpritesData[sprChunk].Texture <> nil) then
229 for i:= 0 to cnt do
230 AddVisualGear(X, Y, vgtChunk)
231 end;
232
233 if (WorldEdge = weWrap) then
234 begin
235 // already wrapped? let's not wrap again!
236 if wrap then
237 break;
238
239 // Radius + 5 because that's the actual radius the explosion changes graphically
240 if X + (Radius + 5) > rightX then
241 begin
242 dec(X, playWidth);
243 wrap:= true;
244 end
245 else if X - (Radius + 5) < leftX then
246 begin
247 inc(X, playWidth);
248 wrap:= true;
249 end;
250 end;
251
252 until (not wrap);
253
254 uAIMisc.AwareOfExplosion(0, 0, 0)
255 end;
256
ModifyDamagenull257 function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
258 var i: hwFloat;
259 begin
260 (* Invulnerability cannot be placed in here due to still needing kicks
261 Not without a new damage machine.
262 King check should be in here instead of ApplyDamage since Tiy wants them kicked less
263 *)
264 i:= _1;
265 if (CurrentHedgehog <> nil) and CurrentHedgehog^.King then
266 i:= _1_5;
267 if (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog <> nil) and
268 (Gear^.Hedgehog^.King or (Gear^.Hedgehog^.Effects[heFrozen] > 0)) then
269 ModifyDamage:= hwRound(cDamageModifier * dmg * i * cDamagePercent * _0_5 * _0_01)
270 else
271 ModifyDamage:= hwRound(cDamageModifier * dmg * i * cDamagePercent * _0_01);
272 end;
273
274 procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
275 var vampDmg, tmpDmg, i: Longword;
276 vg: PVisualGear;
277 begin
278 if Damage = 0 then
279 exit; // nothing to apply
280
281 if (Gear^.Kind = gtHedgehog) then
282 begin
283 Gear^.LastDamage := AttackerHog;
284
285 Gear^.Hedgehog^.Team^.Clan^.Flawless:= false;
286
287 if (Gear^.State and gstHHDeath) = 0 then
288 begin
289 HHHurt(Gear^.Hedgehog, Source, Damage);
290 AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), Damage, Gear^.Hedgehog^.Team^.Clan^.Color);
291 end;
292
293 tmpDmg:= min(Damage, max(0,Gear^.Health-Gear^.Damage));
294 if (Gear <> CurrentHedgehog^.Gear) and (CurrentHedgehog^.Gear <> nil) and (tmpDmg >= 1) then
295 begin
296 if cVampiric then
297 begin
298 vampDmg:= hwRound(int2hwFloat(tmpDmg)*_0_8);
299 if vampDmg >= 1 then
300 begin
301 // was considering pulsing on attack, Tiy thinks it should be permanent while in play
302 //CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstVampiric;
303 vampDmg:= IncHogHealth(CurrentHedgehog, vampDmg);
304 RenderHealth(CurrentHedgehog^);
305 RecountTeamHealth(CurrentHedgehog^.Team);
306 HHHeal(CurrentHedgehog, vampDmg, true, $FF0000FF);
307 end
308 end;
309 if (GameFlags and gfKarma <> 0) and (GameFlags and gfInvulnerable = 0) and
310 (CurrentHedgehog^.Effects[heInvulnerable] = 0) then
311 begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
312 inc(CurrentHedgehog^.Gear^.Karma, tmpDmg);
313 CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
314 spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
315 end;
316 end;
317
318 uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);
319
320 if AprilOne and (Gear^.Hedgehog^.Hat = 'fr_tomato') and (Damage > 2) then
321 for i := 0 to random(min(Damage,20))+5 do
322 begin
323 vg:= AddVisualGear(hwRound(Gear^.X), hwRound(Gear^.Y), vgtStraightShot);
324 if vg <> nil then
325 with vg^ do
326 begin
327 dx:= 0.001 * (random(100)+10);
328 dy:= 0.001 * (random(100)+10);
329 tdy:= -cGravityf;
330 if random(2) = 0 then
331 dx := -dx;
332 FrameTicks:= random(500) + 1000;
333 State:= ord(sprBubbles);
334 Tint:= $ff0000ff
335 end
336 end
337 end else
338 Gear^.Hedgehog:= AttackerHog;
339 inc(Gear^.Damage, Damage);
340
341 ScriptCall('onGearDamage', Gear^.UID, Damage);
342 end;
343
344 procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
345 var tag: PVisualGear;
346 begin
347 tag:= AddVisualGear(hwRound(HHGear^.X), hwRound(HHGear^.Y), vgtHealthTag, dmg);
348 if (tag <> nil) then
349 tag^.Hedgehog:= HHGear^.Hedgehog; // the tag needs the tag to determine the text color
350 AllInactive:= false;
351 HHGear^.Active:= true;
352 end;
353
354 // Play effects for hurt hedgehog
355 procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource; Damage: Longword);
356 begin
357 if Hedgehog^.Effects[heFrozen] <> 0 then exit;
358
359 if (Damage >= ouchDmg) and (OuchTauntTimer = 0) and ((Source = dsFall) or (Source = dsBullet) or (Source = dsShove) or (Source = dsHammer)) then
360 begin
361 PlaySoundV(sndOuch, Hedgehog^.Team^.voicepack);
362 // Prevent sndOuch from being played too often in short time
363 OuchTauntTimer:= 1250;
364 end
365 else if (Source = dsFall) or (Source = dsExplosion) then
366 case random(3) of
367 0: PlaySoundV(sndOoff1, Hedgehog^.Team^.voicepack);
368 1: PlaySoundV(sndOoff2, Hedgehog^.Team^.voicepack);
369 2: PlaySoundV(sndOoff3, Hedgehog^.Team^.voicepack);
370 end
371 else if (Source = dsPoison) then
372 case random(2) of
373 0: PlaySoundV(sndPoisonCough, Hedgehog^.Team^.voicepack);
374 1: PlaySoundV(sndPoisonMoan, Hedgehog^.Team^.voicepack);
375 end
376 else
377 case random(4) of
378 0: PlaySoundV(sndOw1, Hedgehog^.Team^.voicepack);
379 1: PlaySoundV(sndOw2, Hedgehog^.Team^.voicepack);
380 2: PlaySoundV(sndOw3, Hedgehog^.Team^.voicepack);
381 3: PlaySoundV(sndOw4, Hedgehog^.Team^.voicepack);
382 end
383 end;
384
385 {-
386 Show heal particles and message at hog gear.
387 Hedgehog: Hedgehog which gets the health boost
388 healthBoost: Amount of added health added
389 showMessage: Whether to show announcer message
390 vgTint: Tint of heal particle (if 0, don't render particles)
391 -}
392 procedure HHHeal(Hedgehog: PHedgehog; healthBoost: LongInt; showMessage: boolean; vgTint: Longword);
393 var i: LongInt;
394 vg: PVisualGear;
395 s: ansistring;
396 begin
397 if healthBoost < 1 then
398 exit;
399
400 if showMessage then
401 begin
402 s:= IntToStr(healthBoost);
403 AddCaption(FormatA(trmsg[sidHealthGain], s), Hedgehog^.Team^.Clan^.Color, capgrpAmmoinfo)
404 end;
405
406 i:= 0;
407 // One particle for every 5 HP. Max. 200 particles
408 if (vgTint <> 0) then
409 while (i < healthBoost) and (i < 1000) do
410 begin
411 vg:= AddVisualGear(hwRound(Hedgehog^.Gear^.X), hwRound(Hedgehog^.Gear^.Y), vgtStraightShot);
412 if vg <> nil then
413 with vg^ do
414 begin
415 Tint:= vgTint;
416 State:= ord(sprHealth)
417 end;
418 inc(i, 5)
419 end;
420 end;
421
422 // Shorthand for the same above, but with tint implied
423 procedure HHHeal(Hedgehog: PHedgehog; healthBoost: LongInt; showMessage: boolean);
424 begin
425 HHHeal(Hedgehog, healthBoost, showMessage, $00FF00FF);
426 end;
427
428 // Increase hog health by healthBoost (at least 1).
429 // Resulting health is capped at cMaxHogHealth.
430 // Returns actual amount healed.
IncHogHealthnull431 function IncHogHealth(Hedgehog: PHedgehog; healthBoost: LongInt): LongInt;
432 var oldHealth: LongInt;
433 begin
434 if healthBoost < 1 then
435 begin
436 IncHogHealth:= 0;
437 exit;
438 end;
439 oldHealth:= Hedgehog^.Gear^.Health;
440 inc(Hedgehog^.Gear^.Health, healthBoost);
441 // Prevent overflow
442 if (Hedgehog^.Gear^.Health < 1) or (Hedgehog^.Gear^.Health > cMaxHogHealth) then
443 Hedgehog^.Gear^.Health:= cMaxHogHealth;
444 IncHogHealth:= Hedgehog^.Gear^.Health - oldHealth;
445 end;
446
447 procedure CheckHHDamage(Gear: PGear);
448 var
449 dmg: LongInt;
450 i: LongWord;
451 particle: PVisualGear;
452 begin
453 if _0_4 < Gear^.dY then
454 begin
455 dmg := ModifyDamage(1 + hwRound((Gear^.dY - _0_4) * 70), Gear);
456 if Gear^.Hedgehog^.Effects[heFrozen] = 0 then
457 PlaySound(sndBump)
458 else PlaySound(sndFrozenHogImpact);
459 if dmg < 1 then
460 exit;
461
462 for i:= min(12, 3 + dmg div 10) downto 0 do
463 begin
464 particle := AddVisualGear(hwRound(Gear^.X) - 5 + Random(10), hwRound(Gear^.Y) + 12, vgtDust);
465 if particle <> nil then
466 particle^.dX := particle^.dX + (Gear^.dX.QWordValue / 21474836480);
467 end;
468
469 if ((Gear^.Hedgehog^.Effects[heInvulnerable] <> 0)) then
470 exit;
471
472 if Gear^.LastDamage <> nil then
473 ApplyDamage(Gear, Gear^.LastDamage, dmg, dsFall)
474 else
475 ApplyDamage(Gear, CurrentHedgehog, dmg, dsFall);
476 end
477 end;
478
479
480 procedure CalcRotationDirAngle(Gear: PGear);
481 var
482 dAngle: real;
483 begin
484 // Frac/Round to be kind to JS as of 2012-08-27 where there is yet no int64/uint64
485 dAngle := (Gear^.dX.Round + Gear^.dY.Round) / 2 + (Gear^.dX.Frac/$100000000+Gear^.dY.Frac/$100000000);
486 if not Gear^.dX.isNegative then
487 Gear^.DirAngle := Gear^.DirAngle + dAngle
488 else
489 Gear^.DirAngle := Gear^.DirAngle - dAngle;
490
491 if Gear^.DirAngle < 0 then
492 Gear^.DirAngle := Gear^.DirAngle + 360
493 else if 360 < Gear^.DirAngle then
494 Gear^.DirAngle := Gear^.DirAngle - 360
495 end;
496
497 procedure AddSplashForGear(Gear: PGear; justSkipping: boolean);
498 var x, y, i, distL, distR, distB, minDist, maxDrops: LongInt;
499 splash, particle: PVisualGear;
500 speed, hwTmp: hwFloat;
501 vi, vs, tmp: real; // impact speed and sideways speed
502 isImpactH, isImpactRight: boolean;
503 const dist2surf = 4;
504 begin
505 x:= hwRound(Gear^.X);
506 y:= hwRound(Gear^.Y);
507
508 // find position for splash and impact speed
509
510 distB:= cWaterline - y;
511
512 if WorldEdge <> weSea then
513 minDist:= distB
514 else
515 begin
516 distL:= x - leftX;
517 distR:= rightX - x;
518 minDist:= min(distB, min(distL, distR));
519 end;
520
521 isImpactH:= (minDist <> distB);
522
523 if not isImpactH then
524 begin
525 y:= cWaterline - dist2surf;
526 speed:= hwAbs(Gear^.dY);
527 end
528 else
529 begin
530 isImpactRight := minDist = distR;
531 if isImpactRight then
532 x:= rightX - dist2surf
533 else
534 x:= leftX + dist2surf;
535 speed:= hwAbs(Gear^.dX);
536 end;
537
538 // splash sound
539
540 if justSkipping then
541 PlaySound(sndSkip)
542 else
543 begin
544 // adjust water impact sound based on gear speed and density
545 hwTmp:= hwAbs(Gear^.Density * speed);
546
547 if hwTmp > _1 then
548 PlaySound(sndSplash)
549 else if hwTmp > _0_5 then
550 PlaySound(sndSkip)
551 else if hwTmp > _0_0002 then // arbitrary sanity cutoff. mostly for airmines
552 PlaySound(sndDroplet2);
553 end;
554
555
556 // splash visuals
557
558 if ((cReducedQuality and rqPlainSplash) <> 0) then
559 exit;
560
561 splash:= AddVisualGear(x, y, vgtSplash);
562 if splash = nil then
563 exit;
564
565 if not isImpactH then
566 vs:= abs(hwFloat2Float(Gear^.dX))
567 else
568 begin
569 if isImpactRight then
570 splash^.Angle:= -90
571 else
572 splash^.Angle:= 90;
573 vs:= abs(hwFloat2Float(Gear^.dY));
574 end;
575
576
577 vi:= hwFloat2Float(speed);
578
579 with splash^ do
580 begin
581 Scale:= abs(hwFloat2Float(Gear^.Density / _3 * speed));
582 if Scale > 1 then Scale:= power(Scale,0.3333)
583 else Scale:= Scale + ((1-Scale) / 2);
584 if Scale > 1 then Timer:= round(min(Scale*0.0005/cGravityf,4))
585 else Timer:= 1;
586 if Scale > 1 then
587 if (not isImpactH) then
588 Y:= Y + 10
589 else if isImpactRight then
590 X:= X + 10
591 else
592 X:= X - 10;
593 // Low Gravity
594 FrameTicks:= FrameTicks*Timer;
595 end;
596
597
598 // eject water drops
599
600 maxDrops := (hwRound(Gear^.Density) * 3) div 2 + round((vi + vs) * hwRound(Gear^.Density) * 6);
601 for i:= max(maxDrops div 3, min(32, Random(maxDrops))) downto 0 do
602 begin
603 if isImpactH then
604 particle := AddVisualGear(x, y - 3 + Random(7), vgtDroplet)
605 else
606 particle := AddVisualGear(x - 3 + Random(7), y, vgtDroplet);
607
608 if particle <> nil then
609 with particle^ do
610 begin
611 // dX and dY were initialized to have a random value on creation (see uVisualGearsList)
612 if isImpactH then
613 begin
614 tmp:= dX;
615 if isImpactRight then
616 dX:= dY - vi / 5
617 else
618 dX:= -dy + vi / 5;
619 dY:= tmp * (1 + vs / 10);
620 end
621 else
622 begin
623 dX:= dX * (1 + vs / 10);
624 dY:= dY - vi / 5;
625 end;
626
627 if splash <> nil then
628 begin
629 if splash^.Scale > 1 then
630 begin
631 dX:= dX * power(splash^.Scale, 0.3333); // tone down the droplet height further
632 dY:= dY * power(splash^.Scale, 0.3333);
633 end
634 else
635 begin
636 dX:= dX * splash^.Scale;
637 dY:= dY * splash^.Scale;
638 end;
639 end;
640 end
641 end;
642
643 end;
644
645 procedure DrownGear(Gear: PGear);
646 begin
647 Gear^.doStep := @doStepDrowningGear;
648
649 Gear^.Timer := 5000; // how long game should wait
650 end;
651
CheckGearDrowningnull652 function CheckGearDrowning(var Gear: PGear): boolean;
653 var
654 skipSpeed, skipAngle, skipDecay: hwFloat;
655 tmp, X, Y, dist2Water: LongInt;
656 isSubmersible, isDirH, isImpact, isSkip: boolean;
657 s: ansistring;
658 begin
659 // probably needs tweaking. might need to be in a case statement based upon gear type
660 X:= hwRound(Gear^.X);
661 Y:= hwRound(Gear^.Y);
662
663 dist2Water:= cWaterLine - (Y + Gear^.Radius);
664 isDirH:= false;
665
666 if WorldEdge = weSea then
667 begin
668 tmp:= dist2Water;
669 dist2Water:= min(dist2Water, min(X - Gear^.Radius - leftX, rightX - (X + Gear^.Radius)));
670 // if water on sides is closer than on bottom -> horizontal direction
671 isDirH:= tmp <> dist2Water;
672 end;
673
674 isImpact:= false;
675
676 if dist2Water < 0 then
677 begin
678 // invisible gears will just be deleted
679 // unless they are generic fallers, then they will be "respawned"
680 if Gear^.State and gstInvisible <> 0 then
681 begin
682 if Gear^.Kind = gtGenericFaller then
683 begin
684 Gear^.X:= int2hwFloat(GetRandom(rightX-leftX)+leftX);
685 Gear^.Y:= int2hwFloat(GetRandom(LAND_HEIGHT-topY)+topY);
686 Gear^.dX:= _90-(GetRandomf*_360);
687 Gear^.dY:= _90-(GetRandomf*_360)
688 end
689 else DeleteGear(Gear);
690 exit(true)
691 end;
692 isSubmersible:= ((Gear = CurrentHedgehog^.Gear) and (CurAmmoGear <> nil) and (CurAmmoGear^.State and gstSubmersible <> 0)) or (Gear^.State and gstSubmersible <> 0);
693
694 skipSpeed := _0_25;
695 skipAngle := _1_9;
696 skipDecay := _0_87;
697
698
699 // skipping
700
701 if (not isSubmersible) and (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > skipSpeed)
702 and ( ((not isDirH) and (hwAbs(Gear^.dX) > skipAngle * hwAbs(Gear^.dY)))
703 or (isDirH and (hwAbs(Gear^.dY) > skipAngle * hwAbs(Gear^.dX))) ) then
704 begin
705 isSkip:= true;
706 // if skipping we move the gear out of water
707 if isDirH then
708 begin
709 Gear^.dX.isNegative := (not Gear^.dX.isNegative);
710 Gear^.X:= Gear^.X + Gear^.dX;
711 end
712 else
713 begin
714 Gear^.dY.isNegative := (not Gear^.dY.isNegative);
715 Gear^.Y:= Gear^.Y + Gear^.dY;
716 end;
717 Gear^.dY := Gear^.dY * skipDecay;
718 Gear^.dX := Gear^.dX * skipDecay;
719 CheckGearDrowning := false;
720 end
721 else // not skipping
722 begin
723 isImpact:= true;
724 isSkip:= false;
725 if not isSubmersible then
726 begin
727 CheckGearDrowning := true;
728 Gear^.State := gstDrowning;
729 if Gear = CurrentHedgehog^.Gear then
730 TurnTimeLeft := 0;
731 Gear^.RenderTimer := false;
732 if (Gear^.Kind <> gtSniperRifleShot) and (Gear^.Kind <> gtShotgunShot)
733 and (Gear^.Kind <> gtDEagleShot) and (Gear^.Kind <> gtSineGunShot)
734 and (Gear^.Kind <> gtMinigunBullet) then
735 if Gear^.Kind = gtHedgehog then
736 begin
737 if Gear^.Hedgehog^.Effects[heResurrectable] <> 0 then
738 begin
739 // Gear could become nil after this, just exit to skip splashes
740 ResurrectHedgehog(Gear);
741 exit(true)
742 end
743 else
744 begin
745 DrownGear(Gear);
746 Gear^.State := Gear^.State and (not gstHHDriven);
747 s:= ansistring(Gear^.Hedgehog^.Name);
748 if Gear^.Hedgehog^.King then
749 AddCaption(FormatA(GetEventString(eidKingDied), s), capcolDefault, capgrpMessage)
750 else
751 AddCaption(FormatA(GetEventString(eidDrowned), s), capcolDefault, capgrpMessage);
752 end
753 end
754 else
755 DrownGear(Gear);
756 if Gear^.Kind = gtFlake then
757 exit(true); // skip splashes
758 end
759 else // submersible
760 begin
761 // drown submersible gears if far below map
762 if (Y > cWaterLine + cVisibleWater*4) then
763 begin
764 DrownGear(Gear);
765 exit(true); // no splashes needed
766 end;
767
768 CheckGearDrowning := false;
769
770 // check if surface was penetrated
771
772 // no penetration if center's water distance not smaller than radius
773 if ((dist2Water + Gear^.Radius div 2) < 0) or (abs(dist2Water + Gear^.Radius) >= Gear^.Radius) then
774 isImpact:= false
775 else
776 begin
777 // get distance to water of last tick
778 if isDirH then
779 begin
780 tmp:= hwRound(Gear^.X - Gear^.dX);
781 if abs(tmp - real(leftX)) < abs(tmp - real(rightX)) then // left edge
782 isImpact:= (abs(tmp-real(leftX)) >= Gear^.Radius) and (Gear^.dX.isNegative)
783 else
784 isImpact:= (abs(tmp-real(rightX)) >= Gear^.Radius) and (not Gear^.dX.isNegative);
785 end
786 else
787 begin
788 tmp:= hwRound(Gear^.Y - Gear^.dY);
789 tmp:= abs(cWaterLine - tmp);
790 // there was an impact if distance was >= radius
791 isImpact:= (tmp >= Gear^.Radius) and (not Gear^.dY.isNegative);
792 end;
793
794 end;
795 end; // end of submersible
796 end; // end of not skipping
797
798 // splash sound animation and droplets
799 if isImpact or isSkip then
800 if (not (((dist2Water + Gear^.Radius div 2) < 0) or (abs(dist2Water + Gear^.Radius) >= Gear^.Radius))) then
801 addSplashForGear(Gear, isSkip);
802
803 if isSkip then
804 ScriptCall('onGearWaterSkip', Gear^.uid);
805 end
806 else
807 CheckGearDrowning := false
808 end;
809
810
811 procedure ResurrectHedgehog(var gear: PGear);
812 var tempTeam : PTeam;
813 sparkles, expl: PVisualGear;
814 gX, gY: LongInt;
815 begin
816 if (Gear^.LastDamage <> nil) then
817 uStats.HedgehogDamaged(Gear, Gear^.LastDamage, 0, true)
818 else
819 uStats.HedgehogDamaged(Gear, CurrentHedgehog, 0, true);
820 // Reset gear state
821 AttackBar:= 0;
822 gear^.dX := _0;
823 gear^.dY := _0;
824 gear^.Damage := 0;
825 gear^.Health := gear^.Hedgehog^.InitialHealth;
826 gear^.Hedgehog^.Effects[hePoisoned] := 0;
827 if (CurrentHedgehog^.Effects[heResurrectable] = 0) or ((CurrentHedgehog^.Effects[heResurrectable] <> 0)
828 and (Gear^.Hedgehog^.Team^.Clan <> CurrentHedgehog^.Team^.Clan)) then
829 with CurrentHedgehog^ do
830 begin
831 inc(Team^.stats.AIKills);
832 FreeAndNilTexture(Team^.AIKillsTex);
833 Team^.AIKillsTex := RenderStringTex(ansistring(inttostr(Team^.stats.AIKills)), Team^.Clan^.Color, fnt16);
834 end;
835 tempTeam := gear^.Hedgehog^.Team;
836 DeleteCI(gear);
837 gX := hwRound(gear^.X);
838 gY := hwRound(gear^.Y);
839 // Spawn a few sparkles at death position.
840 // Might need more sparkles for a column.
841 sparkles:= AddVisualGear(gX, gY, vgtDust, 1);
842 if sparkles <> nil then
843 begin
844 sparkles^.Tint:= tempTeam^.Clan^.Color shl 8 or $FF;
845 end;
846 // Set new position of gear (might fail)
847 FindPlace(gear, false, 0, LAND_WIDTH, true);
848 if gear <> nil then
849 begin
850 // Visual effect at position of resurrection
851 expl:= AddVisualGear(hwRound(gear^.X), hwRound(gear^.Y), vgtExplosion);
852 PlaySound(sndWarp);
853 RenderHealth(gear^.Hedgehog^);
854 if expl <> nil then
855 ScriptCall('onGearResurrect', gear^.uid, expl^.uid)
856 else
857 ScriptCall('onGearResurrect', gear^.uid);
858 gear^.State := gstWait;
859 end;
860 RecountTeamHealth(tempTeam);
861 end;
862
863 function CountLand(x, y, r, c: LongInt; mask, antimask: LongWord): LongInt;
864 var i: LongInt;
865 count: LongInt = 0;
866 begin
867 if (y and LAND_HEIGHT_MASK) = 0 then
868 for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 1) do
869 if (Land[y, i] and mask <> 0) and (Land[y, i] and antimask = 0) then
870 begin
871 inc(count);
872 if count = c then
873 begin
874 CountLand:= count;
875 exit
876 end;
877 end;
878 CountLand:= count;
879 end;
880
881 function isSteadyPosition(x, y, r, c: LongInt; mask: Longword): boolean;
882 var cnt, i: LongInt;
883 begin
884 cnt:= 0;
885 isSteadyPosition:= false;
886
887 if ((y and LAND_HEIGHT_MASK) = 0) and (x - r >= 0) and (x + r < LAND_WIDTH) then
888 begin
889 for i:= r - c + 2 to r do
890 begin
891 if (Land[y, x - i] and mask <> 0) then inc(cnt);
892 if (Land[y, x + i] and mask <> 0) then inc(cnt);
893
894 if cnt >= c then
895 begin
896 isSteadyPosition:= true;
897 exit
898 end;
899 end;
900 end;
901 end;
902
903
904 function NoGearsToAvoid(mX, mY: LongInt; rX, rY: LongInt): boolean;
905 var t: PGear;
906 begin
907 NoGearsToAvoid:= false;
908 t:= GearsList;
909 rX:= sqr(rX);
910 rY:= sqr(rY);
911 while t <> nil do
912 begin
913 if t^.Kind <= gtExplosives then
914 if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
915 exit;
916 t:= t^.NextGear
917 end;
918 NoGearsToAvoid:= true
919 end;
920
921 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
922 begin
923 FindPlace(Gear, withFall, Left, Right, false);
924 end;
925
926 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
927 var x: LongInt;
928 y, sy, dir: LongInt;
929 ar: array[0..1023] of TPoint;
930 ar2: array[0..2047] of TPoint;
931 temp: TPoint;
932 cnt, cnt2: Longword;
933 delta: LongInt;
934 ignoreNearObjects, ignoreOverlap, tryAgain: boolean;
935 begin
936 ignoreNearObjects:= false; // try not skipping proximity at first
937 ignoreOverlap:= false; // this not only skips proximity, but allows overlapping objects (barrels, mines, hogs, crates). Saving it for a 3rd pass. With this active, winning AI Survival goes back to virtual impossibility
938 tryAgain:= true;
939 if WorldEdge <> weNone then
940 begin
941 Left:= max(Left, leftX + Gear^.Radius);
942 Right:= min(Right,rightX-Gear^.Radius)
943 end;
944 while tryAgain do
945 begin
946 delta:= LAND_WIDTH div 16;
947 cnt2:= 0;
948 repeat
949 if GetRandom(2) = 0 then dir:= -1 else dir:= 1;
950 x:= max(LAND_WIDTH div 2048, LongInt(GetRandom(Delta)));
951 if dir = 1 then x:= Left + x else x:= Right - x;
952 repeat
953 cnt:= 0;
954 y:= min(1024, topY) - Gear^.Radius shl 1;
955 while y < cWaterLine do
956 begin
957 repeat
958 inc(y, 2);
959 until (y >= cWaterLine) or
960 (ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, $FF00, 0) = 0)) or
961 (not ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, $FFFF, 0) = 0));
962
963
964 sy:= y;
965
966 repeat
967 inc(y);
968 until (y >= cWaterLine) or
969 (ignoreOverlap and
970 (CountLand(x, y, Gear^.Radius - 1, 1, $FFFF, 0) <> 0)) or
971 (not ignoreOverlap and
972 (CountLand(x, y, Gear^.Radius - 1, 1, lfLandMask, 0) <> 0));
973
974 if (y - sy > Gear^.Radius * 2) and (y < cWaterLine)
975 and (((Gear^.Kind = gtExplosives)
976 and (ignoreNearObjects or NoGearsToAvoid(x, y - Gear^.Radius, 60, 60))
977 and (isSteadyPosition(x, y+1, Gear^.Radius - 1, 3, $FFFF)
978 or (CountLand(x, y+1, Gear^.Radius - 1, Gear^.Radius+1, $FFFF, 0) > Gear^.Radius)
979 ))
980 or
981 ((Gear^.Kind <> gtExplosives)
982 and (ignoreNearObjects or NoGearsToAvoid(x, y - Gear^.Radius, 110, 110))
983 and (isSteadyPosition(x, y+1, Gear^.Radius - 1, 3, lfIce)
984 or (CountLand(x, y+1, Gear^.Radius - 1, Gear^.Radius+1, $FFFF, lfIce) <> 0)
985 ))) then
986 begin
987 ar[cnt].X:= x;
988 if withFall then
989 ar[cnt].Y:= sy + Gear^.Radius
990 else
991 ar[cnt].Y:= y - Gear^.Radius;
992 inc(cnt)
993 end;
994
995 inc(y, 10)
996 end;
997
998 if cnt > 0 then
999 begin
1000 temp := ar[GetRandom(cnt)];
1001 with temp do
1002 begin
1003 ar2[cnt2].x:= x;
1004 ar2[cnt2].y:= y;
1005 inc(cnt2)
1006 end;
1007 end;
1008 inc(x, Delta*dir)
1009 until ((dir = 1) and (x > Right)) or ((dir = -1) and (x < Left));
1010
1011 dec(Delta, 60)
1012 until (cnt2 > 0) or (Delta < 70);
1013 // if either of these has not been tried, do another pass
1014 if (cnt2 = 0) and skipProximity and (not ignoreOverlap) then
1015 tryAgain:= true
1016 else tryAgain:= false;
1017 if ignoreNearObjects then ignoreOverlap:= true;
1018 ignoreNearObjects:= true;
1019 end;
1020
1021 if cnt2 > 0 then
1022 begin
1023 temp := ar2[GetRandom(cnt2)];
1024 with temp do
1025 begin
1026 Gear^.X:= int2hwFloat(x);
1027 Gear^.Y:= int2hwFloat(y);
1028 AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
1029 end
1030 end
1031 else
1032 begin
1033 OutError('Can''t find place for Gear', false);
1034 if Gear^.Kind = gtHedgehog then
1035 begin
1036 cnt:= 0;
1037 if GameTicks = 0 then
1038 begin
1039 //AddFileLog('Trying to make a hole');
1040 while (cnt < 1000) do
1041 begin
1042 inc(cnt);
1043 x:= left+GetRandom(right-left-2*cHHRadius)+cHHRadius;
1044 y:= topY+GetRandom(LAND_HEIGHT-topY-64)+48;
1045 if NoGearsToAvoid(x, y, 100 div max(1,cnt div 100), 100 div max(1,cnt div 100)) then
1046 begin
1047 Gear^.State:= Gear^.State or gsttmpFlag;
1048 Gear^.X:= int2hwFloat(x);
1049 Gear^.Y:= int2hwFloat(y);
1050 AddFileLog('Picked a spot for hog at coordinates (' + inttostr(hwRound(Gear^.X)) + ',' + inttostr(hwRound(Gear^.Y)) + ')');
1051 cnt:= 2000
1052 end
1053 end;
1054 end;
1055 if cnt < 2000 then
1056 begin
1057 Gear^.Hedgehog^.Effects[heResurrectable] := 0;
1058 DeleteGear(Gear);
1059 Gear:= nil
1060 end
1061 end
1062 else
1063 begin
1064 DeleteGear(Gear);
1065 Gear:= nil
1066 end
1067 end
1068 end;
1069
1070 function CheckGearNearImpl(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt; exclude: PGear): PGear;
1071 var t: PGear;
1072 width, bound, dX, dY: hwFloat;
1073 isHit: Boolean;
1074 i, j: LongWord;
1075 begin
1076 bound:= _1_5 * int2hwFloat(max(rX, rY));
1077 rX:= sqr(rX);
1078 rY:= sqr(rY);
1079 width:= int2hwFloat(RightX - LeftX);
1080 if (Kind = gtHedgehog) then
1081 begin
1082 for j:= 0 to Pred(TeamsCount) do
1083 if TeamsArray[j]^.TeamHealth > 0 then // it's impossible for a team to have hogs in game and zero health right?
1084 with TeamsArray[j]^ do
1085 for i:= 0 to cMaxHHIndex do
1086 with Hedgehogs[i] do
1087 if (Gear <> nil) and (Gear <> exclude) then
1088 begin
Inull1089 // code duplication - could throw into an inline function I guess
1090 dX := X - Gear^.X;
1091 dY := Y - Gear^.Y;
1092 isHit := (hwAbs(dX) + hwAbs(dY) < bound)
1093 and (not ((hwSqr(dX) / rX + hwSqr(dY) / rY) > _1));
1094
1095 if (not isHit) and (WorldEdge = weWrap) then
1096 begin
1097 if (hwAbs(dX - width) + hwAbs(dY) < bound)
1098 and (not ((hwSqr(dX - width) / rX + hwSqr(dY) / rY) > _1)) then
1099 isHit := true
1100 else if (hwAbs(dX + width) + hwAbs(dY) < bound)
1101 and (not ((hwSqr(dX + width) / rX + hwSqr(dY) / rY) > _1)) then
1102 isHit := true
1103 end;
1104
1105 if isHit then
1106 begin
1107 CheckGearNearImpl:= Gear;
1108 exit;
1109 end
1110 end;
1111 end
1112 else
1113 begin
1114 t:= GearsList;
1115
1116 while t <> nil do
1117 begin
1118 if (t <> exclude) and (t^.Kind = Kind) then
1119 begin
1120 dX := X - t^.X;
1121 dY := Y - t^.Y;
1122 isHit := (hwAbs(dX) + hwAbs(dY) < bound)
1123 and (not ((hwSqr(dX) / rX + hwSqr(dY) / rY) > _1));
1124
1125 if (not isHit) and (WorldEdge = weWrap) then
1126 begin
1127 if (hwAbs(dX - width) + hwAbs(dY) < bound)
1128 and (not ((hwSqr(dX - width) / rX + hwSqr(dY) / rY) > _1)) then
1129 isHit := true
1130 else if (hwAbs(dX + width) + hwAbs(dY) < bound)
1131 and (not ((hwSqr(dX + width) / rX + hwSqr(dY) / rY) > _1)) then
1132 isHit := true
1133 end;
1134
1135 if isHit then
1136 begin
1137 CheckGearNearImpl:= t;
1138 exit;
1139 end;
1140 end;
1141 t:= t^.NextGear
1142 end
1143 end;
1144
1145 CheckGearNearImpl:= nil
1146 end;
1147
CheckGearNearnull1148 function CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
1149 begin
1150 CheckGearNear := CheckGearNearImpl(Kind, X, Y, rX, rY, nil);
1151 end;
1152
CheckGearNearnull1153 function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
1154 begin
1155 CheckGearNear := CheckGearNearImpl(Kind, Gear^.X, Gear^.Y, rX, rY, Gear);
1156 end;
1157
1158 procedure CheckCollision(Gear: PGear); inline;
1159 begin
1160 if (TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0)
1161 or (TestCollisionYwithGear(Gear, hwSign(Gear^.dY)) <> 0) then
1162 Gear^.State := Gear^.State or gstCollision
1163 else
1164 Gear^.State := Gear^.State and (not gstCollision)
1165 end;
1166
1167 procedure CheckCollisionWithLand(Gear: PGear); inline;
1168 begin
1169 if (TestCollisionX(Gear, hwSign(Gear^.dX)) <> 0)
1170 or (TestCollisionY(Gear, hwSign(Gear^.dY)) <> 0) then
1171 Gear^.State := Gear^.State or gstCollision
1172 else
1173 Gear^.State := Gear^.State and (not gstCollision)
1174 end;
1175
MakeHedgehogsStepnull1176 function MakeHedgehogsStep(Gear: PGear) : boolean;
1177 begin
1178 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1179 begin
1180 Gear^.Y:= Gear^.Y - _1;
1181 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1182 begin
1183 Gear^.Y:= Gear^.Y - _1;
1184 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1185 begin
1186 Gear^.Y:= Gear^.Y - _1;
1187 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1188 begin
1189 Gear^.Y:= Gear^.Y - _1;
1190 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1191 begin
1192 Gear^.Y:= Gear^.Y - _1;
1193 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then if (TestCollisionYwithGear(Gear, -1) = 0) then
1194 begin
1195 Gear^.Y:= Gear^.Y - _1;
1196 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then
1197 Gear^.Y:= Gear^.Y + _6
1198 end else Gear^.Y:= Gear^.Y + _5 else
1199 end else Gear^.Y:= Gear^.Y + _4 else
1200 end else Gear^.Y:= Gear^.Y + _3 else
1201 end else Gear^.Y:= Gear^.Y + _2 else
1202 end else Gear^.Y:= Gear^.Y + _1
1203 end;
1204
1205 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) = 0 then
1206 begin
1207 Gear^.X:= Gear^.X + SignAs(_1, Gear^.dX);
1208 MakeHedgehogsStep:= true
1209 end else
1210 MakeHedgehogsStep:= false;
1211
1212 if TestCollisionYwithGear(Gear, 1) = 0 then
1213 begin
1214 Gear^.Y:= Gear^.Y + _1;
1215 if TestCollisionYwithGear(Gear, 1) = 0 then
1216 begin
1217 Gear^.Y:= Gear^.Y + _1;
1218 if TestCollisionYwithGear(Gear, 1) = 0 then
1219 begin
1220 Gear^.Y:= Gear^.Y + _1;
1221 if TestCollisionYwithGear(Gear, 1) = 0 then
1222 begin
1223 Gear^.Y:= Gear^.Y + _1;
1224 if TestCollisionYwithGear(Gear, 1) = 0 then
1225 begin
1226 Gear^.Y:= Gear^.Y + _1;
1227 if TestCollisionYwithGear(Gear, 1) = 0 then
1228 begin
1229 Gear^.Y:= Gear^.Y + _1;
1230 if TestCollisionYwithGear(Gear, 1) = 0 then
1231 begin
1232 Gear^.Y:= Gear^.Y - _6;
1233 Gear^.dY:= _0;
1234 Gear^.State:= Gear^.State or gstMoving;
1235 exit
1236 end;
1237 end
1238 end
1239 end
1240 end
1241 end
1242 end;
1243 end;
1244
1245
1246 procedure ShotgunShot(Gear: PGear);
1247 var t: PGear;
1248 dmg, r, dist: LongInt;
1249 dx, dy: hwFloat;
1250 begin
1251 Gear^.Radius:= cShotgunRadius;
1252 t:= GearsList;
1253 while t <> nil do
1254 begin
1255 case t^.Kind of
1256 gtHedgehog,
1257 gtMine,
1258 gtSMine,
1259 gtAirMine,
1260 gtKnife,
1261 gtCase,
1262 gtTarget,
1263 gtExplosives: begin
1264 //addFileLog('ShotgunShot radius: ' + inttostr(Gear^.Radius) + ', t^.Radius = ' + inttostr(t^.Radius) + ', distance = ' + inttostr(dist) + ', dmg = ' + inttostr(dmg));
1265 dmg:= 0;
1266 r:= Gear^.Radius + t^.Radius;
1267 dx:= Gear^.X-t^.X;
1268 dx.isNegative:= false;
1269 dy:= Gear^.Y-t^.Y;
1270 dy.isNegative:= false;
1271 if r-hwRound(dx+dy) > 0 then
1272 begin
1273 dist:= hwRound(Distance(dx, dy));
1274 dmg:= ModifyDamage(min(r - dist, Gear^.Boom), t);
1275 end;
1276 if dmg > 0 then
1277 begin
1278 if (t^.Kind <> gtHedgehog) or (t^.Hedgehog^.Effects[heInvulnerable] = 0) then
1279 ApplyDamage(t, Gear^.Hedgehog, dmg, dsBullet)
1280 else
1281 Gear^.State:= Gear^.State or gstWinner;
1282
1283 DeleteCI(t);
1284 t^.dX:= t^.dX + Gear^.dX * dmg * _0_01 + SignAs(cHHKick, Gear^.dX);
1285 t^.dY:= t^.dY + Gear^.dY * dmg * _0_01;
1286 t^.State:= t^.State or gstMoving;
1287 if t^.Kind = gtKnife then t^.State:= t^.State and (not gstCollision);
1288 t^.Active:= true;
1289 FollowGear:= t;
1290
1291 if t^.Kind = gtAirmine then
1292 begin
1293 t^.Tag:= 1;
1294 t^.FlightTime:= 5000;
1295 end
1296 end
1297 end;
1298 gtGrave: begin
1299 dmg:= 0;
1300 r:= Gear^.Radius + t^.Radius;
1301 dx:= Gear^.X-t^.X;
1302 dx.isNegative:= false;
1303 dy:= Gear^.Y-t^.Y;
1304 dy.isNegative:= false;
1305 if r-hwRound(dx+dy) > 0 then
1306 begin
1307 dist:= hwRound(Distance(dx, dy));
1308 dmg:= ModifyDamage(min(r - dist, Gear^.Boom), t);
1309 end;
1310 if dmg > 0 then
1311 begin
1312 t^.dY:= - _0_1;
1313 t^.Active:= true
1314 end
1315 end;
1316 end;
1317 t:= t^.NextGear
1318 end;
1319 if (GameFlags and gfSolidLand) = 0 then
1320 DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius)
1321 end;
1322
1323 // Returns true if the given hog gear can use the tardis
CanUseTardisnull1324 function CanUseTardis(HHGear: PGear): boolean;
1325 var usable: boolean;
1326 i, j, cnt: LongInt;
1327 HH: PHedgehog;
1328 begin
1329 (*
1330 Conditions for not activating.
1331 1. Hog is last of his clan
1332 2. Sudden Death is in play
1333 3. Hog is a king
1334 *)
1335 usable:= true;
1336 HH:= HHGear^.Hedgehog;
1337 if HHGear <> nil then
1338 if (HHGear = nil) or (HH^.King) or (SuddenDeathActive) then
1339 usable:= false;
1340 cnt:= 0;
1341 for j:= 0 to Pred(HH^.Team^.Clan^.TeamsNumber) do
1342 for i:= 0 to Pred(HH^.Team^.Clan^.Teams[j]^.HedgehogsNumber) do
1343 if (HH^.Team^.Clan^.Teams[j]^.Hedgehogs[i].Gear <> nil)
1344 and ((HH^.Team^.Clan^.Teams[j]^.Hedgehogs[i].Gear^.State and gstDrowning) = 0)
1345 and (HH^.Team^.Clan^.Teams[j]^.Hedgehogs[i].Gear^.Health > HH^.Team^.Clan^.Teams[j]^.Hedgehogs[i].Gear^.Damage) then
1346 inc(cnt);
1347 if (cnt < 2) then
1348 usable:= false;
1349 CanUseTardis:= usable;
1350 end;
1351
1352 procedure AmmoShoveImpl(Ammo: PGear; Damage, Power: LongInt; collisions: PGearArray);
1353 var t: PGearArray;
1354 Gear: PGear;
1355 i, j, tmpDmg: LongInt;
1356 VGear: PVisualGear;
1357 begin
1358 t:= collisions;
1359
1360 // Just to avoid hogs on rope dodging fire.
1361 if (CurAmmoGear <> nil) and ((CurAmmoGear^.Kind = gtRope) or (CurAmmoGear^.Kind = gtJetpack) or (CurAmmoGear^.Kind = gtBirdy))
1362 and (CurrentHedgehog^.Gear <> nil) and (CurrentHedgehog^.Gear^.CollisionIndex = -1)
1363 and (sqr(hwRound(Ammo^.X) - hwRound(CurrentHedgehog^.Gear^.X)) + sqr(hwRound(Ammo^.Y) - hwRound(CurrentHedgehog^.Gear^.Y)) <= sqr(cHHRadius + Ammo^.Radius)) then
1364 begin
1365 t^.ar[t^.Count]:= CurrentHedgehog^.Gear;
1366 inc(t^.Count)
1367 end;
1368
1369 i:= t^.Count;
1370
1371 if (Ammo^.Kind = gtFlame) and (i > 0) then
1372 Ammo^.Health:= 0;
1373 while i > 0 do
1374 begin
1375 dec(i);
1376 Gear:= t^.ar[i];
1377 if (Ammo^.Kind in [gtDEagleShot, gtSniperRifleShot, gtMinigunBullet,
1378 gtFirePunch, gtKamikaze, gtWhip, gtShover])
1379 and (((Ammo^.Data <> nil) and (PGear(Ammo^.Data) = Gear))
1380 or (not UpdateHitOrder(Gear, Ammo^.WDTimer))) then
1381 continue;
1382
1383 if ((Ammo^.Kind = gtFlame) or (Ammo^.Kind = gtBlowTorch)) and
1384 (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog^.Effects[heFrozen] > 255) then
1385 Gear^.Hedgehog^.Effects[heFrozen]:= max(255,Gear^.Hedgehog^.Effects[heFrozen]-10000);
1386 tmpDmg:= ModifyDamage(Damage, Gear);
1387 if (Gear^.State and gstNoDamage) = 0 then
1388 begin
1389
1390 if (Gear^.Kind = gtHedgehog) and (Ammo^.State and gsttmpFlag <> 0) and (Ammo^.Kind = gtShover) then
1391 Gear^.FlightTime:= 1;
1392
1393 case Gear^.Kind of
1394 gtHedgehog,
1395 gtMine,
1396 gtAirMine,
1397 gtSMine,
1398 gtKnife,
1399 gtTarget,
1400 gtCase,
1401 gtExplosives:
1402 begin
1403 if (Ammo^.Kind in [gtFirePunch, gtKamikaze]) and (Gear^.Kind <> gtSMine) then
1404 PlaySound(sndFirePunchHit);
1405
1406 if Ammo^.Kind in [gtDEagleShot, gtSniperRifleShot, gtMinigunBullet] then
1407 begin
1408 VGear := AddVisualGear(t^.cX[i], t^.cY[i], vgtBulletHit);
1409 if VGear <> nil then
1410 VGear^.Angle := DxDy2Angle(-Ammo^.dX, Ammo^.dY);
1411 end;
1412 if (Ammo^.Kind = gtDrill) then
1413 begin
1414 Ammo^.Timer:= 0;
1415 exit;
1416 end;
1417 if (Gear^.Kind <> gtHedgehog) or (Gear^.Hedgehog^.Effects[heInvulnerable] = 0) then
1418 begin
1419 if (Ammo^.Kind = gtKnife) and (tmpDmg > 0) then
1420 for j:= 1 to max(1,min(3,tmpDmg div 5)) do
1421 begin
1422 VGear:= AddVisualGear(
1423 t^.cX[i] - ((t^.cX[i] - hwround(Gear^.X)) div 2),
1424 t^.cY[i] - ((t^.cY[i] - hwround(Gear^.Y)) div 2),
1425 vgtStraightShot);
1426 if VGear <> nil then
1427 with VGear^ do
1428 begin
1429 Tint:= $FFCC00FF;
1430 Angle:= random(360);
1431 dx:= 0.0005 * (random(100));
1432 dy:= 0.0005 * (random(100));
1433 if random(2) = 0 then
1434 dx := -dx;
1435 if random(2) = 0 then
1436 dy := -dy;
1437 FrameTicks:= 600+random(200);
1438 State:= ord(sprStar)
1439 end
1440 end;
1441 ApplyDamage(Gear, Ammo^.Hedgehog, tmpDmg, dsShove);
1442
1443 if Gear^.Kind = gtAirmine then
1444 begin
1445 Gear^.Tag:= 1;
1446 Gear^.FlightTime:= 5000;
1447 end
1448 end
1449 else
1450 Gear^.State:= Gear^.State or gstWinner;
1451 if (Gear^.Kind = gtExplosives) and (Ammo^.Kind = gtBlowtorch) then
1452 begin
1453 if (Ammo^.Hedgehog^.Gear <> nil) then
1454 Ammo^.Hedgehog^.Gear^.State:= Ammo^.Hedgehog^.Gear^.State and (not gstNotKickable);
1455 ApplyDamage(Gear, Ammo^.Hedgehog, tmpDmg * 100, dsExplosion); // crank up damage for explosives + blowtorch
1456 end;
1457
1458 if (Gear^.Kind = gtHedgehog) and (Gear^.Hedgehog^.King or (Gear^.Hedgehog^.Effects[heFrozen] > 0)) then
1459 begin
1460 Gear^.dX:= Ammo^.dX * Power * _0_005;
1461 Gear^.dY:= Ammo^.dY * Power * _0_005
1462 end
1463 else if ((Ammo^.Kind <> gtFlame) or (Gear^.Kind = gtHedgehog)) and (Power <> 0) then
1464 begin
1465 Gear^.dX:= Ammo^.dX * Power * _0_01;
1466 Gear^.dY:= Ammo^.dY * Power * _0_01
1467 end;
1468
1469 if (not isZero(Gear^.dX)) or (not isZero(Gear^.dY)) then
1470 begin
1471 Gear^.Active:= true;
1472 DeleteCI(Gear);
1473 Gear^.State:= Gear^.State or gstMoving;
1474 if Gear^.Kind = gtKnife then Gear^.State:= Gear^.State and (not gstCollision);
1475 // move the gear upwards a bit to throw it over tiny obstacles at start
1476 if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) <> 0 then
1477 begin
1478 if (TestCollisionXwithXYShift(Gear, _0, -3, hwSign(Gear^.dX)) = 0) and
1479 (TestCollisionYwithGear(Gear, -1) = 0) then
1480 Gear^.Y:= Gear^.Y - _1;
1481 if (TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX)) = 0) and
1482 (TestCollisionYwithGear(Gear, -1) = 0) then
1483 Gear^.Y:= Gear^.Y - _1;
1484 if (TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX)) = 0) and
1485 (TestCollisionYwithGear(Gear, -1) = 0) then
1486 Gear^.Y:= Gear^.Y - _1;
1487 end
1488 end;
1489
1490
1491 if (Ammo^.Kind <> gtFlame) or ((Ammo^.State and gsttmpFlag) = 0) then
1492 FollowGear:= Gear
1493 end;
1494 end
1495 end;
1496 end;
1497 if i <> 0 then
1498 SetAllToActive
1499 end;
1500
1501 procedure AmmoShoveLine(Ammo: PGear; Damage, Power: LongInt; oX, oY, tX, tY: hwFloat);
1502 var t: PGearArray;
1503 begin
1504 t:= CheckAllGearsLineCollision(Ammo, oX, oY, tX, tY);
1505 AmmoShoveImpl(Ammo, Damage, Power, t);
1506 end;
1507
1508 procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt);
1509 begin
1510 AmmoShoveImpl(Ammo, Damage, Power,
1511 CheckGearsCollision(Ammo));
1512 end;
1513
1514 procedure AmmoShoveCache(Ammo: PGear; Damage, Power: LongInt);
1515 begin
1516 AmmoShoveImpl(Ammo, Damage, Power,
1517 CheckCacheCollision(Ammo));
1518 end;
1519
CountGearsnull1520 function CountGears(Kind: TGearType): Longword;
1521 var t: PGear;
1522 count: Longword = 0;
1523 begin
1524
1525 t:= GearsList;
1526 while t <> nil do
1527 begin
1528 if t^.Kind = Kind then
1529 inc(count);
1530 t:= t^.NextGear
1531 end;
1532 CountGears:= count;
1533 end;
1534
1535 procedure SetAllToActive;
1536 var t: PGear;
1537 begin
1538 AllInactive:= false;
1539 t:= GearsList;
1540 while t <> nil do
1541 begin
1542 t^.Active:= true;
1543 t:= t^.NextGear
1544 end
1545 end;
1546
1547 procedure SetAllHHToActive; inline;
1548 begin
1549 SetAllHHToActive(true)
1550 end;
1551
1552
1553 procedure SetAllHHToActive(Ice: boolean);
1554 var t: PGear;
1555 begin
1556 AllInactive:= false;
1557 t:= GearsList;
1558 while t <> nil do
1559 begin
1560 if (t^.Kind = gtHedgehog) or (t^.Kind = gtExplosives) then
1561 begin
1562 if (t^.Kind = gtHedgehog) and Ice then CheckIce(t);
1563 t^.Active:= true
1564 end;
1565 t:= t^.NextGear
1566 end
1567 end;
1568
1569
1570 var GearsNearArray : TPGearArray;
GearsNearnull1571 function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS;
1572 var
1573 t: PGear;
1574 s: Longword;
1575 xc, xc_left, xc_right, yc: hwFloat;
1576 begin
1577 r:= r*r;
1578 s:= 0;
1579 SetLength(GearsNearArray, s);
1580 t := GearsList;
1581 while t <> nil do
1582 begin
1583 xc:= (X - t^.X)*(X - t^.X);
1584 xc_left:= ((X - int2hwFloat(RightX-LeftX)) - t^.X)*((X - int2hwFloat(RightX-LeftX)) - t^.X);
1585 xc_right := ((X + int2hwFloat(RightX-LeftX)) - t^.X)*((X + int2hwFloat(RightX-LeftX)) - t^.X);
1586 yc:= (Y - t^.Y)*(Y - t^.Y);
1587 if (t^.Kind = Kind)
1588 and ((xc + yc < int2hwFloat(r))
1589 or ((WorldEdge = weWrap) and
1590 ((xc_left + yc < int2hwFloat(r)) or
1591 (xc_right + yc < int2hwFloat(r))))) then
1592 begin
1593 inc(s);
1594 SetLength(GearsNearArray, s);
1595 GearsNearArray[s - 1] := t;
1596 end;
1597 t := t^.NextGear;
1598 end;
1599
1600 GearsNear.size:= s;
1601 GearsNear.ar:= @GearsNearArray
1602 end;
1603
SpawnBoxOfSmthnull1604 function SpawnBoxOfSmth: PGear;
1605 var t, aTot, uTot, a, h: LongInt;
1606 i: TAmmoType;
1607 begin
1608 SpawnBoxOfSmth:= nil;
1609 if (PlacingHogs) or (PlacingKings) or
1610 (cCaseFactor = 0)
1611 or (CountGears(gtCase) >= cMaxCaseDrops)
1612 or (GetRandom(cCaseFactor) <> 0) then
1613 exit;
1614
1615 FollowGear:= nil;
1616 aTot:= 0;
1617 uTot:= 0;
1618 for i:= Low(TAmmoType) to High(TAmmoType) do
1619 if (Ammoz[i].Ammo.Propz and ammoprop_Utility) = 0 then
1620 inc(aTot, Ammoz[i].Probability)
1621 else
1622 inc(uTot, Ammoz[i].Probability);
1623
1624 t:=0;
1625 a:=aTot;
1626 h:= 1;
1627
1628 if (aTot+uTot) <> 0 then
1629 if ((GameFlags and gfInvulnerable) = 0) then
1630 begin
1631 h:= cHealthCaseProb * 100;
1632 t:= GetRandom(10000);
1633 a:= (10000-h)*aTot div (aTot+uTot)
1634 end
1635 else
1636 begin
1637 t:= GetRandom(aTot+uTot);
1638 h:= 0
1639 end;
1640
1641
1642 if t<h then
1643 begin
1644 FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0);
1645 FollowGear^.RenderHealth:= true;
1646 FollowGear^.Health:= cHealthCaseAmount;
1647 FollowGear^.Pos:= posCaseHealth;
1648 // health crate is smaller than the other crates
1649 FollowGear^.Radius := cCaseHealthRadius;
1650 AddCaption(GetEventString(eidNewHealthPack), capcolDefault, capgrpAmmoInfo);
1651 end
1652 else if (t<a+h) then
1653 begin
1654 t:= aTot;
1655 if (t > 0) then
1656 begin
1657 FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0);
1658 t:= GetRandom(t);
1659 i:= Low(TAmmoType);
1660 FollowGear^.Pos:= posCaseAmmo;
1661 FollowGear^.AmmoType:= i;
1662 AddCaption(GetEventString(eidNewAmmoPack), capcolDefault, capgrpAmmoInfo);
1663 end
1664 end
1665 else
1666 begin
1667 t:= uTot;
1668 if (t > 0) then
1669 begin
1670 FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0);
1671 t:= GetRandom(t);
1672 i:= Low(TAmmoType);
1673 FollowGear^.Pos:= posCaseUtility;
1674 FollowGear^.AmmoType:= i;
1675 AddCaption(GetEventString(eidNewUtilityPack), capcolDefault, capgrpAmmoInfo);
1676 end
1677 end;
1678
1679 // handles case of no ammo or utility crates - considered also placing booleans in uAmmos and altering probabilities
1680 if (FollowGear <> nil) then
1681 begin
1682 FindPlace(FollowGear, true, 0, LAND_WIDTH);
1683 PlayBoxSpawnTaunt(FollowGear);
1684 SpawnBoxOfSmth:= FollowGear;
1685 end
1686 end;
1687
1688 procedure PlayBoxSpawnTaunt(Gear: PGear);
1689 const
1690 // Max. distance between hog and crate for sndThisOneIsMine taunt
1691 ThisOneIsMineDistance : LongInt = 130;
1692 var d, minD: LongInt;
1693 gi, closestHog: PGear;
1694 begin
1695 // Taunt
1696 if (Gear <> nil) then
1697 begin
1698 // Look for hog closest to the crate (on the X axis)
1699 gi := GearsList;
1700 minD := LAND_WIDTH + ThisOneIsMineDistance + 1;
1701 closestHog:= nil;
1702 while gi <> nil do
1703 begin
1704 if (gi^.Kind = gtHedgehog) then
1705 begin
1706 // Y axis is ignored to simplify calculations
1707 d := hwRound(hwAbs(gi^.X - Gear^.X));
1708 if d < minD then
1709 begin
1710 minD := d;
1711 closestHog:= gi;
1712 end;
1713 end;
1714 gi := gi^.NextGear;
1715 end;
1716
1717 // Is closest hog close enough to the crate (on the X axis)?
1718 if (closestHog <> nil) and (closestHog^.Hedgehog <> nil) and (minD <= ThisOneIsMineDistance) then
1719 // If so, there's a chance for a special taunt
1720 if random(3) > 0 then
1721 AddVoice(sndThisOneIsMine, closestHog^.Hedgehog^.Team^.voicepack)
1722 else
1723 AddVoice(sndReinforce, CurrentTeam^.voicepack)
1724 else
1725 // Default crate drop taunt
1726 AddVoice(sndReinforce, CurrentTeam^.voicepack);
1727 end;
1728 end;
1729
1730
1731 function GetAmmo(Hedgehog: PHedgehog): TAmmoType;
1732 var t, aTot: LongInt;
1733 i: TAmmoType;
1734 begin
1735 Hedgehog:= Hedgehog; // avoid hint
1736
1737 aTot:= 0;
1738 for i:= Low(TAmmoType) to High(TAmmoType) do
1739 if (Ammoz[i].Ammo.Propz and ammoprop_Utility) = 0 then
1740 inc(aTot, Ammoz[i].Probability);
1741
1742 t:= aTot;
1743 i:= Low(TAmmoType);
1744 if (t > 0) then
1745 begin
1746 t:= GetRandom(t);
1747 while t >= 0 do
1748 begin
1749 inc(i);
1750 if (Ammoz[i].Ammo.Propz and ammoprop_Utility) = 0 then
1751 dec(t, Ammoz[i].Probability)
1752 end
1753 end;
1754 GetAmmo:= i
1755 end;
1756
1757 function GetUtility(Hedgehog: PHedgehog): TAmmoType;
1758 var t, uTot: LongInt;
1759 i: TAmmoType;
1760 begin
1761
1762 uTot:= 0;
1763 for i:= Low(TAmmoType) to High(TAmmoType) do
1764 if ((Ammoz[i].Ammo.Propz and ammoprop_Utility) <> 0)
1765 and ((Hedgehog^.Team^.HedgehogsNumber > 1) or (Ammoz[i].Ammo.AmmoType <> amSwitch)) then
1766 inc(uTot, Ammoz[i].Probability);
1767
1768 t:= uTot;
1769 i:= Low(TAmmoType);
1770 if (t > 0) then
1771 begin
1772 t:= GetRandom(t);
1773 while t >= 0 do
1774 begin
1775 inc(i);
1776 if ((Ammoz[i].Ammo.Propz and ammoprop_Utility) <> 0) and ((Hedgehog^.Team^.HedgehogsNumber > 1)
1777 or (Ammoz[i].Ammo.AmmoType <> amSwitch)) then
1778 dec(t, Ammoz[i].Probability)
1779 end
1780 end;
1781 GetUtility:= i
1782 end;
1783
1784 (*
1785 Intended to check Gear X/Y against the map left/right edges and apply one of the world modes
1786 * Normal - infinite world, do nothing
1787 * Wrap (entering left edge exits at same height on right edge)
1788 * Bounce (striking edge is treated as a 100% elasticity bounce)
1789 * From the depths (same as from sky, but from sea, with submersible flag set)
1790
1791 Trying to make the checks a little broader than on first pass to catch things that don't move normally.
1792 *)
WorldWrapnull1793 function WorldWrap(var Gear: PGear): boolean;
1794 var bounced: boolean;
1795 begin
1796 WorldWrap:= false;
1797 if WorldEdge = weNone then exit(false);
1798 if (hwRound(Gear^.X) < leftX) or
1799 (hwRound(Gear^.X) > rightX) then
1800 begin
1801 if WorldEdge = weWrap then
1802 begin
1803 if (hwRound(Gear^.X) < leftX) then
1804 Gear^.X:= Gear^.X + int2hwfloat(rightX - leftX)
1805 else Gear^.X:= Gear^.X - int2hwfloat(rightX - leftX);
1806 LeftImpactTimer:= 150;
1807 RightImpactTimer:= 150;
1808 WorldWrap:= true;
1809 end
1810 else if WorldEdge = weBounce then
1811 begin
1812 bounced:= false;
1813 // Bounce left
1814 if (hwRound(Gear^.X) - Gear^.Radius < leftX) and (((hwSign(Gear^.dX) = -1) and (not isZero(Gear^.dX))) or (Gear^.Kind = gtHedgehog)) then
1815 begin
1816 LeftImpactTimer:= 333;
1817 // Set X coordinate to bounce edge, unless the gear spawned inside the bounce edge before
1818 if (Gear^.State and gstInBounceEdge) = 0 then
1819 Gear^.X:= int2hwfloat(leftX + Gear^.Radius);
1820 // Invert horizontal speed
1821 Gear^.dX.isNegative:= false;
1822 bounced:= true;
1823 end
1824 // Bounce right
1825 else if (hwRound(Gear^.X) + Gear^.Radius > rightX) and (((hwSign(Gear^.dX) = 1) and (not isZero(Gear^.dX))) or (Gear^.Kind = gtHedgehog)) then
1826 begin
1827 RightImpactTimer:= 333;
1828 // Set X coordinate to bounce edge, unless the gear spawned inside the bounce edge before
1829 if (Gear^.State and gstInBounceEdge) = 0 then
1830 Gear^.X:= int2hwfloat(rightX - Gear^.Radius);
1831 // Invert horizontal speed
1832 Gear^.dX.isNegative:= true;
1833 bounced:= true;
1834 end;
1835 // Clear gstInBounceEdge when gear is no longer inside a bounce edge area
1836 if ((Gear^.State and gstInBounceEdge) <> 0) and (hwRound(Gear^.X) - Gear^.Radius >= leftX) and (hwRound(Gear^.X) + Gear^.Radius <= rightX) then
1837 Gear^.State:= Gear^.State and (not gstInBounceEdge);
1838 if (bounced) then
1839 begin
1840 WorldWrap:= true;
1841 if (Gear^.dX.QWordValue > _0_001.QWordValue) then
1842 AddBounceEffectForGear(Gear);
1843 end;
1844 end
1845 else
1846 WorldWrap:= true;
1847 end;
1848 end;
1849
1850 (*
1851 Applies wrap-around logic for the target of homing gears.
1852
1853 In wrap-around world edge, the shortest way may to the target might
1854 be across the border, so the X value of the target would lead the
1855 gear to the wrong direction across the whole map. This procedure
1856 changes the target X in this case.
1857 This function must be called after the gear passed through
1858 the wrap-around world edge (WorldWrap returned true).
1859
1860 No-op for other world edges.
1861
1862 Returns true if target has been changed.
1863 *)
HomingWrapnull1864 function HomingWrap(var Gear: PGear): boolean;
1865 var dist_center, dist_right, dist_left: hwFloat;
1866 begin
1867 if WorldEdge = weWrap then
1868 begin
1869 HomingWrap:= false;
1870 // We just check the same target 3 times:
1871 // 1) in current section (no change)
1872 // 2) clone in the right section
1873 // 3) clone in the left section
1874 // The gear will go for the target with the shortest distance to the gear.
1875 // For simplicity, we only check distance on the X axis.
1876 dist_center:= hwAbs(Gear^.X - int2hwFloat(Gear^.Target.X));
1877 dist_right:= hwAbs(Gear^.X - int2hwFloat(Gear^.Target.X + (RightX-LeftX)));
1878 dist_left:= hwAbs(Gear^.X - int2hwFloat(Gear^.Target.X - (RightX-LeftX)));
1879 if (dist_left < dist_right) and (dist_left < dist_center) then
1880 begin
1881 dec(Gear^.Target.X, RightX-LeftX);
1882 HomingWrap:= true;
1883 end
1884 else if (dist_right < dist_left) and (dist_right < dist_center) then
1885 begin
1886 inc(Gear^.Target.X, RightX-LeftX);
1887 HomingWrap:= true;
1888 end;
1889 end;
1890 end;
1891
1892 // Add an audiovisual bounce effect for gear after it bounced from bouncy material.
1893 // Graphical effect is based on speed.
1894 procedure AddBounceEffectForGear(Gear: PGear);
1895 begin
1896 AddBounceEffectForGear(Gear, hwFloat2Float(Gear^.Density * hwAbs(Gear^.dY) + hwAbs(Gear^.dX)) / 1.5);
1897 end;
1898
1899 // Same as above, but can specify the size of bounce image with imageScale manually.
1900 procedure AddBounceEffectForGear(Gear: PGear; imageScale: Single);
1901 var boing: PVisualGear;
1902 begin
1903 if (Gear^.Density < _0_01) or (Gear^.Radius < 2) then
1904 exit;
1905 boing:= AddVisualGear(hwRound(Gear^.X), hwRound(Gear^.Y), vgtStraightShot, 0, false, 1);
1906 if boing <> nil then
1907 with boing^ do
1908 begin
1909 Angle:= random(360);
1910 dx:= 0;
1911 dy:= 0;
1912 FrameTicks:= 200;
1913 Scale:= imageScale;
1914 State:= ord(sprBoing)
1915 end;
1916 PlaySound(sndMelonImpact, true)
1917 end;
1918
IsHogFacingLeftnull1919 function IsHogFacingLeft(Gear: PGear): boolean;
1920 var sign: LongInt;
1921 begin
1922 sign:= hwSign(Gear^.dX);
1923 if (CurAmmoGear <> nil) and (CurAmmoGear^.Kind = gtParachute) then
1924 IsHogFacingLeft:= CurAmmoGear^.Tag = -1
1925 else if ((Gear^.State and gstHHHJump) <> 0) and (Gear^.Hedgehog^.Effects[heArtillery] = 0) then
1926 IsHogFacingLeft:= sign > 0
1927 else
1928 IsHogFacingLeft:= sign < 0;
1929 end;
1930
IsHogLocalnull1931 function IsHogLocal(HH: PHedgehog): boolean;
1932 begin
1933 IsHogLocal:= (not (HH^.Team^.ExtDriven or (HH^.BotLevel > 0))) or (HH^.Team^.Clan^.LocalOrAlly) or (GameType = gmtDemo);
1934 end;
1935
1936 end.
1937