author  unc0rr 
Tue, 27 May 2008 14:30:48 +0000  
changeset 955  474afaab0365 
parent 954  0cc31e998f4e 
child 956  19003f7fc174 
permissions  rwrr 
4  1 
(* 
2 
* Hedgewars, a wormslike game 

883  3 
* Copyright (c) 20042008 Andrey Korotaev <unC0Rr@gmail.com> 
4  4 
* 
183  5 
* This program is free software; you can redistribute it and/or modify 
6 
* it under the terms of the GNU General Public License as published by 

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

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

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

12 
* GNU General Public License for more details. 

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

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

4  17 
*) 
18 

19 
unit uGears; 

20 
interface 

351  21 
uses SDLh, uConsts, uFloat; 
4  22 
{$INCLUDE options.inc} 
23 
const AllInactive: boolean = false; 

868  24 
PrvInactive: boolean = false; 
4  25 

26 
type PGear = ^TGear; 

27 
TGearStepProcedure = procedure (Gear: PGear); 

28 
TGear = record 

29 
NextGear, PrevGear: PGear; 

30 
Active: Boolean; 

930  31 
Ammo : PAmmo; 
188  32 
State : Longword; 
351  33 
X : hwFloat; 
34 
Y : hwFloat; 

35 
dX: hwFloat; 

36 
dY: hwFloat; 

42  37 
Kind: TGearType; 
38 
Pos: Longword; 

4  39 
doStep: TGearStepProcedure; 
371  40 
Radius: LongInt; 
188  41 
Angle, Power : Longword; 
776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
775
diff
changeset

42 
DirAngle: real; 
4  43 
Timer : LongWord; 
351  44 
Elasticity: hwFloat; 
45 
Friction : hwFloat; 

783  46 
Message, MsgParam : Longword; 
4  47 
Hedgehog: pointer; 
371  48 
Health, Damage: LongInt; 
511  49 
CollisionIndex: LongInt; 
371  50 
Tag: LongInt; 
762  51 
Tex: PTexture; 
293  52 
Z: Longword; 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
503
diff
changeset

53 
IntersectGear: PGear; 
595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
593
diff
changeset

54 
TriggerId: Longword; 
4  55 
end; 
56 

371  57 
function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear; 
4  58 
procedure ProcessGears; 
59 
procedure SetAllToActive; 

60 
procedure SetAllHHToActive; 

61 
procedure DrawGears(Surface: PSDL_Surface); 

62 
procedure FreeGearsList; 

10  63 
procedure AddMiscGears; 
4  64 
procedure AssignHHCoords; 
294  65 
procedure InsertGearToList(Gear: PGear); 
66 
procedure RemoveGearFromList(Gear: PGear); 

4  67 

68 
var CurAmmoGear: PGear = nil; 

68  69 
GearsList: PGear = nil; 
307  70 
KilledHHs: Longword = 0; 
70  71 

4  72 
implementation 
81  73 
uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, 
814
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

74 
uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos, uTriggers, GL, 
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

75 
uStats; 
789  76 

77 
const MAXROPEPOINTS = 300; 

68  78 
var RopePoints: record 
4  79 
Count: Longword; 
776
8fc7e59d9cb4
Convert the rest of rotated sprites to be rotated by OpenGL
unc0rr
parents:
775
diff
changeset

80 
HookAngle: GLfloat; 
789  81 
ar: array[0..MAXROPEPOINTS] of record 
351  82 
X, Y: hwFloat; 
83 
dLen: hwFloat; 

4  84 
b: boolean; 
85 
end; 

86 
end; 

87 

88 
procedure DeleteGear(Gear: PGear); forward; 

371  89 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); forward; 
90 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward; 

79  91 
procedure AmmoFlameWork(Ammo: PGear); forward; 
371  92 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; forward; 
15  93 
procedure SpawnBoxOfSmth; forward; 
32
78bff13b11c0
With this patch the game doesn't crash when gaming by net
unc0rr
parents:
24
diff
changeset

94 
procedure AfterAttack; forward; 
371  95 
procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt); forward; 
302  96 
procedure HedgehogStep(Gear: PGear); forward; 
303
1659c4aad5ab
Now blow torch angle can be changed during blowing :)
unc0rr
parents:
302
diff
changeset

97 
procedure HedgehogChAngle(Gear: PGear); forward; 
506  98 
procedure ShotgunShot(Gear: PGear); forward; 
522  99 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); forward; 
4  100 

101 
{$INCLUDE GSHandlers.inc} 

102 
{$INCLUDE HHHandlers.inc} 

103 

104 
const doStepHandlers: array[TGearType] of TGearStepProcedure = ( 

351  105 
@doStepBomb, 
106 
@doStepHedgehog, 

107 
@doStepGrenade, 

108 
@doStepHealthTag, 

109 
@doStepGrave, 

110 
@doStepUFO, 

111 
@doStepShotgunShot, 

112 
@doStepPickHammer, 

113 
@doStepRope, 

114 
@doStepSmokeTrace, 

115 
@doStepExplosion, 

116 
@doStepMine, 

117 
@doStepCase, 

118 
@doStepDEagleShot, 

119 
@doStepDynamite, 

120 
@doStepTeamHealthSorter, 

121 
@doStepBomb, 

122 
@doStepCluster, 

123 
@doStepShover, 

124 
@doStepFlame, 

125 
@doStepFirePunch, 

126 
@doStepActionTimer, 

127 
@doStepActionTimer, 

128 
@doStepActionTimer, 

129 
@doStepParachute, 

130 
@doStepAirAttack, 

131 
@doStepAirBomb, 

409  132 
@doStepBlowTorch, 
520  133 
@doStepGirder, 
522  134 
@doStepTeleport, 
534  135 
@doStepHealthTag, 
590  136 
@doStepSwitcher, 
924  137 
@doStepCase, 
925  138 
@doStepMortar, 
139 
@doStepWhip 

4  140 
); 
141 

294  142 
procedure InsertGearToList(Gear: PGear); 
803  143 
var tmp, ptmp: PGear; 
294  144 
begin 
145 
if GearsList = nil then 

146 
GearsList:= Gear 

147 
else begin 

148 
tmp:= GearsList; 

803  149 
ptmp:= GearsList; 
150 
while (tmp <> nil) and (tmp^.Z <= Gear^.Z) do 

