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 uGears;
22 (*
23 * This unit defines the behavior of gears.
24 *
25 * Gears are "things"/"objects" that may be visible to the player or not,
26 * but always have an effect on the course of the game.
27 *
28 * E.g.: weapons, hedgehogs, etc.
29 *
30 * Note: The visual appearance of gears is defined in the unit "uGearsRender".
31 *
32 * Note: Gears that do not have an effect on the game but are just visual
33 * effects are called "Visual Gears" and defined in the respective unit!
34 *)
35 interface
36 uses uConsts, uFloat, uTypes, uChat, uCollisions;
37
38 procedure initModule;
39 procedure freeModule;
SpawnCustomCrateAtnull40 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content, cnt: Longword): PGear;
SpawnFakeCrateAtnull41 function SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean ): PGear;
42 procedure ProcessGears;
43 procedure EndTurnCleanup;
44 procedure DrawGears;
45 procedure DrawGearsGui;
46 procedure DrawFinger;
47 procedure FreeGearsList;
48 procedure AddMiscGears;
49 procedure AssignHHCoords;
50 procedure RandomizeHHAnim;
51 procedure StartSuddenDeath;
GearByUIDnull52 function GearByUID(uid : Longword) : PGear;
IsClockRunningnull53 function IsClockRunning() : boolean;
54
55 implementation
56 uses uStore, uSound, uTeams, uRandom, uIO, uLandGraphics,
57 {$IFDEF USE_TOUCH_INTERFACE}uTouch,{$ENDIF}
58 uLocale, uAmmos, uStats, uVisualGears, uScript, uVariables,
59 uCommands, uUtils, uTextures, uRenderUtils, uGearsRender, uCaptions,
60 uGearsHedgehog, uGearsUtils, uGearsList, uGearsHandlersRope
61 , uVisualGearsList, uGearsHandlersMess, uAI;
62
63 var skipFlag: boolean;
64
65 var delay: LongWord;
66 delay2: LongWord;
67 step: (stInit, stDelay1, stChDmg, stSweep, stTurnStats, stChWin1,
68 stTurnReact, stDelay2, stChWin2, stWater, stChWin3,
69 stChKing, stSuddenDeath, stDelay3, stHealth, stSpawn, stDelay4,
70 stNTurn);
71 NewTurnTick: LongWord;
72
73 const delayInit = 50;
74 delaySDStart = 1600;
75 delaySDWarning = 1000;
76 delayDamageTagFull = 1500;
77 delayDamageTagShort = 500;
78 delayTurnReact = 800;
79 delayFinal = 100;
80
CheckNoDamagenull81 function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
82 var Gear: PGear;
83 dmg: LongInt;
84 begin
85 CheckNoDamage:= true;
86 Gear:= GearsList;
87 while Gear <> nil do
88 begin
89 if (Gear^.Kind = gtHedgehog) and (((GameFlags and gfInfAttack) = 0) or ((Gear^.dX.QWordValue < _0_000004.QWordValue)
90 and (Gear^.dY.QWordValue < _0_000004.QWordValue))) then
91 begin
92 if (not isInMultiShoot) then
93 inc(Gear^.Damage, Gear^.Karma);
94 if (Gear^.Damage <> 0) and ((Gear^.Hedgehog^.Effects[heInvulnerable] = 0)) then
95 begin
96 CheckNoDamage:= false;
97
98 dmg:= Gear^.Damage;
99 if (Gear^.Health < dmg) then
100 begin
101 Gear^.Active:= true;
102 Gear^.Health:= 0
103 end
104 else
105 dec(Gear^.Health, dmg);
106 (*
107 This doesn't fit well w/ the new loser sprite which is cringing from an attack.
108 if (Gear^.Hedgehog^.Team = CurrentTeam) and (Gear^.Damage <> Gear^.Karma)
109 and (not Gear^.Hedgehog^.King) and (Gear^.Hedgehog^.Effects[hePoisoned] = 0) and (not SuddenDeathDmg) then
110 Gear^.State:= Gear^.State or gstLoser;
111 *)
112
113 spawnHealthTagForHH(Gear, dmg);
114
115 RenderHealth(Gear^.Hedgehog^);
116 RecountTeamHealth(Gear^.Hedgehog^.Team);
117
118 end
119 else if ((GameFlags and gfKing) <> 0) and (not Gear^.Hedgehog^.Team^.hasKing) then
120 begin
121 Gear^.Active:= true;
122 Gear^.Health:= 0;
123 RenderHealth(Gear^.Hedgehog^);
124 RecountTeamHealth(Gear^.Hedgehog^.Team);
125 end;
126
127 if (not isInMultiShoot) then
128 Gear^.Karma:= 0;
129 Gear^.Damage:= 0
130 end;
131 Gear:= Gear^.NextGear
132 end;
133 end;
134
DoDelaynull135 function DoDelay: boolean;
136 begin
137 if delay <= 0 then
138 delay:= 1
139 else
140 dec(delay);
141 DoDelay:= delay = 0;
142 end;
143
CheckMinionsDienull144 function CheckMinionsDie: boolean;
145 var Gear: PGear;
146 begin
147 CheckMinionsDie:= false;
148 if (GameFlags and gfKing) = 0 then
149 exit;
150
151 Gear:= GearsList;
152 while Gear <> nil do
153 begin
154 if (Gear^.Kind = gtHedgehog) and (not Gear^.Hedgehog^.King) and (not Gear^.Hedgehog^.Team^.hasKing) then
155 begin
156 CheckMinionsDie:= true;
157 exit;
158 end;
159 Gear:= Gear^.NextGear;
160 end;
161 end;
162
163 procedure HealthMachine;
164 var Gear: PGear;
165 team: PTeam;
166 i: LongWord;
167 flag: Boolean;
168 tmp: LongWord;
169 begin
170 Gear:= GearsList;
171
172 while Gear <> nil do
173 begin
174 if Gear^.Kind = gtHedgehog then
175 begin
176 tmp:= 0;
177 // Deal poison damage (when not frozen)
178 if (Gear^.Hedgehog^.Effects[hePoisoned] <> 0) and (Gear^.Hedgehog^.Effects[heFrozen] = 0) then
179 begin
180 inc(tmp, ModifyDamage(Gear^.Hedgehog^.Effects[hePoisoned], Gear));
181 if (GameFlags and gfResetHealth) <> 0 then
182 dec(Gear^.Hedgehog^.InitialHealth);
183 end;
184 // Apply SD health decrease as soon as SD starts
185 if (TotalRoundsPre > cSuddenDTurns - 1) then
186 begin
187 inc(tmp, cHealthDecrease);
188 if (GameFlags and gfResetHealth) <> 0 then
189 dec(Gear^.Hedgehog^.InitialHealth, cHealthDecrease)
190 end;
191 // Reduce king health when he is alone in team
192 if Gear^.Hedgehog^.King then
193 begin
194 flag:= false;
195 team:= Gear^.Hedgehog^.Team;
196 for i:= 0 to Pred(team^.HedgehogsNumber) do
197 if (team^.Hedgehogs[i].Gear <> nil) and (not team^.Hedgehogs[i].King)
198 and (team^.Hedgehogs[i].Gear^.Health > team^.Hedgehogs[i].Gear^.Damage) then
199 flag:= true;
200 if not flag then
201 begin
202 inc(tmp, 5);
203 if (GameFlags and gfResetHealth) <> 0 then
204 dec(Gear^.Hedgehog^.InitialHealth, 5)
205 end
206 end;
207 // Initial health must never be below 1 because hog might be resurrected
208 if Gear^.Hedgehog^.InitialHealth < 1 then
209 Gear^.Hedgehog^.InitialHealth:= 1;
210 // Set real damage
211 if tmp > 0 then
212 begin
213 // SD damage never reduces health below 1
214 tmp:= min(tmp, max(0, Gear^.Health - 1 - Gear^.Damage));
215 inc(Gear^.Damage, tmp);
216 if tmp > 0 then
217 // Make hedgehog moan on damage
218 HHHurt(Gear^.Hedgehog, dsPoison, tmp);
219 end
220 end;
221
222 Gear:= Gear^.NextGear
223 end;
224 end;
225
226 procedure ProcessGears;
227 var t, tmpGear: PGear;
228 i, j, AliveCount: LongInt;
229 s: ansistring;
230 prevtime: LongWord;
231 stirFallers: boolean;
232 begin
233 stirFallers:= false;
234 prevtime:= TurnTimeLeft;
235 ScriptCall('onGameTick');
236 if GameTicks mod 20 = 0 then ScriptCall('onGameTick20');
237 if GameTicks = NewTurnTick then
238 begin
239 ScriptCall('onNewTurn');
240 {$IFDEF USE_TOUCH_INTERFACE}
241 uTouch.NewTurnBeginning();
242 {$ENDIF}
243 end;
244
245 PrvInactive:= AllInactive;
246 AllInactive:= true;
247
248 if (StepSoundTimer > 0) and (StepSoundChannel < 0) then
249 StepSoundChannel:= LoopSound(sndSteps)
250 else if (StepSoundTimer = 0) and (StepSoundChannel > -1) then
251 begin
252 StopSoundChan(StepSoundChannel);
253 StepSoundChannel:= -1
254 end;
255
256 if StepSoundTimer > 0 then
257 dec(StepSoundTimer, 1);
258
259 t:= GearsList;
260 while t <> nil do
261 begin
262 curHandledGear:= t;
263 t:= curHandledGear^.NextGear;
264 if (GameTicks and $1FFF = 0) and (curHandledGear^.Kind = gtCase) and (curHandledGear^.Pos <> posCaseHealth) then
265 stirFallers := true;
266
267 if curHandledGear^.Message and gmDelete <> 0 then
268 DeleteGear(curHandledGear)
269 else
270 begin
271 if curHandledGear^.Message and gmRemoveFromList <> 0 then
272 begin
273 RemoveGearFromList(curHandledGear);
274 // since I can't think of any good reason this would ever be separate from a remove from list, going to keep it inside this block
275 if curHandledGear^.Message and gmAddToList <> 0 then InsertGearToList(curHandledGear);
276 curHandledGear^.Message:= curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList))
277 end;
278 if curHandledGear^.Active then
279 begin
280 if (not cOnlyStats) and curHandledGear^.RenderTimer then
281 begin
282 // Mine timer
283 if (curHandledGear^.Kind in [gtMine, gtSMine, gtAirMine]) then
284 begin
285 if curHandledGear^.Tex = nil then
286 if (curHandledGear^.Karma = 1) and (not (GameType in [gmtDemo, gmtRecord])) then
287 // Secret mine timer
288 curHandledGear^.Tex:= RenderStringTex(trmsg[sidUnknownGearValue], $ff808080, fntSmall)
289 else
290 begin
291 // Display mine timer with up to 1 decimal point of precision (rounded down)
292 i:= curHandledGear^.Timer div 1000;
293 j:= (curHandledGear^.Timer mod 1000) div 100;
294 if j = 0 then
295 curHandledGear^.Tex:= RenderStringTex(ansistring(inttostr(i)), $ff808080, fntSmall)
296 else
297 curHandledGear^.Tex:= RenderStringTex(ansistring(inttostr(i) + lDecimalSeparator + inttostr(j)), $ff808080, fntSmall);
298 end
299 end
300 // Timer of other gears
301 else if ((curHandledGear^.Timer > 500) and ((curHandledGear^.Timer mod 1000) = 0)) then
302 begin
303 // Display time in seconds as whole number, rounded up
304 FreeAndNilTexture(curHandledGear^.Tex);
305 curHandledGear^.Tex:= RenderStringTex(ansistring(inttostr(curHandledGear^.Timer div 1000)), cWhiteColor, fntSmall);
306 end;
307 end;
308 curHandledGear^.doStep(curHandledGear);
309 end
310 end
311 end;
312 if stirFallers then
313 begin
314 t := GearsList;
315 while t <> nil do
316 begin
317 if (t^.Kind = gtGenericFaller) and (t^.Tag = 1) then
318 begin
319 t^.Active:= true;
320 t^.X:= int2hwFloat(GetRandom(rightX-leftX)+leftX);
321 t^.Y:= int2hwFloat(GetRandom(LAND_HEIGHT-topY)+topY);
322 t^.dX:= _90-(GetRandomf*_360);
323 t^.dY:= _90-(GetRandomf*_360)
324 end;
325 t := t^.NextGear
326 end
327 end;
328
329 curHandledGear:= nil;
330
331 if AllInactive then
332 case step of
333 stInit:
334 begin
335 if (not bBetweenTurns) and (not isInMultiShoot) then
336 ScriptCall('onEndTurn');
337 delay:= delayInit;
338 inc(step)
339 end;
340 stDelay1:
341 begin
342 if DoDelay() then
343 inc(step);
344 end;
345 stChDmg:
346 if CheckNoDamage then
347 inc(step)
348 else
349 begin
350 if (not bBetweenTurns) and (not isInMultiShoot) then
351 delay:= delayDamageTagShort
352 else
353 delay:= delayDamageTagFull;
354 step:= stDelay1;
355 end;
356
357 stSweep:
358 if SweepDirty then
359 begin
360 SetAllToActive;
361 step:= stChDmg
362 end
363 else
364 inc(step);
365
366 stTurnStats:
367 begin
368 if (not bBetweenTurns) and (not isInMultiShoot) then
369 uStats.TurnStats;
370 inc(step)
371 end;
372
373 stChWin1:
374 begin
375 CheckForWin();
376 inc(step)
377 end;
378
379 stTurnReact:
380 begin
381 if (not bBetweenTurns) and (not isInMultiShoot) then
382 begin
383 uStats.TurnReaction;
384 uStats.TurnStatsReset;
385 delay:= delayTurnReact;
386 inc(step)
387 end
388 else
389 inc(step, 2);
390 end;
391
392 stDelay2:
393 if DoDelay() then
394 inc(step);
395 stChWin2:
396 begin
397 CheckForWin();
398 inc(step)
399 end;
400 stWater:
401 if (not bBetweenTurns) and (not isInMultiShoot) then
402 begin
403 // Start Sudden Death water rise in the 2nd round of Sudden Death
404 if TotalRoundsPre = cSuddenDTurns + 1 then
405 bWaterRising:= true;
406 if bWaterRising and (cWaterRise > 0) then
407 begin
408 bDuringWaterRise:= true;
409 AddGear(0, 0, gtWaterUp, 0, _0, _0, 0)^.Tag:= cWaterRise;
410 end;
411 inc(step)
412 end
413 else // since we are not raising the water, another win-check isn't needed
414 inc(step,2);
415 stChWin3:
416 begin
417 CheckForWin;
418 bDuringWaterRise:= false;
419 inc(step)
420 end;
421
422 stChKing:
423 begin
424 if (not isInMultiShoot) and (CheckMinionsDie) then
425 step:= stChDmg
426 else
427 inc(step);
428 end;
429 stSuddenDeath:
430 begin
431 if ((cWaterRise <> 0) or (cHealthDecrease <> 0)) and (not (isInMultiShoot or bBetweenTurns)) then
432 begin
433 // Start Sudden Death
434 if (TotalRoundsPre = cSuddenDTurns) and (not SuddenDeath) then
435 begin
436 StartSuddenDeath();
437 delay:= delaySDStart;
438 inc(step);
439 end
440 // Show Sudden Death warning message
441 else if (TotalRoundsPre < cSuddenDTurns) and ((LastSuddenDWarn = -2) or (LastSuddenDWarn <> TotalRoundsPre)) then
442 begin
443 i:= cSuddenDTurns - TotalRoundsPre;
444 s:= ansistring(inttostr(i));
445 // X rounds before SD. X = 1, 2, 3, 5, 7, 10, 15, 20, 25, 50, 100, ...
446 if (i > 0) and ((i <= 3) or (i = 7) or ((i mod 50 = 0) or ((i <= 25) and (i mod 5 = 0)))) then
447 begin
448 if i = 1 then
449 AddCaption(trmsg[sidRoundSD], capcolDefault, capgrpGameState)
450 else
451 AddCaption(FormatA(trmsg[sidRoundsSD], s), capcolDefault, capgrpGameState);
452 delay:= delaySDWarning;
453 inc(step);
454 LastSuddenDWarn:= TotalRoundsPre;
455 end
456 else
457 inc(step, 2);
458 end
459 else
460 inc(step, 2);
461 end
462 else
463 inc(step, 2);
464 end;
465 stDelay3:
466 if DoDelay() then
467 inc(step);
468 stHealth:
469 begin
470 if bBetweenTurns
471 or isInMultiShoot
472 or (TotalRoundsReal = -1) then
473 inc(step)
474 else
475 begin
476 bBetweenTurns:= true;
477 HealthMachine;
478 step:= stChDmg
479 end;
480 end;
481 stSpawn:
482 begin
483 if (not isInMultiShoot) then
484 begin
485 tmpGear:= SpawnBoxOfSmth;
486 if tmpGear <> nil then
487 ScriptCall('onCaseDrop', tmpGear^.uid)
488 else
489 ScriptCall('onCaseDrop');
490 delay:= delayFinal;
491 inc(step);
492 end
493 else
494 inc(step, 2)
495 end;
496 stDelay4:
497 if DoDelay() then
498 inc(step);
499 stNTurn:
500 begin
501 if isInMultiShoot then
502 isInMultiShoot:= false
503 else
504 begin
505 // delayed till after 0.9.12
506 // reset to default zoom
507 //ZoomValue:= ZoomDefault;
508 with CurrentHedgehog^ do
509 if (Gear <> nil)
510 and ((Gear^.State and gstAttacked) = 0)
511 and (MultiShootAttacks > 0) then
512 OnUsedAmmo(CurrentHedgehog^);
513
514 EndTurnCleanup;
515
516 FreeActionsList; // could send -left, -right and similar commands, so should be called before /nextturn
517
518 ParseCommand('/nextturn', true);
519 SwitchHedgehog;
520
521 AfterSwitchHedgehog;
522 bBetweenTurns:= false;
523 NewTurnTick:= GameTicks + 1
524 end;
525 step:= Low(step)
526 end;
527 end
528 else if ((GameFlags and gfInfAttack) <> 0) then
529 begin
530 if delay2 = 0 then
531 delay2:= cInactDelay * 50
532 else
533 begin
534 dec(delay2);
535
536 if ((delay2 mod cInactDelay) = 0) and (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil)
537 and (not CurrentHedgehog^.Unplaced)
538 and (not PlacingHogs) then
539 begin
540 if (CurrentHedgehog^.Gear^.State and gstAttacked <> 0)
541 and (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NeedTarget <> 0) then
542 begin
543 CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstChooseTarget;
544 isCursorVisible := true
545 end;
546 CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State and (not gstAttacked);
547 end;
548 if delay2 = 0 then
549 begin
550 if (CurrentHedgehog^.Gear <> nil) and (CurrentHedgehog^.Gear^.State and gstAttacked = 0)
551 and (CurAmmoGear = nil) then
552 SweepDirty;
553 if (CurrentHedgehog^.Gear = nil) or (CurrentHedgehog^.Gear^.State and gstHHDriven = 0) or (CurrentHedgehog^.Gear^.Damage = 0) then
554 CheckNoDamage;
555 AliveCount:= 0; // shorter version of check for win to allow typical step activity to proceed
556 for i:= 0 to Pred(ClansCount) do
557 if ClansArray[i]^.ClanHealth > 0 then
558 inc(AliveCount);
559 if (AliveCount <= 1) and ((GameFlags and gfOneClanMode) = 0) then
560 begin
561 step:= stChDmg;
562 if TagTurnTimeLeft = 0 then
563 TagTurnTimeLeft:= TurnTimeLeft;
564 GameOver:= true;
565 TurnTimeLeft:= 0
566 end
567 end
568 end
569 end;
570
571 if TurnTimeLeft > 0 then
572 if IsClockRunning() then
573 begin
574 if (cHedgehogTurnTime > TurnTimeLeft)
575 and (CurrentHedgehog^.Gear <> nil)
576 and ((CurrentHedgehog^.Gear^.State and gstAttacked) = 0)
577 and (not isGetAwayTime) and (ReadyTimeLeft = 0) then
578 if (TurnTimeLeft = 5000) and (cHedgehogTurnTime >= 10000) then
579 PlaySoundV(sndHurry, CurrentTeam^.voicepack)
580 else if TurnTimeLeft = 4000 then
581 PlaySound(sndCountdown4)
582 else if TurnTimeLeft = 3000 then
583 PlaySound(sndCountdown3)
584 else if TurnTimeLeft = 2000 then
585 PlaySound(sndCountdown2)
586 else if TurnTimeLeft = 1000 then
587 PlaySound(sndCountdown1);
588 if ReadyTimeLeft > 0 then
589 begin
590 if (ReadyTimeLeft = 2000) and (LastVoice.snd = sndNone) and (not PlacingHogs) and (not CinematicScript) then
591 AddVoice(sndComeonthen, CurrentTeam^.voicepack);
592 dec(ReadyTimeLeft)
593 end
594 else
595 dec(TurnTimeLeft)
596 end;
597
598 if skipFlag then
599 begin
600 if TagTurnTimeLeft = 0 then
601 TagTurnTimeLeft:= TurnTimeLeft;
602 TurnTimeLeft:= 0;
603 skipFlag:= false;
604 inc(CurrentHedgehog^.Team^.stats.TurnSkips);
605 end;
606
607 if ((GameTicks and $FFFF) = $FFFF) then
608 begin
609 if (not CurrentTeam^.ExtDriven) then
610 begin
611 SendIPC(_S'#');
612 AddFileLog('hiTicks increment message sent')
613 end;
614
615 if (not CurrentTeam^.ExtDriven) or CurrentTeam^.hasGone then
616 begin
617 AddFileLog('hiTicks increment (current team is local or gone)');
618 inc(hiTicks) // we do not recieve a message for this
619 end
620 end;
621 AddRandomness(CheckSum);
622 TurnClockActive:= prevtime <> TurnTimeLeft;
623 inc(GameTicks);
624 if (OuchTauntTimer > 0) then
625 dec(OuchTauntTimer);
626 end;
627
628 //Purpose, to reset all transient attributes toggled by a utility and clean up various gears and effects at end of turn
629 //If any of these are set as permanent toggles in the frontend, that needs to be checked and skipped here.
630 procedure EndTurnCleanup;
631 var i: LongInt;
632 t: PGear;
633 begin
634 SpeechText:= ''; // in case it has not been consumed
635
636 if (GameFlags and gfLowGravity) = 0 then
637 begin
638 cGravity:= cMaxWindSpeed * 2;
639 cGravityf:= 0.00025 * 2;
640 cLowGravity:= false
641 end;
642
643 if (GameFlags and gfVampiric) = 0 then
644 cVampiric:= false;
645
646 cDamageModifier:= _1;
647
648 if (GameFlags and gfLaserSight) = 0 then
649 begin
650 cLaserSighting:= false;
651 cLaserSightingSniper:= false
652 end;
653
654 // have to sweep *all* current team hedgehogs since it is theoretically possible if you have enough invulnerabilities and switch turns to make your entire team invulnerable
655 if (CurrentTeam <> nil) then
656 with CurrentTeam^ do
657 for i:= 0 to cMaxHHIndex do
658 with Hedgehogs[i] do
659 begin
660
661 if (Gear <> nil) then
662 begin
663 if (GameFlags and gfInvulnerable) = 0 then
664 Gear^.Hedgehog^.Effects[heInvulnerable]:= 0;
665 if (Gear^.Hedgehog^.Effects[heArtillery] = 2) then
666 Gear^.Hedgehog^.Effects[heArtillery]:= 0;
667 end;
668 end;
669 t:= GearsList;
670 while t <> nil do
671 begin
672 t^.PortalCounter:= 0;
673 if ((GameFlags and gfResetHealth) <> 0) and (t^.Kind = gtHedgehog) and (t^.Health < t^.Hedgehog^.InitialHealth) then
674 begin
675 i:= t^.Hedgehog^.InitialHealth - t^.Health;
676 t^.Health:= t^.Hedgehog^.InitialHealth;
677 if i > 0 then
678 HHHeal(t^.Hedgehog, i, false, $00FF0040);
679 RenderHealth(t^.Hedgehog^);
680 end;
681 t:= t^.NextGear
682 end;
683
684 if ((GameFlags and gfResetWeps) <> 0) and (not PlacingHogs) and (not PlacingKings) then
685 ResetWeapons;
686
687 if (GameFlags and gfResetHealth) <> 0 then
688 for i:= 0 to Pred(TeamsCount) do
689 RecountTeamHealth(TeamsArray[i])
690 end;
691
692 procedure DrawGears;
693 var Gear: PGear;
694 x, y: LongInt;
695 begin
696 Gear:= GearsList;
697 while Gear <> nil do
698 begin
699 if (Gear^.State and gstInvisible = 0) and (Gear^.Message and gmRemoveFromList = 0) then
700 begin
701 x:= hwRound(Gear^.X) + WorldDx;
702 y:= hwRound(Gear^.Y) + WorldDy;
703 RenderGear(Gear, x, y);
704 end;
705 Gear:= Gear^.NextGear
706 end;
707
708 if SpeechHogNumber > 0 then
709 DrawHHOrder();
710 end;
711
712 // Draw gear timers and other GUI overlays
713 procedure DrawGearsGui;
714 var Gear: PGear;
715 x, y: LongInt;
716 begin
717 Gear:= GearsList;
718 while Gear <> nil do
719 begin
720 x:= hwRound(Gear^.X) + WorldDx;
721 y:= hwRound(Gear^.Y) + WorldDy;
722 if Gear^.Kind = gtAirMine then
723 RenderAirMineGuiExtras(Gear, x, y);
724 RenderGearHealth(Gear, x, y);
725 RenderGearTimer(Gear, x, y);
726 if Gear^.Kind = gtHedgehog then
727 RenderHHGuiExtras(Gear, x, y);
728 Gear:= Gear^.NextGear
729 end;
730 end;
731
732 procedure DrawFinger;
733 var Gear: PGear;
734 x, y: LongInt;
735 begin
736 if ((CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil)) then
737 begin
738 Gear:= CurrentHedgehog^.Gear;
739 x:= hwRound(Gear^.X) + WorldDx;
740 y:= hwRound(Gear^.Y) + WorldDy;
741 RenderFinger(Gear, x, y);
742 end;
743 end;
744
745 procedure FreeGearsList;
746 var t, tt: PGear;
747 begin
748 tt:= GearsList;
749 GearsList:= nil;
750 while tt <> nil do
751 begin
752 FreeAndNilTexture(tt^.Tex);
753 t:= tt;
754 tt:= tt^.NextGear;
755 Dispose(t)
756 end;
757 end;
758
759 procedure AddMiscGears;
760 var p,i,j,t,h,unplaced: Longword;
761 rx, ry: LongInt;
762 rdx, rdy: hwFloat;
763 Gear: PGear;
764 begin
765 AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000);
766
767 i:= 0;
768 unplaced:= 0;
769 while (i < cLandMines) and (unplaced < 4) do
770 begin
771 Gear:= AddGear(0, 0, gtMine, 0, _0, _0, 0);
772 FindPlace(Gear, false, 0, LAND_WIDTH);
773
774 if Gear = nil then
775 inc(unplaced)
776 else
777 unplaced:= 0;
778
779 inc(i)
780 end;
781
782 i:= 0;
783 unplaced:= 0;
784 while (i < cExplosives) and (unplaced < 4) do
785 begin
786 Gear:= AddGear(0, 0, gtExplosives, 0, _0, _0, 0);
787 FindPlace(Gear, false, 0, LAND_WIDTH);
788
789 if Gear = nil then
790 inc(unplaced)
791 else
792 begin
793 unplaced:= 0;
794 AddCI(Gear)
795 end;
796
797 inc(i)
798 end;
799
800 i:= 0;
801 j:= 0;
802 p:= 0; // 0: good position, 1: bad position.
803 unplaced:= 0;
804 if cAirMines > 0 then
805 Gear:= AddGear(0, 0, gtAirMine, 0, _0, _0, 0);
806 while (i < cAirMines) and (j < 1000*cAirMines) do
807 begin
808 p:= 0;
809 if (hasBorder) or (WorldEdge = weBounce) then
810 rx:= leftX+GetRandom(rightX-leftX-16)+8
811 else
812 rx:= leftX+GetRandom(rightX-leftX+400)-200;
813 if hasBorder then
814 ry:= topY+GetRandom(LAND_HEIGHT-topY-16)+8
815 else
816 ry:= topY+GetRandom(LAND_HEIGHT-topY+400)-200;
817 Gear^.X:= int2hwFloat(CalcWorldWrap(rx,Gear^.Radius));
818 Gear^.Y:= int2hwFloat(ry);
819 if CheckLandValue(rx, ry, $FFFF) and
820 (TestCollisionYwithGear(Gear,-1) = 0) and
821 (TestCollisionXwithGear(Gear, 1) = 0) and
822 (TestCollisionXwithGear(Gear,-1) = 0) and
823 (TestCollisionYwithGear(Gear, 1) = 0) then
824 begin
825 t:= 0;
826 while (t < TeamsCount) and (p = 0) do
827 begin
828 h:= 0;
829 with TeamsArray[t]^ do
830 while (h <= cMaxHHIndex) and (p = 0) do
831 begin
832 if (Hedgehogs[h].Gear <> nil) then
833 begin
834 rdx:=Gear^.X-Hedgehogs[h].Gear^.X;
835 rdy:=Gear^.Y-Hedgehogs[h].Gear^.Y;
836 if (Gear^.Angle < $FFFFFFFF) and
837 ((rdx.Round+rdy.Round < Gear^.Angle) and
838 (hwRound(hwSqr(rdx) + hwSqr(rdy)) < sqr(Gear^.Angle))) then
839 begin
840 p:= 1
841 end
842 end;
843 inc(h)
844 end;
845 inc(t)
846 end;
847 if p = 0 then
848 begin
849 inc(i);
850 AddFileLog('Placed Air Mine @ (' + inttostr(rx) + ',' + inttostr(ry) + ')');
851 if i < cAirMines then
852 Gear:= AddGear(0, 0, gtAirMine, 0, _0, _0, 0)
853 end
854 end
855 else
856 p:= 1;
857 inc(j)
858 end;
859 if p <> 0 then DeleteGear(Gear);
860
861 if (GameFlags and gfLowGravity) <> 0 then
862 begin
863 cGravity:= cMaxWindSpeed;
864 cGravityf:= 0.00025;
865 cLowGravity:= true
866 end;
867
868 if (GameFlags and gfVampiric) <> 0 then
869 cVampiric:= true;
870
871 Gear:= GearsList;
872 if (GameFlags and gfInvulnerable) <> 0 then
873 for p:= 0 to Pred(ClansCount) do
874 with ClansArray[p]^ do
875 for j:= 0 to Pred(TeamsNumber) do
876 with Teams[j]^ do
877 for i:= 0 to cMaxHHIndex do
878 with Hedgehogs[i] do
879 Effects[heInvulnerable]:= 1;
880
881 if (GameFlags and gfLaserSight) <> 0 then
882 cLaserSighting:= true;
883
884 for i:= (LAND_WIDTH*LAND_HEIGHT) div 524288+2 downto 0 do
885 begin
886 rx:= GetRandom(rightX-leftX)+leftX;
887 ry:= GetRandom(LAND_HEIGHT-topY)+topY;
888 rdx:= _90-(GetRandomf*_360);
889 rdy:= _90-(GetRandomf*_360);
890 Gear:= AddGear(rx, ry, gtGenericFaller, gstInvisible, rdx, rdy, $FFFFFFFF);
891 // This allows this generic faller to be displaced randomly by events
892 Gear^.Tag:= 1;
893 end;
894
895 snowRight:= max(LAND_WIDTH,4096)+512;
896 snowLeft:= -(snowRight-LAND_WIDTH);
897
898 if (not hasBorder) and cSnow then
899 for i:= vobCount * Longword(max(LAND_WIDTH,4096)) div 2048 downto 1 do
900 begin
901 rx:=GetRandom(snowRight - snowLeft);
902 ry:=GetRandom(750);
903 AddGear(rx + snowLeft, LongInt(LAND_HEIGHT) + ry - 1300, gtFlake, 0, _0, _0, 0)
904 end
905 end;
906
907 // sort clans horizontally (bubble-sort, because why not)
908 procedure SortHHsByClan();
909 var n, newn, i, j, k, p: LongInt;
910 ar, clar: array[0..Pred(cMaxHHs)] of PHedgehog;
911 Count, clCount: Longword;
912 tmpX, tmpY: hwFloat;
913 hh1, hh2: PHedgehog;
914 begin
915 Count:= 0;
916 // add hedgehogs to the array in clan order
917 for p:= 0 to (ClansCount - 1) do
918 with SpawnClansArray[p]^ do
919 begin
920 // count hogs in this clan
921 clCount:= 0;
922 for j:= 0 to Pred(TeamsNumber) do
923 with Teams[j]^ do
924 for i:= 0 to cMaxHHIndex do
925 if Hedgehogs[i].Gear <> nil then
926 begin
927 clar[clCount]:= @Hedgehogs[i];
928 inc(clCount);
929 end;
930
931 // shuffle all hogs of this clan
932 for i:= 0 to clCount - 1 do
933 begin
934 j:= GetRandom(clCount);
935 k:= GetRandom(clCount);
936 if clar[j] <> clar[k] then
937 begin
938 hh1:= clar[j];
939 clar[j]:= clar[k];
940 clar[k]:= hh1;
941 end;
942 end;
943
944 // add clan's hog to sorting array
945 for i:= 0 to clCount - 1 do
946 begin
947 ar[Count]:= clar[i];
948 inc(Count);
949 end;
950 end;
951
952
953 // bubble-sort hog array
954 n:= Count - 1;
955
956 repeat
957 newn:= 0;
958 for i:= 1 to n do
959 begin
960 hh1:= ar[i-1];
961 hh2:= ar[i];
962 if hwRound(hh1^.Gear^.X) > hwRound(hh2^.Gear^.X) then
963 begin
964 tmpX:= hh1^.Gear^.X;
965 tmpY:= hh1^.Gear^.Y;
966 hh1^.Gear^.X:= hh2^.Gear^.X;
967 hh1^.Gear^.Y:= hh2^.Gear^.Y;
968 hh2^.Gear^.X:= tmpX;
969 hh2^.Gear^.Y:= tmpY;
970 newn:= i;
971 end;
972 end;
973 n:= newn;
974 until n = 0;
975
976 end;
977
978 procedure AssignHHCoords;
979 var i, t, p, j, x, y: LongInt;
980 ar: array[0..Pred(cMaxHHs)] of PHedgehog;
981 Count: Longword;
982 divide, sectionDivide: boolean;
983 begin
984 if (GameFlags and gfPlaceHog) <> 0 then
985 PlacingHogs:= true
986 else if (GameFlags and gfKing) <> 0 then
987 PlacingKings:= true;
988
989 divide:= ((GameFlags and gfDivideTeams) <> 0);
990
991 (* sectionDivide will determine the mode of hog distribution
992 *
993 * On generated maps or maps not designed with divided mode in mind,
994 * using spawning sections can be problematic, because some sections may
995 * contain too little land surface for sensible spawning.
996 *
997 * if sectionDivide is true, the map will be sliced into equal-width sections
998 * and one team spawned in each
999 * if false, the hogs will be spawned normally and sorted by teams after
1000 *
1001 *)
1002
1003 // TODO: there might be a smarter way to decide if dividing clans into equal-width map sections makes sense
1004 // e.g. by checking if there is enough spawn area in each section
1005 sectionDivide:= divide and ((cMapGen = mgForts) or (ClansCount = 2));
1006
1007 // divide the map into equal-width sections and put each clan in one of them
1008 if sectionDivide then
1009 begin
1010 t:= leftX;
1011 for p:= 0 to (ClansCount - 1) do
1012 begin
1013 with SpawnClansArray[p]^ do
1014 for j:= 0 to Pred(TeamsNumber) do
1015 with Teams[j]^ do
1016 for i:= 0 to cMaxHHIndex do
1017 with Hedgehogs[i] do
1018 if (Gear <> nil) and (Gear^.X.QWordValue = 0) then
1019 begin
1020 if PlacingHogs then
1021 Unplaced:= true
1022 else
1023 FindPlace(Gear, false, t, t + playWidth div ClansCount, true);// could make Gear == nil;
1024 if PlacingKings and King then
1025 UnplacedKing:= true;
1026 if Gear <> nil then
1027 begin
1028 Gear^.Pos:= GetRandom(49);
1029 // unless the world is wrapping, make outter teams face to map center
1030 if (WorldEdge <> weWrap) and ((p = 0) or (p = ClansCount - 1)) then
1031 Gear^.dX.isNegative:= (p <> 0)
1032 else
1033 Gear^.dX.isNegative:= (GetRandom(2) = 1);
1034 end
1035 end;
1036 inc(t, playWidth div ClansCount);
1037 end
1038 end
1039 else // mix hedgehogs
1040 begin
1041 Count:= 0;
1042 for p:= 0 to Pred(TeamsCount) do
1043 with TeamsArray[p]^ do
1044 begin
1045 for i:= 0 to cMaxHHIndex do
1046 with Hedgehogs[i] do
1047 if (Gear <> nil) and (Gear^.X.QWordValue = 0) then
1048 begin
1049 ar[Count]:= @Hedgehogs[i];
1050 inc(Count)
1051 end;
1052 end;
1053 while (Count > 0) do
1054 begin
1055 i:= GetRandom(Count);
1056 if PlacingHogs then
1057 ar[i]^.Unplaced:= true
1058 else
1059 FindPlace(ar[i]^.Gear, false, leftX, rightX, true);
1060 if PlacingKings and ar[i]^.King then
1061 ar[i]^.UnplacedKing:= true;
1062 if ar[i]^.Gear <> nil then
1063 begin
1064 ar[i]^.Gear^.dX.isNegative:= hwRound(ar[i]^.Gear^.X) > leftX + playWidth div 2;
1065 end;
1066 ar[i]:= ar[Count - 1];
1067 dec(Count)
1068 end
1069 end;
1070 for p:= 0 to Pred(TeamsCount) do
1071 with TeamsArray[p]^ do
1072 for i:= 0 to cMaxHHIndex do
1073 with Hedgehogs[i] do
1074 if (Gear <> nil) and (Gear^.State and gsttmpFlag <> 0) then
1075 begin
1076 DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50);
1077 AddFileLog('Carved a hole for hog at coordinates (' + inttostr(hwRound(Gear^.X)) + ',' + inttostr(hwRound(Gear^.Y)) + ')')
1078 end;
1079 // place flowers after in case holes overlap (we shrink search distance if we are failing to place)
1080 for p:= 0 to Pred(TeamsCount) do
1081 with TeamsArray[p]^ do
1082 for i:= 0 to cMaxHHIndex do
1083 with Hedgehogs[i] do
1084 if (Gear <> nil) and (Gear^.State and gsttmpFlag <> 0) then
1085 begin
1086 // Get flower position
1087 x:= hwRound(Gear^.X) - SpritesData[sprTargetBee].Width div 2;
1088 y:= hwRound(Gear^.Y) - SpritesData[sprTargetBee].Height div 2;
1089 // Calculate offset from map boundaries and border
1090 if hasBorder then
1091 x:= max(min(x, RightX - SpritesData[sprTargetBee].Width - cBorderWidth), LeftX + cBorderWidth)
1092 else
1093 x:= max(min(x, RightX - SpritesData[sprTargetBee].Width), LeftX);
1094 y:= max(y, TopY);
1095
1096 // Place flower
1097 ForcePlaceOnLand(x, y, sprTargetBee, 0, lfBasic, $FFFFFFFF, false, false, false);
1098
1099 // Place hog
1100 Gear^.Y:= int2hwFloat(hwRound(Gear^.Y) - (SpritesData[sprTargetBee].Height div 2) - Gear^.Radius);
1101 AddCI(Gear);
1102 Gear^.State:= Gear^.State and (not gsttmpFlag);
1103
1104 AddFileLog('Placed flower for hog at coordinates (' + inttostr(x) + ',' + inttostr(y) + ')')
1105 end;
1106
1107
1108 // divided teams: sort the hedgehogs from left to right by clan and shuffle clan members
1109 if divide and (not sectionDivide) then
1110 SortHHsByClan();
1111 end;
1112
1113 // Set random pos for all hogs so their animations have different starting points
1114 procedure RandomizeHHAnim;
1115 var i, j, p: LongInt;
1116 begin
1117 for p:= 0 to (ClansCount - 1) do
1118 with SpawnClansArray[p]^ do
1119 for j:= 0 to Pred(TeamsNumber) do
1120 with Teams[j]^ do
1121 for i:= 0 to cMaxHHIndex do
1122 if (Hedgehogs[i].Gear <> nil) then
1123 Hedgehogs[i].Gear^.Pos:= GetRandom(19);
1124 end;
1125
1126 {procedure AmmoFlameWork(Ammo: PGear);
1127 var t: PGear;
1128 begin
1129 t:= GearsList;
1130 while t <> nil do
1131 begin
1132 if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then
1133 if not (hwSqr(Ammo^.X - t^.X) + hwSqr(Ammo^.Y - t^.Y - int2hwFloat(cHHRadius)) * 2 > _2) then
1134 begin
1135 ApplyDamage(t, 5);
1136 t^.dX:= t^.dX + (t^.X - Ammo^.X) * _0_02;
1137 t^.dY:= - _0_25;
1138 t^.Active:= true;
1139 DeleteCI(t);
1140 FollowGear:= t
1141 end;
1142 t:= t^.NextGear
1143 end;
1144 end;}
1145
1146
1147 function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content, cnt: Longword): PGear;
1148 var gear: PGear;
1149 begin
1150 gear := AddGear(x, y, gtCase, 0, _0, _0, 0);
1151 if(FinishedTurnsTotal > -1) then
1152 FollowGear:= gear;
1153 cCaseFactor := 0;
1154
1155 if (crate <> HealthCrate) and (content > ord(High(TAmmoType))) then
1156 content := ord(High(TAmmoType));
1157
1158 gear^.Power:= cnt;
1159
1160 case crate of
1161 HealthCrate:
1162 begin
1163 gear^.Pos := posCaseHealth;
1164 gear^.RenderHealth:= true;
1165 // health crate is smaller than the other crates
1166 gear^.Radius := cCaseHealthRadius;
1167 gear^.Health := content;
1168 if(FinishedTurnsTotal > -1) then
1169 AddCaption(GetEventString(eidNewHealthPack), capcolDefault, capgrpAmmoInfo);
1170 end;
1171 AmmoCrate:
1172 begin
1173 gear^.Pos := posCaseAmmo;
1174 gear^.AmmoType := TAmmoType(content);
1175 if(FinishedTurnsTotal > -1) then
1176 AddCaption(GetEventString(eidNewAmmoPack), capcolDefault, capgrpAmmoInfo);
1177 end;
1178 UtilityCrate:
1179 begin
1180 gear^.Pos := posCaseUtility;
1181 gear^.AmmoType := TAmmoType(content);
1182 if(FinishedTurnsTotal > -1) then
1183 AddCaption(GetEventString(eidNewUtilityPack), capColDefault, capgrpAmmoInfo);
1184 end;
1185 end;
1186
1187 if ( (x = 0) and (y = 0) ) then
1188 FindPlace(gear, true, 0, LAND_WIDTH);
1189
1190 SpawnCustomCrateAt := gear;
1191 end;
1192
1193 function SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean): PGear;
1194 var gear: PGear;
1195 begin
1196 gear := AddGear(x, y, gtCase, 0, _0, _0, 0);
1197 if(FinishedTurnsTotal > -1) then
1198 FollowGear:= gear;
1199 cCaseFactor := 0;
1200 gear^.Pos := posCaseDummy;
1201
1202 if explode then
1203 gear^.Pos := gear^.Pos + posCaseExplode;
1204 if poison then
1205 gear^.Pos := gear^.Pos + posCasePoison;
1206
1207 case crate of
1208 HealthCrate:
1209 begin
1210 gear^.Pos := gear^.Pos + posCaseHealth;
1211 gear^.RenderHealth:= true;
1212 gear^.Karma:= 2;
1213 // health crate is smaller than the other crates
1214 gear^.Radius := cCaseHealthRadius;
1215 if(FinishedTurnsTotal > -1) then
1216 AddCaption(GetEventString(eidNewHealthPack), capcolDefault, capgrpAmmoInfo);
1217 end;
1218 AmmoCrate:
1219 begin
1220 gear^.Pos := gear^.Pos + posCaseAmmo;
1221 if(FinishedTurnstotal > -1) then
1222 AddCaption(GetEventString(eidNewAmmoPack), capcolDefault, capgrpAmmoInfo);
1223 end;
1224 UtilityCrate:
1225 begin
1226 gear^.Pos := gear^.Pos + posCaseUtility;
1227 if(FinishedTurnsTotal > -1) then
1228 AddCaption(GetEventString(eidNewUtilityPack), capcolDefault, capgrpAmmoInfo);
1229 end;
1230 end;
1231
1232 if ( (x = 0) and (y = 0) ) then
1233 FindPlace(gear, true, 0, LAND_WIDTH);
1234
1235 SpawnFakeCrateAt := gear;
1236 end;
1237
1238 procedure StartSuddenDeath();
1239 begin
1240 if SuddenDeath then
1241 exit;
1242
1243 SuddenDeath:= true;
1244 SuddenDeathActive:= true;
1245
1246 // Special effects (only w/ health decrease)
1247 if cHealthDecrease <> 0 then
1248 begin
1249 SuddenDeathDmg:= true;
1250 // White screen flash
1251 ScreenFade:= sfFromWhite;
1252 ScreenFadeValue:= sfMax;
1253 ScreenFadeSpeed:= 1;
1254
1255 // Clouds, flakes, sky tint
1256 ChangeToSDClouds;
1257 ChangeToSDFlakes;
1258 SetSkyColor(SDSkyColor.r * (SDTint.r/255) / 255, SDSkyColor.g * (SDTint.g/255) / 255, SDSkyColor.b * (SDTint.b/255) / 255);
1259 end;
1260
1261 // Disable tardis
1262 Ammoz[amTardis].SkipTurns:= 9999;
1263 Ammoz[amTardis].Probability:= 0;
1264
1265 AddCaption(trmsg[sidSuddenDeath], capcolDefault, capgrpGameState);
1266 ScriptCall('onSuddenDeath');
1267 playSound(sndSuddenDeath);
1268 StopMusic;
1269 if SDMusicFN <> '' then
1270 PlayMusic
1271 end;
1272
1273 function GearByUID(uid : Longword) : PGear;
1274 var gear: PGear;
1275 begin
1276 GearByUID:= nil;
1277 if uid = 0 then exit;
1278 if (lastGearByUID <> nil) and (lastGearByUID^.uid = uid) then
1279 begin
1280 GearByUID:= lastGearByUID;
1281 exit
1282 end;
1283 gear:= GearsList;
1284 while gear <> nil do
1285 begin
1286 if gear^.uid = uid then
1287 begin
1288 lastGearByUID:= gear;
1289 GearByUID:= gear;
1290 exit
1291 end;
1292 gear:= gear^.NextGear
1293 end
1294 end;
1295
1296 function IsClockRunning() : boolean;
1297 begin
1298 IsClockRunning :=
1299 (CurrentHedgehog^.Gear <> nil)
1300 and (((CurrentHedgehog^.Gear^.State and gstAttacking) = 0)
1301 or (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_DoesntStopTimerWhileAttacking <> 0)
1302 or ((GameFlags and gfInfAttack) <> 0) and (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_DoesntStopTimerWhileAttackingInInfAttackMode <> 0)
1303 or (CurrentHedgehog^.CurAmmoType = amSniperRifle))
1304 and (not(isInMultiShoot and ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_DoesntStopTimerInMultiShoot) <> 0)))
1305 and (not LuaClockPaused);
1306 end;
1307
1308
1309 procedure chSkip(var s: shortstring);
1310 begin
1311 s:= s; // avoid compiler hint
1312 if not isExternalSource then
1313 SendIPC(_S',');
1314 uStats.Skipped;
1315 skipFlag:= true;
1316 ScriptCall('onSkipTurn');
1317 end;
1318
1319 procedure chHogSay(var s: shortstring);
1320 var Gear: PVisualGear;
1321 text: shortstring;
1322 hh: PHedgehog;
1323 i, x, t, h: byte;
1324 c, j: LongInt;
1325 begin
1326 hh:= nil;
1327 i:= 0;
1328 t:= 0;
1329 x:= byte(s[1]); // speech type
1330 if x < 4 then
1331 begin
1332 t:= byte(s[2]); // team
1333 if Length(s) > 2 then
1334 h:= byte(s[3]) // target hog
1335 else
1336 h:= 0
1337 end;
1338 // allow targetting a hog by specifying a number as the first portion of the text
1339 if (x < 4) and (h > byte('0')) and (h < byte('9')) then
1340 i:= h - 48;
1341 if i <> 0 then
1342 text:= copy(s, 4, Length(s) - 1)
1343 else if x < 4 then
1344 text:= copy(s, 3, Length(s) - 1)
1345 else text:= copy(s, 2, Length(s) - 1);
1346
1347 if text = '' then text:= '...';
1348
1349 if (x < 4) and (TeamsArray[t] <> nil) then
1350 begin
1351 // if team matches current hedgehog team, default to current hedgehog
1352 if (i = 0) and (CurrentHedgehog <> nil) and (CurrentHedgehog^.Team = TeamsArray[t]) and (not CurrentHedgehog^.Unplaced) then
1353 hh:= CurrentHedgehog
1354 else
1355 begin
1356 // otherwise use the first living hog or the hog amongs the remaining ones indicated by i
1357 j:= 0;
1358 c:= 0;
1359 while (j <= cMaxHHIndex) and (hh = nil) do
1360 begin
1361 if (TeamsArray[t]^.Hedgehogs[j].Gear <> nil) and (not TeamsArray[t]^.Hedgehogs[j].Unplaced) then
1362 begin
1363 inc(c);
1364 if (i=0) or (i=c) then
1365 hh:= @TeamsArray[t]^.Hedgehogs[j]
1366 end;
1367 inc(j)
1368 end
1369 end;
1370 if hh <> nil then
1371 begin
1372 Gear:= AddVisualGear(0, 0, vgtSpeechBubble);
1373 if Gear <> nil then
1374 begin
1375 Gear^.Hedgehog:= hh;
1376 Gear^.Text:= text;
1377 Gear^.FrameTicks:= x
1378 end;
1379 AddChatString(#9+Format(shortstring(trmsg[sidChatHog]), HH^.Name, text));
1380 end
1381 end
1382 else if (x >= 4) then
1383 begin
1384 SpeechType:= x-3;
1385 SpeechText:= text
1386 end;
1387 end;
1388
1389 procedure initModule;
1390 const handlers: array[TGearType] of TGearStepProcedure = (
1391 @doStepFlame,
1392 @doStepHedgehog,
1393 @doStepMine,
1394 @doStepCase,
1395 @doStepAirMine,
1396 @doStepCase,
1397 @doStepBomb,
1398 @doStepShell,
1399 @doStepGrave,
1400 @doStepBee,
1401 @doStepShotgunShot,
1402 @doStepPickHammer,
1403 @doStepRope,
1404 @doStepDEagleShot,
1405 @doStepDynamite,
1406 @doStepBomb,
1407 @doStepCluster,
1408 @doStepShover,
1409 @doStepFirePunch,
1410 @doStepActionTimer,
1411 @doStepActionTimer,
1412 @doStepParachute,
1413 @doStepAirAttack,
1414 @doStepAirBomb,
1415 @doStepBlowTorch,
1416 @doStepGirder,
1417 @doStepTeleport,
1418 @doStepSwitcher,
1419 @doStepTarget,
1420 @doStepMortar,
1421 @doStepWhip,
1422 @doStepKamikaze,
1423 @doStepCake,
1424 @doStepSeduction,
1425 @doStepBomb,
1426 @doStepCluster,
1427 @doStepBomb,
1428 @doStepWaterUp,
1429 @doStepDrill,
1430 @doStepBallgun,
1431 @doStepBomb,
1432 @doStepRCPlane,
1433 @doStepSniperRifleShot,
1434 @doStepJetpack,
1435 @doStepMolotov,
1436 @doStepBirdy,
1437 @doStepEggWork,
1438 @doStepPortalShot,
1439 @doStepPiano,
1440 @doStepBomb,
1441 @doStepSineGunShot,
1442 @doStepFlamethrower,
1443 @doStepSMine,
1444 @doStepPoisonCloud,
1445 @doStepHammer,
1446 @doStepHammerHit,
1447 @doStepResurrector,
1448 @doStepNapalmBomb,
1449 @doStepSnowball,
1450 @doStepSnowflake,
1451 @doStepLandGun,
1452 @doStepTardis,
1453 @doStepIceGun,
1454 @doStepAddAmmo,
1455 @doStepGenericFaller,
1456 @doStepKnife,
1457 @doStepCreeper,
1458 @doStepMinigun,
1459 @doStepMinigunBullet);
1460 begin
1461 doStepHandlers:= handlers;
1462
1463 RegisterVariable('skip', @chSkip, false);
1464 RegisterVariable('hogsay', @chHogSay, true );
1465
1466 CurAmmoGear:= nil;
1467 GearsList:= nil;
1468 curHandledGear:= nil;
1469
1470 KilledHHs:= 0;
1471 SuddenDeath:= false;
1472 SuddenDeathDmg:= false;
1473 SpeechType:= 1;
1474 skipFlag:= false;
1475
1476 AllInactive:= false;
1477 PrvInactive:= false;
1478
1479 //typed const
1480 delay:= 0;
1481 delay2:= 0;
1482 step:= stDelay1;
1483 upd:= 0;
1484
1485 NewTurnTick:= $FFFFFFFF;
1486 end;
1487
1488 procedure freeModule;
1489 begin
1490 FreeGearsList();
1491 end;
1492
1493 end.
1494