151 
begin 

152 
ptmp:= tmp; 

153 
tmp:= tmp^.NextGear 

154 
end; 

294  155 

803  156 
if ptmp <> nil then 
157 
begin 

158 
Gear^.NextGear:= ptmp^.NextGear; 

159 
Gear^.PrevGear:= ptmp; 

160 
if ptmp^.NextGear <> nil then ptmp^.NextGear^.PrevGear:= Gear; 

161 
ptmp^.NextGear:= Gear 

162 
end 

163 
else GearsList:= Gear 

294  164 
end 
165 
end; 

166 

167 
procedure RemoveGearFromList(Gear: PGear); 

168 
begin 

351  169 
if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear^.PrevGear; 
170 
if Gear^.PrevGear <> nil then Gear^.PrevGear^.NextGear:= Gear^.NextGear 

809  171 
else GearsList:= Gear^.NextGear 
294  172 
end; 
173 

371  174 
function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear; 
79  175 
const Counter: Longword = 0; 
351  176 
var Result: PGear; 
4  177 
begin 
79  178 
inc(Counter); 
108  179 
{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+'), d('+floattostr(dX)+','+floattostr(dY)+')');{$ENDIF} 
4  180 
New(Result); 
357  181 
{$IFDEF DEBUGFILE}AddFileLog('AddGear: type = ' + inttostr(ord(Kind)));{$ENDIF} 
4  182 
FillChar(Result^, sizeof(TGear), 0); 
498  183 
Result^.X:= int2hwFloat(X); 
184 
Result^.Y:= int2hwFloat(Y); 

351  185 
Result^.Kind := Kind; 
186 
Result^.State:= State; 

187 
Result^.Active:= true; 

188 
Result^.dX:= dX; 

189 
Result^.dY:= dY; 

190 
Result^.doStep:= doStepHandlers[Kind]; 

511  191 
Result^.CollisionIndex:= 1; 
351  192 
Result^.Timer:= Timer; 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
503
diff
changeset

193 

4  194 
if CurrentTeam <> nil then 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
503
diff
changeset

195 
begin 
602  196 
Result^.Hedgehog:= CurrentHedgehog; 
197 
Result^.IntersectGear:= CurrentHedgehog^.Gear 

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

198 
end; 
802
ed5450a89b96
Start implementing 'visual gears'  gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
789
diff
changeset

199 

4  200 
case Kind of 
915  201 
gtAmmo_Bomb, 
202 
gtClusterBomb: begin 

351  203 
Result^.Radius:= 4; 
204 
Result^.Elasticity:= _0_6; 

205 
Result^.Friction:= _0_995; 

4  206 
end; 
207 
gtHedgehog: begin 

351  208 
Result^.Radius:= cHHRadius; 
209 
Result^.Elasticity:= _0_35; 

210 
Result^.Friction:= _0_999; 

211 
Result^.Angle:= cMaxAngle div 2; 

954  212 
Result^.Pos:= GetRandom(19); 
351  213 
Result^.Z:= cHHZ; 
4  214 
end; 
215 
gtAmmo_Grenade: begin 

351  216 
Result^.Radius:= 4; 
4  217 
end; 
218 
gtHealthTag: begin 

351  219 
Result^.Timer:= 1500; 
522  220 
Result^.Z:= 2001; 
4  221 
end; 
222 
gtGrave: begin 

351  223 
Result^.Radius:= 10; 
224 
Result^.Elasticity:= _0_6; 

4  225 
end; 
226 
gtUFO: begin 

351  227 
Result^.Radius:= 5; 
228 
Result^.Timer:= 500; 

229 
Result^.Elasticity:= _0_9 

4  230 
end; 
231 
gtShotgunShot: begin 

351  232 
Result^.Timer:= 900; 
233 
Result^.Radius:= 2 

4  234 
end; 
235 
gtPickHammer: begin 

351  236 
Result^.Radius:= 10; 
237 
Result^.Timer:= 4000 

4  238 
end; 
239 
gtSmokeTrace: begin 

498  240 
Result^.X:= Result^.X  _16; 
241 
Result^.Y:= Result^.Y  _16; 

351  242 
Result^.State:= 8 
4  243 
end; 
244 
gtRope: begin 

351  245 
Result^.Radius:= 3; 
498  246 
Result^.Friction:= _450; 
4  247 
RopePoints.Count:= 0; 
248 
end; 

9  249 
gtExplosion: begin 
498  250 
Result^.X:= Result^.X  _25; 
251 
Result^.Y:= Result^.Y  _25; 

9  252 
end; 
10  253 
gtMine: begin 
503  254 
Result^.State:= Result^.State or gstMoving; 
915  255 
Result^.Radius:= 2; 
351  256 
Result^.Elasticity:= _0_55; 
257 
Result^.Friction:= _0_995; 

258 
Result^.Timer:= 3000; 

10  259 
end; 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

260 
gtCase: begin 
351  261 
Result^.Radius:= 16; 
601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
595
diff
changeset

262 
Result^.Elasticity:= _0_3 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

263 
end; 
37  264 
gtDEagleShot: begin 
351  265 
Result^.Radius:= 1; 
266 
Result^.Health:= 50 

37  267 
end; 
39  268 
gtDynamite: begin 
351  269 
Result^.Radius:= 3; 
270 
Result^.Elasticity:= _0_55; 

271 
Result^.Friction:= _0_03; 

272 
Result^.Timer:= 5000; 

39  273 
end; 
910  274 
gtCluster: Result^.Radius:= 2; 
878  275 
gtShover: Result^.Radius:= 20; 
79  276 
gtFlame: begin 
351  277 
Result^.Angle:= Counter mod 64; 
278 
Result^.Radius:= 1; 

279 
Result^.Health:= 2; 

280 
Result^.dY:= (getrandom  _0_8) * _0_03; 

281 
Result^.dX:= (getrandom  _0_5) * _0_4 

79  282 
end; 
82  283 
gtFirePunch: begin 
351  284 
Result^.Radius:= 15; 
285 
Result^.Tag:= Y 

82  286 
end; 
302  287 
gtAirBomb: begin 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

288 
Result^.Radius:= 5; 
302  289 
end; 
290 
gtBlowTorch: begin 

511  291 
Result^.Radius:= cHHRadius + cBlowTorchC; 
351  292 
Result^.Timer:= 7500; 
302  293 
end; 
522  294 
gtSmallDamage: begin 
295 
Result^.Timer:= 1100; 

296 
Result^.Z:= 2000; 

297 
end; 

540  298 
gtSwitcher: begin 
299 
Result^.Z:= cCurrHHZ 

300 
end; 

593  301 
gtTarget: begin 
601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
595
diff
changeset

302 
Result^.Radius:= 16; 
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
595
diff
changeset

303 
Result^.Elasticity:= _0_3 
593  304 
end; 
924  305 
gtMortar: begin 
306 
Result^.Elasticity:= _0_2; 

307 
Result^.Friction:= _0_08 

308 
end; 

925  309 
gtWhip: Result^.Radius:= 20; 
4  310 
end; 
351  311 
InsertGearToList(Result); 
312 
AddGear:= Result 

4  313 
end; 
314 

315 
procedure DeleteGear(Gear: PGear); 

48  316 
var team: PTeam; 
307  317 
t: Longword; 
4  318 
begin 
503  319 
DeleteCI(Gear); 
762  320 

321 
if Gear^.Tex <> nil then 

522  322 
begin 
762  323 
FreeTexture(Gear^.Tex); 
324 
Gear^.Tex:= nil 

522  325 
end; 
762  326 

351  327 
if Gear^.Kind = gtHedgehog then 
4  328 
if CurAmmoGear <> nil then 
329 
begin 

351  330 
Gear^.Message:= gm_Destroy; 
331 
CurAmmoGear^.Message:= gm_Destroy; 

4  332 
exit 
47  333 
end else 
334 
begin 

498  335 
if not (hwRound(Gear^.Y) < cWaterLine) then 
307  336 
begin 
351  337 
t:= max(Gear^.Damage, Gear^.Health); 
867  338 
Gear^.Damage:= t; 
498  339 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
867  340 
uStats.HedgehogDamaged(Gear) 
307  341 
end; 
351  342 
team:= PHedgehog(Gear^.Hedgehog)^.Team; 
602  343 
if CurrentHedgehog^.Gear = Gear then 
145  344 
FreeActionsList; // to avoid ThinkThread on drawned gear 
351  345 
PHedgehog(Gear^.Hedgehog)^.Gear:= nil; 
307  346 
inc(KilledHHs); 
48  347 
RecountTeamHealth(team); 
47  348 
end; 
357  349 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear');{$ENDIF} 
595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
593
diff
changeset

350 
if Gear^.TriggerId <> 0 then TickTrigger(Gear^.TriggerId); 
82  351 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  352 
if FollowGear = Gear then FollowGear:= nil; 
294  353 
RemoveGearFromList(Gear); 
4  354 
Dispose(Gear) 
355 
end; 

356 

357 
function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs 

358 
var Gear: PGear; 

359 
begin 

351  360 
CheckNoDamage:= true; 
4  361 
Gear:= GearsList; 
362 
while Gear <> nil do 

867  363 
begin 
364 
if Gear^.Kind = gtHedgehog then 

365 
if Gear^.Damage <> 0 then 

366 
begin 

367 
CheckNoDamage:= false; 

368 
uStats.HedgehogDamaged(Gear); 

351  369 

867  370 
if Gear^.Health < Gear^.Damage then 
371 
Gear^.Health:= 0 

372 
else 

373 
dec(Gear^.Health, Gear^.Damage); 

374 

375 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y)  cHHRadius  12, 

376 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 

377 
RenderHealth(PHedgehog(Gear^.Hedgehog)^); 

378 
RecountTeamHealth(PHedgehog(Gear^.Hedgehog)^.Team); 

379 

380 
Gear^.Damage:= 0 

381 
end; 

382 
Gear:= Gear^.NextGear 

383 
end; 

4  384 
end; 
385 

522  386 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); 
387 
begin 

529  388 
if cAltDamage then 
389 
AddGear(X, Y, gtSmallDamage, Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 

522  390 
end; 
391 

4  392 
procedure ProcessGears; 
614  393 
const delay: LongWord = 0; 
869  394 
step: (stDelay, stChDmg, stTurnReact, 
395 
stAfterDelay, stChWin, stSpawn, stNTurn) = stDelay; 

4  396 
var Gear, t: PGear; 
397 
begin 

868  398 
PrvInactive:= AllInactive; 
4  399 
AllInactive:= true; 
400 
t:= GearsList; 

401 
while t<>nil do 

402 
begin 

403 
Gear:= t; 

351  404 
t:= Gear^.NextGear; 
405 
if Gear^.Active then Gear^.doStep(Gear); 

4  406 
end; 
89  407 

4  408 
if AllInactive then 
15  409 
case step of 
410 
stDelay: begin 

411 
if delay = 0 then 

412 
delay:= cInactDelay 

614  413 
else 
414 
dec(delay); 

415 

416 
if delay = 0 then 

417 
inc(step) 

15  418 
end; 
419 
stChDmg: if CheckNoDamage then inc(step) else step:= stDelay; 

814
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

420 
stTurnReact: begin 
855
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

421 
if not isInMultiShoot then 
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

422 
begin 
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

423 
uStats.TurnReaction; 
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

424 
inc(step) 
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

425 
end else 
8842c71d16bf
 Fix too long delay between shotgun and deagle shots
unc0rr
parents:
854
diff
changeset

426 
inc(step, 2); 
814
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

427 
end; 
815  428 
stAfterDelay: begin 
429 
if delay = 0 then 

430 
delay:= cInactDelay 

431 
else 

432 
dec(delay); 

433 

434 
if delay = 0 then 

435 
inc(step) 

436 
end; 

869  437 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
15  438 
stSpawn: begin 
439 
if not isInMultiShoot then SpawnBoxOfSmth; 

440 
inc(step) 

441 
end; 

442 
stNTurn: begin 

443 
if isInMultiShoot then isInMultiShoot:= false 

307  444 
else begin 
351  445 
ParseCommand('/nextturn', true); 
307  446 
end; 
15  447 
step:= Low(step) 
448 
end; 

449 
end; 

450 

4  451 
if TurnTimeLeft > 0 then 
870  452 
if CurrentHedgehog^.Gear <> nil then 
453 
if ((CurrentHedgehog^.Gear^.State and gstAttacking) = 0) 

454 
and not isInMultiShoot then 

455 
begin 

456 
if (TurnTimeLeft = 5000) 

457 
and (CurrentHedgehog^.Gear <> nil) 

458 
and ((CurrentHedgehog^.Gear^.State and gstAttacked) = 0) then PlaySound(sndHurry, false); 

459 
dec(TurnTimeLeft) 

460 
end; 

351  461 

651  462 
if (not CurrentTeam^.ExtDriven) and 
917  463 
((GameTicks and $FFFF) = $FFFF) then 
464 
begin 

465 
SendIPCTimeInc; 

466 
inc(hiTicks) // we do not recieve a message for this 

467 
end; 

656
6d6d9d7b1054
Fix network game bug caused by recent protocol changes
unc0rr
parents:
651
diff
changeset

468 

515  469 
inc(GameTicks) 
4  470 
end; 
471 

472 
procedure SetAllToActive; 

473 
var t: PGear; 

474 
begin 

475 
AllInactive:= false; 

476 
t:= GearsList; 

351  477 
while t <> nil do 
4  478 
begin 
351  479 
t^.Active:= true; 
480 
t:= t^.NextGear 

4  481 
end 
482 
end; 

483 

484 
procedure SetAllHHToActive; 

485 
var t: PGear; 

486 
begin 

487 
AllInactive:= false; 

488 
t:= GearsList; 

351  489 
while t <> nil do 
4  490 
begin 
351  491 
if t^.Kind = gtHedgehog then t^.Active:= true; 
492 
t:= t^.NextGear 

4  493 
end 
494 
end; 

495 

841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

496 
procedure DrawHH(Gear: PGear); 
371  497 
var t: LongInt; 
822  498 
amt: TAmmoType; 
862  499 
hx, hy, m: LongInt; 
500 
aAngle, dAngle: real; 

824  501 
defaultPos: boolean; 
292  502 
begin 
868  503 
if (Gear^.State and gstHHDeath) <> 0 then 
504 
begin 

505 
DrawSprite(sprHHDeath, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  26 + WorldDy, Gear^.Pos); 

506 
exit 

507 
end; 

824  508 
defaultPos:= true; 
847  509 

821
e6c0408b54ed
Use 'regular standing' and 'rope swing' hedgehog sprites
unc0rr
parents:
815
diff
changeset

510 
if (Gear^.State and gstHHDriven) <> 0 then 
822  511 
begin 
874  512 
hx:= hwRound(Gear^.X) + 1 + 8 * hwSign(Gear^.dX) + WorldDx; 
513 
hy:= hwRound(Gear^.Y)  2 + WorldDy; 

514 
aangle:= Gear^.Angle * 180 / cMaxAngle  90; 

515 

822  516 
if CurAmmoGear <> nil then 
517 
begin 

847  518 
case CurAmmoGear^.Kind of 
876  519 
gtShotgunShot: if (CurAmmoGear^.State and gstAnimation <> 0) then 
520 
DrawRotated(sprShotgun, hx, hy, hwSign(Gear^.dX), aangle) 

521 
else 

522 
DrawRotated(sprHandShotgun, hx, hy, hwSign(Gear^.dX), aangle); 

523 
gtDEagleShot: DrawRotated(sprDEagle, hx, hy, hwSign(Gear^.dX), aangle); 

861  524 
gtRope: begin 
862  525 
if Gear^.X < CurAmmoGear^.X then 
526 
begin 

527 
dAngle:= 0; 

528 
m:= 1 

529 
end else 

530 
begin 

531 
dAngle:= 180; 

532 
m:= 1 

533 
end; 

847  534 
DrawHedgehog(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
862  535 
m, 
847  536 
1, 
537 
0, 

862  538 
DxDy2Angle(CurAmmoGear^.dY, CurAmmoGear^.dX) + dAngle); 
847  539 
defaultPos:= false 
540 
end; 

541 
gtBlowTorch: begin 

542 
DrawRotated(sprBlowTorch, hx, hy, hwSign(Gear^.dX), aangle); 

543 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

544 
hwSign(Gear^.dX), 

545 
1, 

546 
3, 

547 
0); 

943  548 
defaultPos:= false 
847  549 
end; 
854  550 
gtShover: DrawRotated(sprHandBaseball, hx, hy, hwSign(Gear^.dX), aangle + 180); 
943  551 
gtFirePunch: begin 
552 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

553 
hwSign(Gear^.dX), 

554 
1, 

555 
4, 

556 
0); 

557 
defaultPos:= false 

558 
end; 

853  559 
gtPickHammer, 
560 
gtTeleport: defaultPos:= false; 

876  561 
end; 
562 

563 
case CurAmmoGear^.Kind of 

564 
gtShotgunShot, 

565 
gtDEagleShot, 

566 
gtShover: begin 

567 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

568 
hwSign(Gear^.dX), 

569 
0, 

570 
4, 

571 
0); 

572 
defaultPos:= false 

573 
end 

847  574 
end 
822  575 
end else 
874  576 

824  577 
if ((Gear^.State and gstHHJumping) <> 0) then 
578 
begin 

874  579 
if ((Gear^.State and gstHHHJump) <> 0) then 
580 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

581 
 hwSign(Gear^.dX), 

582 
1, 

583 
1, 

584 
0) 

585 
else 

586 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

587 
hwSign(Gear^.dX), 

588 
1, 

589 
1, 

590 
0); 

824  591 
defaultPos:= false 
592 
end else 

874  593 

954  594 
if (Gear^.Message and (gm_Left or gm_Right) <> 0) then 
824  595 
begin 
822  596 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
597 
hwSign(Gear^.dX), 

598 
0, 

599 
PHedgehog(Gear^.Hedgehog)^.visStepPos div 2, 

824  600 
0); 
601 
defaultPos:= false 

602 
end 

822  603 
else 
874  604 

954  605 
if ((Gear^.State and gstAttacked) = 0) then 
822  606 
begin 
607 
amt:= CurrentHedgehog^.Ammo^[CurrentHedgehog^.CurSlot, CurrentHedgehog^.CurAmmo].AmmoType; 

608 
case amt of 

823
90d651e75547
Use ammoinhand sprites for desert eagle, shotgun and bazooka
unc0rr
parents:
822
diff
changeset

609 
amBazooka: DrawRotated(sprHandBazooka, hx, hy, hwSign(Gear^.dX), aangle); 
822  610 
amRope: DrawRotated(sprHandRope, hx, hy, hwSign(Gear^.dX), aangle); 
823
90d651e75547
Use ammoinhand sprites for desert eagle, shotgun and bazooka
unc0rr
parents:
822
diff
changeset

611 
amShotgun: DrawRotated(sprHandShotgun, hx, hy, hwSign(Gear^.dX), aangle); 
90d651e75547
Use ammoinhand sprites for desert eagle, shotgun and bazooka
unc0rr
parents:
822
diff
changeset

612 
amDEagle: DrawRotated(sprHandDEagle, hx, hy, hwSign(Gear^.dX), aangle); 
847  613 
amBlowTorch: DrawRotated(sprHandBlowTorch, hx, hy, hwSign(Gear^.dX), aangle); 
822  614 
end; 
826  615 

822  616 
case amt of 
825  617 
amAirAttack, 
847  618 
amMineStrike: DrawRotated(sprHandAirAttack, hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y) + WorldDy, hwSign(Gear^.dX), 0); 
619 
amPickHammer: DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

834  620 
hwSign(Gear^.dX), 
621 
1, 

622 
2, 

623 
0); 

847  624 
amBlowTorch: DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
625 
hwSign(Gear^.dX), 

626 
1, 

627 
3, 

628 
0); 

853  629 
amTeleport: DrawRotatedF(sprTeleport, hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 0, hwSign(Gear^.dX), 0); 
822  630 
else 
631 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

632 
hwSign(Gear^.dX), 

633 
0, 

847  634 
4, 
822  635 
0); 
834  636 
end; 
637 

638 
case amt of 

639 
amBaseballBat: DrawRotated(sprHandBaseball, 

640 
hwRound(Gear^.X) + 1  4 * hwSign(Gear^.dX) + WorldDx, 

641 
hwRound(Gear^.Y) + 6 + WorldDy, hwSign(Gear^.dX), aangle); 

642 
end; 

643 

644 
defaultPos:= false 

822  645 
end 
824  646 
end; 
647 

845  648 
if defaultPos then 
954  649 
DrawRotatedF(sprHHIdle, 
650 
hwRound(Gear^.X) + 1 + WorldDx, 

651 
hwRound(Gear^.Y)  3 + WorldDy, 

652 
(RealTicks div 256 + Gear^.Pos) mod 19, 

822  653 
hwSign(Gear^.dX), 
654 
0); 

292  655 

351  656 
with PHedgehog(Gear^.Hedgehog)^ do 
538  657 
if (Gear^.State{ and not gstAnimation}) = 0 then 
292  658 
begin 
351  659 
t:= hwRound(Gear^.Y)  cHHRadius  10 + WorldDy; 
539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

660 
if (cTagsMask and 1) <> 0 then 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

661 
begin 
762  662 
dec(t, HealthTagTex^.h + 2); 
663 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, HealthTagTex) 

539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

664 
end; 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

665 
if (cTagsMask and 2) <> 0 then 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

666 
begin 
762  667 
dec(t, NameTagTex^.h + 2); 
668 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, NameTagTex) 

539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

669 
end; 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

670 
if (cTagsMask and 4) <> 0 then 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

671 
begin 
762  672 
dec(t, Team^.NameTagTex^.h + 2); 
673 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, Team^.NameTagTex) 

539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

674 
end 
292  675 
end else // Current hedgehog 
538  676 
if (Gear^.State and gstHHDriven) <> 0 then 
292  677 
begin 
351  678 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
679 
DrawSprite(sprFinger, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  64 + WorldDy, 

841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

680 
GameTicks div 32 mod 16); 
821
e6c0408b54ed
Use 'regular standing' and 'rope swing' hedgehog sprites
unc0rr
parents:
815
diff
changeset

681 

542  682 
if (Gear^.State and (gstMoving or gstDrowning)) = 0 then 
351  683 
if (Gear^.State and gstHHThinking) <> 0 then 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

684 
DrawSprite(sprQuestion, hwRound(Gear^.X)  10 + WorldDx, hwRound(Gear^.Y)  cHHRadius  34 + WorldDy, 0) 
292  685 
else 
351  686 
if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then 
777  687 
DrawRotatedTex(Team^.CrosshairTex, 
688 
12, 12, 

689 
Round(hwRound(Gear^.X) + 

690 
hwSign(Gear^.dX) * Sin(Gear^.Angle*pi/cMaxAngle)*60) + WorldDx, 

691 
Round(hwRound(Gear^.Y)  

822  692 
Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy, 0, 
840  693 
hwSign(Gear^.dX) * (Gear^.Angle * 180.0) / cMaxAngle) 
292  694 
end; 
695 
end; 

696 

4  697 
procedure DrawGears(Surface: PSDL_Surface); 
853  698 
var Gear, HHGear: PGear; 
4  699 
i: Longword; 
371  700 
roplen: LongInt; 
4  701 

371  702 
procedure DrawRopeLine(X1, Y1, X2, Y2: LongInt); 
703 
var eX, eY, dX, dY: LongInt; 

704 
i, sX, sY, x, y, d: LongInt; 

366  705 
b: boolean; 
4  706 
begin 
37  707 
if (X1 = X2) and (Y1 = Y2) then 
708 
begin 

351  709 
OutError('WARNING: zero length rope line!', false); 
37  710 
exit 
711 
end; 

366  712 
eX:= 0; 
713 
eY:= 0; 

714 
dX:= X2  X1; 

715 
dY:= Y2  Y1; 

716 

717 
if (dX > 0) then sX:= 1 

718 
else 

719 
if (dX < 0) then 

720 
begin 

721 
sX:= 1; 

722 
dX:= dX 

723 
end else sX:= dX; 

724 

725 
if (dY > 0) then sY:= 1 

726 
else 

727 
if (dY < 0) then 

4  728 
begin 
366  729 
sY:= 1; 
730 
dY:= dY 

731 
end else sY:= dY; 

732 

733 
if (dX > dY) then d:= dX 

734 
else d:= dY; 

735 

736 
x:= X1; 

737 
y:= Y1; 

738 

739 
for i:= 0 to d do 

740 
begin 

741 
inc(eX, dX); 

742 
inc(eY, dY); 

743 
b:= false; 

744 
if (eX > d) then 

35  745 
begin 
366  746 
dec(eX, d); 
747 
inc(x, sX); 

748 
b:= true 

35  749 
end; 
366  750 
if (eY > d) then 
35  751 
begin 
366  752 
dec(eY, d); 
753 
inc(y, sY); 

754 
b:= true 

35  755 
end; 
366  756 
if b then 
757 
begin 

758 
inc(roplen); 

841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

759 
if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x  2, y  2, 0) 
366  760 
end 
4  761 
end 
366  762 
end; 
4  763 

764 
begin 

765 
Gear:= GearsList; 

766 
while Gear<>nil do 

767 
begin 

351  768 
case Gear^.Kind of 
822  769 
gtAmmo_Bomb: DrawRotated(sprBomb, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, Gear^.DirAngle); 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

770 
gtHedgehog: DrawHH(Gear); 
822  771 
gtAmmo_Grenade: DrawRotated(sprGrenade, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, DxDy2Angle(Gear^.dY, Gear^.dX)); 
522  772 
gtHealthTag, 
762  773 
gtSmallDamage: if Gear^.Tex <> nil then DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Tex); 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

774 
gtGrave: DrawSurfSprite(hwRound(Gear^.X) + WorldDx  16, hwRound(Gear^.Y) + WorldDy  16, 32, (GameTicks shr 7) and 7, PHedgehog(Gear^.Hedgehog)^.Team^.GraveTex); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

775 
gtUFO: DrawSprite(sprUFO, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, (GameTicks shr 7) mod 4); 
848  776 
gtPickHammer: DrawSprite(sprPHammer, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  50 + LongInt(((GameTicks shr 5) and 1) * 2) + WorldDy, 0); 
4  777 
gtRope: begin 
35  778 
roplen:= 0; 
4  779 
if RopePoints.Count > 0 then 
780 
begin 

781 
i:= 0; 

782 
while i < Pred(RopePoints.Count) do 

783 
begin 

351  784 
DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy, 
785 
hwRound(RopePoints.ar[Succ(i)].X) + WorldDx, hwRound(RopePoints.ar[Succ(i)].Y) + WorldDy); 

4  786 
inc(i) 
787 
end; 

351  788 
DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy, 
789 
hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy); 

790 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 

791 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

822  792 
DrawRotated(sprRopeHook, hwRound(RopePoints.ar[0].X) + WorldDx, hwRound(RopePoints.ar[0].Y) + WorldDy, 1, RopePoints.HookAngle) 
4  793 
end else 
35  794 
begin 
351  795 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
796 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

822  797 
DrawRotated(sprRopeHook, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, DxDy2Angle(Gear^.dY, Gear^.dX)); 
35  798 
end; 
4  799 
end; 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

800 
gtSmokeTrace: if Gear^.State < 8 then DrawSprite(sprSmokeTrace, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

801 
gtExplosion: DrawSprite(sprExplosion50, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State); 
351  802 
gtMine: if ((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420) 
822  803 
then DrawRotated(sprMineOff, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, Gear^.DirAngle) 
804 
else DrawRotated(sprMineOn, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, Gear^.DirAngle); 

351  805 
gtCase: case Gear^.Pos of 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

806 
posCaseAmmo : DrawSprite(sprCase, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

807 
posCaseHealth: DrawSprite(sprFAid, hwRound(Gear^.X)  24 + WorldDx, hwRound(Gear^.Y)  24 + WorldDy, (GameTicks shr 6) mod 13); 
42  808 
end; 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

809 
gtDynamite: DrawSprite2(sprDynamite, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, Gear^.Tag and 1, Gear^.Tag shr 1); 
822  810 
gtClusterBomb: DrawRotated(sprClusterBomb, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, Gear^.DirAngle); 
841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

811 
gtCluster: DrawSprite(sprClusterParticle, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, 0); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

812 
gtFlame: DrawSprite(sprFlame, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy,(GameTicks div 128 + Gear^.Angle) mod 8); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

813 
gtParachute: DrawSprite(sprParachute, hwRound(Gear^.X)  24 + WorldDx, hwRound(Gear^.Y)  48 + WorldDy, 0); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

814 
gtAirAttack: if Gear^.Tag > 0 then DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0) 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

815 
else DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 1); 
822  816 
gtAirBomb: DrawRotated(sprAirBomb, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, DxDy2Angle(Gear^.dY, Gear^.dX)); 
853  817 
gtTeleport: begin 
818 
HHGear:= PHedgehog(Gear^.Hedgehog)^.Gear; 

819 
DrawRotatedF(sprTeleport, hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, Gear^.Pos, hwSign(HHGear^.dX), 0); 

820 
DrawRotatedF(sprTeleport, hwRound(HHGear^.X) + 1 + WorldDx, hwRound(HHGear^.Y)  3 + WorldDy, 11  Gear^.Pos, hwSign(HHGear^.dX), 0); 

821 
end; 

841
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

822 
gtSwitcher: DrawSprite(sprSwitch, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  56 + WorldDy, (GameTicks shr 6) mod 12); 
0700e3d3474d
Get rid if deprecated Surface parameter of Draw* calls
unc0rr
parents:
840
diff
changeset

823 
gtTarget: DrawSprite(sprTarget, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0); 
4  824 
end; 
351  825 
Gear:= Gear^.NextGear 
4  826 
end; 
827 
end; 

828 

829 
procedure FreeGearsList; 

830 
var t, tt: PGear; 

831 
begin 

832 
tt:= GearsList; 

833 
GearsList:= nil; 

834 
while tt<>nil do 

835 
begin 

836 
t:= tt; 

351  837 
tt:= tt^.NextGear; 
4  838 
Dispose(t) 
839 
end; 

840 
end; 

841 

10  842 
procedure AddMiscGears; 
371  843 
var i: LongInt; 
4  844 
begin 
498  845 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  846 
if (GameFlags and gfForts) = 0 then 
622  847 
for i:= 0 to Pred(cLandAdditions) do 
498  848 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  849 
end; 
850 

371  851 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  852 
var Gear: PGear; 
506  853 
dmg, dmgRadius: LongInt; 
4  854 
begin 
855 
TargetPoint.X:= NoPointX; 

856 
{$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF} 

498  857 
if Radius = 50 then AddGear(X, Y, gtExplosion, 0, _0, _0, 0); 
355  858 
if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion, false); 
506  859 
if (Mask and EXPLAllDamageInRadius)=0 then dmgRadius:= Radius shl 1 
860 
else dmgRadius:= Radius; 

4  861 
Gear:= GearsList; 
862 
while Gear <> nil do 

863 
begin 

506  864 
dmg:= dmgRadius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
538  865 
if (dmg > 1) and 
522  866 
((Gear^.State and gstNoDamage) = 0) then 
4  867 
begin 
355  868 
dmg:= dmg div 2; 
351  869 
case Gear^.Kind of 
10  870 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

871 
gtMine, 
79  872 
gtCase, 
593  873 
gtTarget, 
79  874 
gtFlame: begin 
355  875 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
522  876 
if (Mask and EXPLNoDamage) = 0 then 
877 
begin 

878 
inc(Gear^.Damage, dmg); 

879 
if Gear^.Kind = gtHedgehog then 

880 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, Gear) 

881 
end; 

351  882 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 
42  883 
begin 
506  884 
DeleteCI(Gear); 
498  885 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
886 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  887 
Gear^.State:= Gear^.State or gstMoving; 
351  888 
Gear^.Active:= true; 
42  889 
FollowGear:= Gear 
890 
end; 

4  891 
end; 
51  892 
gtGrave: begin 
351  893 
Gear^.dY:=  _0_004 * dmg; 
894 
Gear^.Active:= true; 

51  895 
end; 
4  896 
end; 
897 
end; 

351  898 
Gear:= Gear^.NextGear 
80  899 
end; 
621  900 
if (Mask and EXPLDontDraw) = 0 then 
901 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(X, Y, Radius); 

498  902 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  903 
end; 
904 

506  905 
procedure ShotgunShot(Gear: PGear); 
906 
var t: PGear; 

955  907 
dmg: LongInt; 
506  908 
begin 
509  909 
Gear^.Radius:= cShotgunRadius; 
506  910 
t:= GearsList; 
911 
while t <> nil do 

912 
begin 

913 
dmg:= min(Gear^.Radius + t^.Radius  hwRound(Distance(Gear^.X  t^.X, Gear^.Y  t^.Y)), 25); 

538  914 
if dmg > 0 then 
506  915 
case t^.Kind of 
916 
gtHedgehog, 

917 
gtMine, 

593  918 
gtCase, 
919 
gtTarget: begin 

506  920 
inc(t^.Damage, dmg); 
867  921 

522  922 
if t^.Kind = gtHedgehog then 
531  923 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, t); 
867  924 

506  925 
DeleteCI(t); 
856  926 
t^.dX:= t^.dX + Gear^.dX * dmg * _0_01 + SignAs(cHHKick, Gear^.dX); 
506  927 
t^.dY:= t^.dY + Gear^.dY * dmg * _0_01; 
928 
t^.State:= t^.State or gstMoving; 

929 
t^.Active:= true; 

930 
FollowGear:= t 

931 
end; 

932 
gtGrave: begin 

933 
t^.dY:=  _0_1; 

934 
t^.Active:= true 

935 
end; 

936 
end; 

937 
t:= t^.NextGear 

938 
end; 

621  939 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius) 
506  940 
end; 
941 

371  942 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  943 
var t: PGearArray; 
371  944 
i: LongInt; 
38  945 
begin 
53  946 
t:= CheckGearsCollision(Ammo); 
351  947 
i:= t^.Count; 
53  948 
while i > 0 do 
949 
begin 

950 
dec(i); 

351  951 
if (t^.ar[i]^.State and gstNoDamage) = 0 then 
952 
case t^.ar[i]^.Kind of 

53  953 
gtHedgehog, 
954 
gtMine, 

593  955 
gtTarget, 
53  956 
gtCase: begin 
351  957 
inc(t^.ar[i]^.Damage, Damage); 
867  958 

522  959 
if t^.ar[i]^.Kind = gtHedgehog then 
960 
AddDamageTag(hwRound(t^.ar[i]^.X), hwRound(t^.ar[i]^.Y), Damage, t^.ar[i]); 

867  961 

538  962 
DeleteCI(t^.ar[i]); 
351  963 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 
964 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

965 
t^.ar[i]^.Active:= true; 

503  966 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  967 
FollowGear:= t^.ar[i] 
53  968 
end; 
969 
end 

126  970 
end; 
971 
SetAllToActive 

38  972 
end; 
973 

4  974 
procedure AssignHHCoords; 
955  975 
var i, t, p, j: LongInt; 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

976 
ar: array[0..Pred(cMaxHHs)] of PGear; 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

977 
Count: Longword; 
4  978 
begin 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

979 
if (GameFlags and gfForts) <> 0 then 
955  980 
begin 
981 
t:= 0; 

982 
for p:= 0 to 1 do 

983 
begin 

984 
with ClansArray[p]^ do 

985 
for j:= 0 to Pred(TeamsNumber) do 

986 
with Teams[j]^ do 

987 
for i:= 0 to cMaxHHIndex do 

988 
with Hedgehogs[i] do 

989 
if (Gear <> nil) and (Gear^.X.QWordValue = 0) then FindPlace(Gear, false, t, t + 1024); 

990 
inc(t, 1024) 

991 
end 

992 
end else // mix hedgehogs 

993 
begin 

994 
Count:= 0; 

995 
for p:= 0 to Pred(TeamsCount) do 

996 
with TeamsArray[p]^ do 

997 
begin 

998 
for i:= 0 to cMaxHHIndex do 

999 
with Hedgehogs[i] do 

1000 
if (Gear <> nil) and (Gear^.X.QWordValue = 0) then 

1001 
begin 

1002 
ar[Count]:= Gear; 

1003 
inc(Count) 

1004 
end; 

1005 
end; 

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

1006 

955  1007 
while (Count > 0) do 
1008 
begin 

1009 
i:= GetRandom(Count); 

1010 
FindPlace(ar[i], false, 0, 2048); 

1011 
ar[i]:= ar[Count  1]; 

1012 
dec(Count) 

1013 
end 

1014 
end 

4  1015 
end; 
1016 

371  1017 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  1018 
var t: PGear; 
1019 
begin 

1020 
t:= GearsList; 

1021 
rX:= sqr(rX); 

1022 
rY:= sqr(rY); 

1023 
while t <> nil do 

1024 
begin 

351  1025 
if (t <> Gear) and (t^.Kind = Kind) then 
498  1026 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  1027 
exit(t); 
1028 
t:= t^.NextGear 

10  1029 
end; 
351  1030 
CheckGearNear:= nil 
15  1031 
end; 
1032 

79  1033 
procedure AmmoFlameWork(Ammo: PGear); 
1034 
var t: PGear; 

1035 
begin 

1036 
t:= GearsList; 

1037 
while t <> nil do 

1038 
begin 

351  1039 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  1040 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  1041 
begin 
351  1042 
inc(t^.Damage, 5); 
1043 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

1044 
t^.dY:=  _0_25; 

1045 
t^.Active:= true; 

79  1046 
DeleteCI(t); 
1047 
FollowGear:= t 

1048 
end; 

351  1049 
t:= t^.NextGear 
79  1050 
end; 
1051 
end; 

1052 

371  1053 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  1054 
var t: PGear; 
1055 
begin 

1056 
t:= GearsList; 

1057 
rX:= sqr(rX); 

1058 
rY:= sqr(rY); 

1059 
while t <> nil do 

1060 
begin 

351  1061 
if t^.Kind in Kind then 
498  1062 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  1063 
exit(t); 
1064 
t:= t^.NextGear 

16  1065 
end; 
351  1066 
CheckGearsNear:= nil 
16  1067 
end; 
1068 

1069 
function CountGears(Kind: TGearType): Longword; 

1070 
var t: PGear; 

351  1071 
Result: Longword; 
16  1072 
begin 
1073 
Result:= 0; 

1074 
t:= GearsList; 

1075 
while t <> nil do 

1076 
begin 

351  1077 
if t^.Kind = Kind then inc(Result); 
1078 
t:= t^.NextGear 

16  1079 
end; 
351  1080 
CountGears:= Result 
16  1081 
end; 
1082 

15  1083 
procedure SpawnBoxOfSmth; 
394
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1084 
var t: LongInt; 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1085 
i: TAmmoType; 
15  1086 
begin 
614  1087 
if (cCaseFactor = 0) or 
1088 
(CountGears(gtCase) >= 5) or 

1089 
(getrandom(cCaseFactor) <> 0) then exit; 

498  1090 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  1091 
case getrandom(2) of 
1092 
0: begin 

351  1093 
FollowGear^.Health:= 25; 
1094 
FollowGear^.Pos:= posCaseHealth 

295  1095 
end; 
1096 
1: begin 

394
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1097 
t:= 0; 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1098 
for i:= Low(TAmmoType) to High(TAmmoType) do 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1099 
inc(t, Ammoz[i].Probability); 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1100 
t:= GetRandom(t); 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1101 
i:= Low(TAmmoType); 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1102 
dec(t, Ammoz[i].Probability); 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1103 
while t >= 0 do 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1104 
begin 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1105 
inc(i); 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1106 
dec(t, Ammoz[i].Probability) 
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1107 
end; 
865  1108 
PlaySound(sndReinforce, false); 
351  1109 
FollowGear^.Pos:= posCaseAmmo; 
394
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1110 
FollowGear^.State:= Longword(i) 
295  1111 
end; 
1112 
end; 

70  1113 
FindPlace(FollowGear, true, 0, 2048) 
1114 
end; 

1115 

371  1116 
procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt); 
70  1117 

371  1118 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
1119 
var i: LongInt; 

1120 
Result: LongInt; 

70  1121 
begin 
1122 
Result:= 0; 

701  1123 
if (y and $FFFFFC00) = 0 then 
1124 
for i:= max(x  r, 0) to min(x + r, 2043) do 

351  1125 
if Land[y, i] <> 0 then inc(Result); 
1126 
CountNonZeroz:= Result 

70  1127 
end; 
1128 

495  1129 
var x: LongInt; 
371  1130 
y, sy: LongInt; 
386  1131 
ar: array[0..511] of TPoint; 
1132 
ar2: array[0..1023] of TPoint; 

392  1133 
cnt, cnt2: Longword; 
1134 
delta: LongInt; 

70  1135 
begin 
386  1136 
delta:= 250; 
1137 
cnt2:= 0; 

16  1138 
repeat 
392  1139 
x:= Left + LongInt(GetRandom(Delta)); 
70  1140 
repeat 
386  1141 
inc(x, Delta); 
70  1142 
cnt:= 0; 
351  1143 
y:= Gear^.Radius * 2; 
70  1144 
while y < 1023 do 
16  1145 
begin 
70  1146 
repeat 
701  1147 
inc(y, 2); 
351  1148 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  1149 
sy:= y; 
1150 
repeat 

1151 
inc(y); 

351  1152 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) <> 0); 
1153 
if (y  sy > Gear^.Radius * 2) 

70  1154 
and (y < 1023) 
351  1155 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  1156 
begin 
1157 
ar[cnt].X:= x; 

351  1158 
if withFall then ar[cnt].Y:= sy + Gear^.Radius 
1159 
else ar[cnt].Y:= y  Gear^.Radius; 

70  1160 
inc(cnt) 
1161 
end; 

386  1162 
inc(y, 45) 
16  1163 
end; 
70  1164 
if cnt > 0 then 
1165 
with ar[GetRandom(cnt)] do 

1166 
begin 

386  1167 
ar2[cnt2].x:= x; 
1168 
ar2[cnt2].y:= y; 

1169 
inc(cnt2) 

70  1170 
end 
386  1171 
until (x + Delta > Right); 
1172 
dec(Delta, 60) 

1173 
until (cnt2 > 0) or (Delta < 70); 

1174 
if cnt2 > 0 then 

1175 
with ar2[GetRandom(cnt2)] do 

1176 
begin 

498  1177 
Gear^.X:= int2hwFloat(x); 
1178 
Gear^.Y:= int2hwFloat(y); 

386  1179 
{$IFDEF DEBUGFILE} 
1180 
AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')'); 

1181 
{$ENDIF} 

1182 
end 

1183 
else 

1184 
begin 

1185 
OutError('Can''t find place for Gear', false); 

1186 
DeleteGear(Gear) 

1187 
end 

10  1188 
end; 
1189 

4  1190 
initialization 
1191 

1192 
finalization 

95  1193 
FreeGearsList; 
4  1194 

1195 
end. 