author  unc0rr 
Thu, 08 May 2008 12:04:13 +0000  
changeset 910  8d5f3fef4ac2 
parent 883  07a568ba44e0 
child 915  33040b7695c0 
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; 

188  31 
State : Longword; 
351  32 
X : hwFloat; 
33 
Y : hwFloat; 

34 
dX: hwFloat; 

35 
dY: hwFloat; 

42  36 
Kind: TGearType; 
37 
Pos: Longword; 

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

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

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

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

53 
TriggerId: Longword; 
4  54 
end; 
55 

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

59 
procedure SetAllHHToActive; 

60 
procedure DrawGears(Surface: PSDL_Surface); 

61 
procedure FreeGearsList; 

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

4  66 

67 
var CurAmmoGear: PGear = nil; 

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

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

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

74 
uStats; 
789  75 

76 
const MAXROPEPOINTS = 300; 

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

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

4  83 
b: boolean; 
84 
end; 

85 
end; 

86 

87 
procedure DeleteGear(Gear: PGear); forward; 

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

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

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

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

100 
{$INCLUDE GSHandlers.inc} 

101 
{$INCLUDE HHHandlers.inc} 

102 

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

351  104 
@doStepBomb, 
105 
@doStepHedgehog, 

106 
@doStepGrenade, 

107 
@doStepHealthTag, 

108 
@doStepGrave, 

109 
@doStepUFO, 

110 
@doStepShotgunShot, 

111 
@doStepPickHammer, 

112 
@doStepRope, 

113 
@doStepSmokeTrace, 

114 
@doStepExplosion, 

115 
@doStepMine, 

116 
@doStepCase, 

117 
@doStepDEagleShot, 

118 
@doStepDynamite, 

119 
@doStepTeamHealthSorter, 

120 
@doStepBomb, 

121 
@doStepCluster, 

122 
@doStepShover, 

123 
@doStepFlame, 

124 
@doStepFirePunch, 

125 
@doStepActionTimer, 

126 
@doStepActionTimer, 

127 
@doStepActionTimer, 

128 
@doStepParachute, 

129 
@doStepAirAttack, 

130 
@doStepAirBomb, 

409  131 
@doStepBlowTorch, 
520  132 
@doStepGirder, 
522  133 
@doStepTeleport, 
534  134 
@doStepHealthTag, 
590  135 
@doStepSwitcher, 
136 
@doStepCase 

4  137 
); 
138 

294  139 
procedure InsertGearToList(Gear: PGear); 
803  140 
var tmp, ptmp: PGear; 
294  141 
begin 
142 
if GearsList = nil then 

143 
GearsList:= Gear 

144 
else begin 

145 
tmp:= GearsList; 

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

148 
begin 

149 
ptmp:= tmp; 

150 
tmp:= tmp^.NextGear 

151 
end; 

294  152 

803  153 
if ptmp <> nil then 
154 
begin 

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

156 
Gear^.PrevGear:= ptmp; 

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

158 
ptmp^.NextGear:= Gear 

159 
end 

160 
else GearsList:= Gear 

294  161 
end 
162 
end; 

163 

164 
procedure RemoveGearFromList(Gear: PGear); 

165 
begin 

351  166 
if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear^.PrevGear; 
167 
if Gear^.PrevGear <> nil then Gear^.PrevGear^.NextGear:= Gear^.NextGear 

809  168 
else GearsList:= Gear^.NextGear 
294  169 
end; 
170 

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

351  182 
Result^.Kind := Kind; 
183 
Result^.State:= State; 

184 
Result^.Active:= true; 

185 
Result^.dX:= dX; 

186 
Result^.dY:= dY; 

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

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

190 

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

192 
begin 
602  193 
Result^.Hedgehog:= CurrentHedgehog; 
194 
Result^.IntersectGear:= CurrentHedgehog^.Gear 

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

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

196 

4  197 
case Kind of 
198 
gtAmmo_Bomb: begin 

351  199 
Result^.Radius:= 4; 
200 
Result^.Elasticity:= _0_6; 

201 
Result^.Friction:= _0_995; 

4  202 
end; 
203 
gtHedgehog: begin 

351  204 
Result^.Radius:= cHHRadius; 
205 
Result^.Elasticity:= _0_35; 

206 
Result^.Friction:= _0_999; 

207 
Result^.Angle:= cMaxAngle div 2; 

208 
Result^.Z:= cHHZ; 

4  209 
end; 
210 
gtAmmo_Grenade: begin 

351  211 
Result^.Radius:= 4; 
4  212 
end; 
213 
gtHealthTag: begin 

351  214 
Result^.Timer:= 1500; 
522  215 
Result^.Z:= 2001; 
4  216 
end; 
217 
gtGrave: begin 

351  218 
Result^.Radius:= 10; 
219 
Result^.Elasticity:= _0_6; 

4  220 
end; 
221 
gtUFO: begin 

351  222 
Result^.Radius:= 5; 
223 
Result^.Timer:= 500; 

224 
Result^.Elasticity:= _0_9 

4  225 
end; 
226 
gtShotgunShot: begin 

351  227 
Result^.Timer:= 900; 
228 
Result^.Radius:= 2 

4  229 
end; 
230 
gtPickHammer: begin 

351  231 
Result^.Radius:= 10; 
232 
Result^.Timer:= 4000 

4  233 
end; 
234 
gtSmokeTrace: begin 

498  235 
Result^.X:= Result^.X  _16; 
236 
Result^.Y:= Result^.Y  _16; 

351  237 
Result^.State:= 8 
4  238 
end; 
239 
gtRope: begin 

351  240 
Result^.Radius:= 3; 
498  241 
Result^.Friction:= _450; 
4  242 
RopePoints.Count:= 0; 
243 
end; 

9  244 
gtExplosion: begin 
498  245 
Result^.X:= Result^.X  _25; 
246 
Result^.Y:= Result^.Y  _25; 

9  247 
end; 
10  248 
gtMine: begin 
503  249 
Result^.State:= Result^.State or gstMoving; 
351  250 
Result^.Radius:= 3; 
251 
Result^.Elasticity:= _0_55; 

252 
Result^.Friction:= _0_995; 

253 
Result^.Timer:= 3000; 

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

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

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

258 
end; 
37  259 
gtDEagleShot: begin 
351  260 
Result^.Radius:= 1; 
261 
Result^.Health:= 50 

37  262 
end; 
39  263 
gtDynamite: begin 
351  264 
Result^.Radius:= 3; 
265 
Result^.Elasticity:= _0_55; 

266 
Result^.Friction:= _0_03; 

267 
Result^.Timer:= 5000; 

39  268 
end; 
78  269 
gtClusterBomb: begin 
351  270 
Result^.Radius:= 4; 
271 
Result^.Elasticity:= _0_6; 

272 
Result^.Friction:= _0_995; 

78  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; 
4  305 
end; 
351  306 
InsertGearToList(Result); 
307 
AddGear:= Result 

4  308 
end; 
309 

310 
procedure DeleteGear(Gear: PGear); 

48  311 
var team: PTeam; 
307  312 
t: Longword; 
4  313 
begin 
503  314 
DeleteCI(Gear); 
762  315 

316 
if Gear^.Tex <> nil then 

522  317 
begin 
762  318 
FreeTexture(Gear^.Tex); 
319 
Gear^.Tex:= nil 

522  320 
end; 
762  321 

351  322 
if Gear^.Kind = gtHedgehog then 
4  323 
if CurAmmoGear <> nil then 
324 
begin 

351  325 
Gear^.Message:= gm_Destroy; 
326 
CurAmmoGear^.Message:= gm_Destroy; 

4  327 
exit 
47  328 
end else 
329 
begin 

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

345 
if Gear^.TriggerId <> 0 then TickTrigger(Gear^.TriggerId); 
82  346 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  347 
if FollowGear = Gear then FollowGear:= nil; 
294  348 
RemoveGearFromList(Gear); 
4  349 
Dispose(Gear) 
350 
end; 

351 

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

353 
var Gear: PGear; 

354 
begin 

351  355 
CheckNoDamage:= true; 
4  356 
Gear:= GearsList; 
357 
while Gear <> nil do 

867  358 
begin 
359 
if Gear^.Kind = gtHedgehog then 

360 
if Gear^.Damage <> 0 then 

361 
begin 

362 
CheckNoDamage:= false; 

363 
uStats.HedgehogDamaged(Gear); 

351  364 

867  365 
if Gear^.Health < Gear^.Damage then 
366 
Gear^.Health:= 0 

367 
else 

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

369 

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

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

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

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

374 

375 
Gear^.Damage:= 0 

376 
end; 

377 
Gear:= Gear^.NextGear 

378 
end; 

4  379 
end; 
380 

522  381 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); 
382 
begin 

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

522  385 
end; 
386 

4  387 
procedure ProcessGears; 
614  388 
const delay: LongWord = 0; 
869  389 
step: (stDelay, stChDmg, stTurnReact, 
390 
stAfterDelay, stChWin, stSpawn, stNTurn) = stDelay; 

4  391 
var Gear, t: PGear; 
392 
begin 

868  393 
PrvInactive:= AllInactive; 
4  394 
AllInactive:= true; 
395 
t:= GearsList; 

396 
while t<>nil do 

397 
begin 

398 
Gear:= t; 

351  399 
t:= Gear^.NextGear; 
400 
if Gear^.Active then Gear^.doStep(Gear); 

4  401 
end; 
89  402 

4  403 
if AllInactive then 
15  404 
case step of 
405 
stDelay: begin 

406 
if delay = 0 then 

407 
delay:= cInactDelay 

614  408 
else 
409 
dec(delay); 

410 

411 
if delay = 0 then 

412 
inc(step) 

15  413 
end; 
414 
stChDmg: if CheckNoDamage then inc(step) else step:= stDelay; 

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

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

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

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

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

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

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

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

422 
end; 
815  423 
stAfterDelay: begin 
424 
if delay = 0 then 

425 
delay:= cInactDelay 

426 
else 

427 
dec(delay); 

428 

429 
if delay = 0 then 

430 
inc(step) 

431 
end; 

869  432 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
15  433 
stSpawn: begin 
434 
if not isInMultiShoot then SpawnBoxOfSmth; 

435 
inc(step) 

436 
end; 

437 
stNTurn: begin 

438 
if isInMultiShoot then isInMultiShoot:= false 

307  439 
else begin 
351  440 
ParseCommand('/nextturn', true); 
307  441 
end; 
15  442 
step:= Low(step) 
443 
end; 

444 
end; 

445 

4  446 
if TurnTimeLeft > 0 then 
870  447 
if CurrentHedgehog^.Gear <> nil then 
448 
if ((CurrentHedgehog^.Gear^.State and gstAttacking) = 0) 

449 
and not isInMultiShoot then 

450 
begin 

451 
if (TurnTimeLeft = 5000) 

452 
and (CurrentHedgehog^.Gear <> nil) 

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

454 
dec(TurnTimeLeft) 

455 
end; 

351  456 

651  457 
if (not CurrentTeam^.ExtDriven) and 
656
6d6d9d7b1054
Fix network game bug caused by recent protocol changes
unc0rr
parents:
651
diff
changeset

458 
((GameTicks and $FFFF) = $FFFF) then 
6d6d9d7b1054
Fix network game bug caused by recent protocol changes
unc0rr
parents:
651
diff
changeset

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

460 
SendIPCTimeInc; 
869  461 
inc(hiTicks) // we do not recieve a message for this 
656
6d6d9d7b1054
Fix network game bug caused by recent protocol changes
unc0rr
parents:
651
diff
changeset

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

463 

515  464 
inc(GameTicks) 
4  465 
end; 
466 

467 
procedure SetAllToActive; 

468 
var t: PGear; 

469 
begin 

470 
AllInactive:= false; 

471 
t:= GearsList; 

351  472 
while t <> nil do 
4  473 
begin 
351  474 
t^.Active:= true; 
475 
t:= t^.NextGear 

4  476 
end 
477 
end; 

478 

479 
procedure SetAllHHToActive; 

480 
var t: PGear; 

481 
begin 

482 
AllInactive:= false; 

483 
t:= GearsList; 

351  484 
while t <> nil do 
4  485 
begin 
351  486 
if t^.Kind = gtHedgehog then t^.Active:= true; 
487 
t:= t^.NextGear 

4  488 
end 
489 
end; 

490 

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

491 
procedure DrawHH(Gear: PGear); 
371  492 
var t: LongInt; 
822  493 
amt: TAmmoType; 
862  494 
hx, hy, m: LongInt; 
495 
aAngle, dAngle: real; 

824  496 
defaultPos: boolean; 
292  497 
begin 
868  498 
if (Gear^.State and gstHHDeath) <> 0 then 
499 
begin 

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

501 
exit 

502 
end; 

824  503 
defaultPos:= true; 
847  504 

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

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

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

510 

822  511 
if CurAmmoGear <> nil then 
512 
begin 

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

516 
else 

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

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

861  519 
gtRope: begin 
862  520 
if Gear^.X < CurAmmoGear^.X then 
521 
begin 

522 
dAngle:= 0; 

523 
m:= 1 

524 
end else 

525 
begin 

526 
dAngle:= 180; 

527 
m:= 1 

528 
end; 

847  529 
DrawHedgehog(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
862  530 
m, 
847  531 
1, 
532 
0, 

862  533 
DxDy2Angle(CurAmmoGear^.dY, CurAmmoGear^.dX) + dAngle); 
847  534 
defaultPos:= false 
535 
end; 

536 
gtBlowTorch: begin 

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

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

539 
hwSign(Gear^.dX), 

540 
1, 

541 
3, 

542 
0); 

543 
end; 

854  544 
gtShover: DrawRotated(sprHandBaseball, hx, hy, hwSign(Gear^.dX), aangle + 180); 
853  545 
gtPickHammer, 
546 
gtTeleport: defaultPos:= false; 

876  547 
end; 
548 

549 
case CurAmmoGear^.Kind of 

550 
gtShotgunShot, 

551 
gtDEagleShot, 

552 
gtShover: begin 

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

554 
hwSign(Gear^.dX), 

555 
0, 

556 
4, 

557 
0); 

558 
defaultPos:= false 

559 
end 

847  560 
end 
822  561 
end else 
874  562 

824  563 
if ((Gear^.State and gstHHJumping) <> 0) then 
564 
begin 

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

567 
 hwSign(Gear^.dX), 

568 
1, 

569 
1, 

570 
0) 

571 
else 

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

573 
hwSign(Gear^.dX), 

574 
1, 

575 
1, 

576 
0); 

824  577 
defaultPos:= false 
578 
end else 

874  579 

824  580 
if (Gear^.Message and (gm_Left or gm_Right) <> 0) 
581 
or ((Gear^.State and gstAttacked) <> 0) then 

582 
begin 

822  583 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
584 
hwSign(Gear^.dX), 

585 
0, 

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

824  587 
0); 
588 
defaultPos:= false 

589 
end 

822  590 
else 
874  591 

822  592 
begin 
593 
amt:= CurrentHedgehog^.Ammo^[CurrentHedgehog^.CurSlot, CurrentHedgehog^.CurAmmo].AmmoType; 

594 
case amt of 

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

595 
amBazooka: DrawRotated(sprHandBazooka, hx, hy, hwSign(Gear^.dX), aangle); 
822  596 
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

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

598 
amDEagle: DrawRotated(sprHandDEagle, hx, hy, hwSign(Gear^.dX), aangle); 
847  599 
amBlowTorch: DrawRotated(sprHandBlowTorch, hx, hy, hwSign(Gear^.dX), aangle); 
822  600 
end; 
826  601 

822  602 
case amt of 
825  603 
amAirAttack, 
847  604 
amMineStrike: DrawRotated(sprHandAirAttack, hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y) + WorldDy, hwSign(Gear^.dX), 0); 
605 
amPickHammer: DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

834  606 
hwSign(Gear^.dX), 
607 
1, 

608 
2, 

609 
0); 

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

612 
1, 

613 
3, 

614 
0); 

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

618 
hwSign(Gear^.dX), 

619 
0, 

847  620 
4, 
822  621 
0); 
834  622 
end; 
623 

624 
case amt of 

625 
amBaseballBat: DrawRotated(sprHandBaseball, 

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

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

628 
end; 

629 

630 
defaultPos:= false 

822  631 
end 
824  632 
end; 
633 

845  634 
if defaultPos then 
822  635 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
636 
hwSign(Gear^.dX), 

637 
0, 

638 
3, 

639 
0); 

292  640 

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

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

646 
begin 
762  647 
dec(t, HealthTagTex^.h + 2); 
648 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, HealthTagTex) 

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

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

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

651 
begin 
762  652 
dec(t, NameTagTex^.h + 2); 
653 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, NameTagTex) 

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

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

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

656 
begin 
762  657 
dec(t, Team^.NameTagTex^.h + 2); 
658 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, Team^.NameTagTex) 

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

659 
end 
292  660 
end else // Current hedgehog 
538  661 
if (Gear^.State and gstHHDriven) <> 0 then 
292  662 
begin 
351  663 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
664 
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

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

666 

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

669 
DrawSprite(sprQuestion, hwRound(Gear^.X)  10 + WorldDx, hwRound(Gear^.Y)  cHHRadius  34 + WorldDy, 0) 
292  670 
else 
351  671 
if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then 
777  672 
DrawRotatedTex(Team^.CrosshairTex, 
673 
12, 12, 

674 
Round(hwRound(Gear^.X) + 

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

676 
Round(hwRound(Gear^.Y)  

822  677 
Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy, 0, 
840  678 
hwSign(Gear^.dX) * (Gear^.Angle * 180.0) / cMaxAngle) 
292  679 
end; 
680 
end; 

681 

4  682 
procedure DrawGears(Surface: PSDL_Surface); 
853  683 
var Gear, HHGear: PGear; 
4  684 
i: Longword; 
371  685 
roplen: LongInt; 
4  686 

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

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

366  690 
b: boolean; 
4  691 
begin 
37  692 
if (X1 = X2) and (Y1 = Y2) then 
693 
begin 

351  694 
OutError('WARNING: zero length rope line!', false); 
37  695 
exit 
696 
end; 

366  697 
eX:= 0; 
698 
eY:= 0; 

699 
dX:= X2  X1; 

700 
dY:= Y2  Y1; 

701 

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

703 
else 

704 
if (dX < 0) then 

705 
begin 

706 
sX:= 1; 

707 
dX:= dX 

708 
end else sX:= dX; 

709 

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

711 
else 

712 
if (dY < 0) then 

4  713 
begin 
366  714 
sY:= 1; 
715 
dY:= dY 

716 
end else sY:= dY; 

717 

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

719 
else d:= dY; 

720 

721 
x:= X1; 

722 
y:= Y1; 

723 

724 
for i:= 0 to d do 

725 
begin 

726 
inc(eX, dX); 

727 
inc(eY, dY); 

728 
b:= false; 

729 
if (eX > d) then 

35  730 
begin 
366  731 
dec(eX, d); 
732 
inc(x, sX); 

733 
b:= true 

35  734 
end; 
366  735 
if (eY > d) then 
35  736 
begin 
366  737 
dec(eY, d); 
738 
inc(y, sY); 

739 
b:= true 

35  740 
end; 
366  741 
if b then 
742 
begin 

743 
inc(roplen); 

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

744 
if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x  2, y  2, 0) 
366  745 
end 
4  746 
end 
366  747 
end; 
4  748 

749 
begin 

750 
Gear:= GearsList; 

751 
while Gear<>nil do 

752 
begin 

351  753 
case Gear^.Kind of 
822  754 
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

755 
gtHedgehog: DrawHH(Gear); 
822  756 
gtAmmo_Grenade: DrawRotated(sprGrenade, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 0, DxDy2Angle(Gear^.dY, Gear^.dX)); 
522  757 
gtHealthTag, 
762  758 
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

759 
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

760 
gtUFO: DrawSprite(sprUFO, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, (GameTicks shr 7) mod 4); 
848  761 
gtPickHammer: DrawSprite(sprPHammer, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  50 + LongInt(((GameTicks shr 5) and 1) * 2) + WorldDy, 0); 
4  762 
gtRope: begin 
35  763 
roplen:= 0; 
4  764 
if RopePoints.Count > 0 then 
765 
begin 

766 
i:= 0; 

767 
while i < Pred(RopePoints.Count) do 

768 
begin 

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

4  771 
inc(i) 
772 
end; 

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

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

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

822  777 
DrawRotated(sprRopeHook, hwRound(RopePoints.ar[0].X) + WorldDx, hwRound(RopePoints.ar[0].Y) + WorldDy, 1, RopePoints.HookAngle) 
4  778 
end else 
35  779 
begin 
351  780 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
781 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

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

785 
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

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

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

791 
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

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

794 
gtDynamite: DrawSprite2(sprDynamite, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, Gear^.Tag and 1, Gear^.Tag shr 1); 
822  795 
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

796 
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

797 
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

798 
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

799 
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

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

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

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

806 
end; 

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

807 
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

808 
gtTarget: DrawSprite(sprTarget, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0); 
4  809 
end; 
351  810 
Gear:= Gear^.NextGear 
4  811 
end; 
812 
end; 

813 

814 
procedure FreeGearsList; 

815 
var t, tt: PGear; 

816 
begin 

817 
tt:= GearsList; 

818 
GearsList:= nil; 

819 
while tt<>nil do 

820 
begin 

821 
t:= tt; 

351  822 
tt:= tt^.NextGear; 
4  823 
Dispose(t) 
824 
end; 

825 
end; 

826 

10  827 
procedure AddMiscGears; 
371  828 
var i: LongInt; 
4  829 
begin 
498  830 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  831 
if (GameFlags and gfForts) = 0 then 
622  832 
for i:= 0 to Pred(cLandAdditions) do 
498  833 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  834 
end; 
835 

371  836 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  837 
var Gear: PGear; 
506  838 
dmg, dmgRadius: LongInt; 
4  839 
begin 
840 
TargetPoint.X:= NoPointX; 

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

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

4  846 
Gear:= GearsList; 
847 
while Gear <> nil do 

848 
begin 

506  849 
dmg:= dmgRadius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
538  850 
if (dmg > 1) and 
522  851 
((Gear^.State and gstNoDamage) = 0) then 
4  852 
begin 
355  853 
dmg:= dmg div 2; 
351  854 
case Gear^.Kind of 
10  855 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

856 
gtMine, 
79  857 
gtCase, 
593  858 
gtTarget, 
79  859 
gtFlame: begin 
355  860 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
522  861 
if (Mask and EXPLNoDamage) = 0 then 
862 
begin 

863 
inc(Gear^.Damage, dmg); 

864 
if Gear^.Kind = gtHedgehog then 

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

866 
end; 

351  867 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 
42  868 
begin 
506  869 
DeleteCI(Gear); 
498  870 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
871 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  872 
Gear^.State:= Gear^.State or gstMoving; 
351  873 
Gear^.Active:= true; 
42  874 
FollowGear:= Gear 
875 
end; 

4  876 
end; 
51  877 
gtGrave: begin 
351  878 
Gear^.dY:=  _0_004 * dmg; 
879 
Gear^.Active:= true; 

51  880 
end; 
4  881 
end; 
882 
end; 

351  883 
Gear:= Gear^.NextGear 
80  884 
end; 
621  885 
if (Mask and EXPLDontDraw) = 0 then 
886 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(X, Y, Radius); 

498  887 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  888 
end; 
889 

506  890 
procedure ShotgunShot(Gear: PGear); 
891 
var t: PGear; 

892 
dmg: integer; 

893 
begin 

509  894 
Gear^.Radius:= cShotgunRadius; 
506  895 
t:= GearsList; 
896 
while t <> nil do 

897 
begin 

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

538  899 
if dmg > 0 then 
506  900 
case t^.Kind of 
901 
gtHedgehog, 

902 
gtMine, 

593  903 
gtCase, 
904 
gtTarget: begin 

506  905 
inc(t^.Damage, dmg); 
867  906 

522  907 
if t^.Kind = gtHedgehog then 
531  908 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, t); 
867  909 

506  910 
DeleteCI(t); 
856  911 
t^.dX:= t^.dX + Gear^.dX * dmg * _0_01 + SignAs(cHHKick, Gear^.dX); 
506  912 
t^.dY:= t^.dY + Gear^.dY * dmg * _0_01; 
913 
t^.State:= t^.State or gstMoving; 

914 
t^.Active:= true; 

915 
FollowGear:= t 

916 
end; 

917 
gtGrave: begin 

918 
t^.dY:=  _0_1; 

919 
t^.Active:= true 

920 
end; 

921 
end; 

922 
t:= t^.NextGear 

923 
end; 

621  924 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius) 
506  925 
end; 
926 

371  927 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  928 
var t: PGearArray; 
371  929 
i: LongInt; 
38  930 
begin 
53  931 
t:= CheckGearsCollision(Ammo); 
351  932 
i:= t^.Count; 
53  933 
while i > 0 do 
934 
begin 

935 
dec(i); 

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

53  938 
gtHedgehog, 
939 
gtMine, 

593  940 
gtTarget, 
53  941 
gtCase: begin 
351  942 
inc(t^.ar[i]^.Damage, Damage); 
867  943 

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

867  946 

538  947 
DeleteCI(t^.ar[i]); 
351  948 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 
949 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

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

503  951 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  952 
FollowGear:= t^.ar[i] 
53  953 
end; 
954 
end 

126  955 
end; 
956 
SetAllToActive 

38  957 
end; 
958 

4  959 
procedure AssignHHCoords; 
547  960 
var i, t, p: LongInt; 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

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

964 
if (GameFlags and gfForts) <> 0 then 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

966 
t:= 0; 
547  967 
for p:= 0 to Pred(TeamsCount) do 
968 
with TeamsArray[p]^ do 

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

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

970 
for i:= 0 to cMaxHHIndex do 
547  971 
with Hedgehogs[i] do 
604
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

972 
if (Gear <> nil) and (Gear^.X.QWordValue = 0) then FindPlace(Gear, false, t, t + 1024); 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

973 
inc(t, 1024); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

975 
end else // mix hedgehogs 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

977 
Count:= 0; 
547  978 
for p:= 0 to Pred(TeamsCount) do 
979 
with TeamsArray[p]^ do 

4  980 
begin 
82  981 
for i:= 0 to cMaxHHIndex do 
547  982 
with Hedgehogs[i] do 
604
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

983 
if (Gear <> nil) and (Gear^.X.QWordValue = 0) then 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

985 
ar[Count]:= Gear; 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

986 
inc(Count) 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

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

989 

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

990 
while (Count > 0) do 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

992 
i:= GetRandom(Count); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

993 
FindPlace(ar[i], false, 0, 2048); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

994 
ar[i]:= ar[Count  1]; 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

995 
dec(Count) 
4  996 
end 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

997 
end 
4  998 
end; 
999 

371  1000 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  1001 
var t: PGear; 
1002 
begin 

1003 
t:= GearsList; 

1004 
rX:= sqr(rX); 

1005 
rY:= sqr(rY); 

1006 
while t <> nil do 

1007 
begin 

351  1008 
if (t <> Gear) and (t^.Kind = Kind) then 
498  1009 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  1010 
exit(t); 
1011 
t:= t^.NextGear 

10  1012 
end; 
351  1013 
CheckGearNear:= nil 
15  1014 
end; 
1015 

79  1016 
procedure AmmoFlameWork(Ammo: PGear); 
1017 
var t: PGear; 

1018 
begin 

1019 
t:= GearsList; 

1020 
while t <> nil do 

1021 
begin 

351  1022 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  1023 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  1024 
begin 
351  1025 
inc(t^.Damage, 5); 
1026 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

1027 
t^.dY:=  _0_25; 

1028 
t^.Active:= true; 

79  1029 
DeleteCI(t); 
1030 
FollowGear:= t 

1031 
end; 

351  1032 
t:= t^.NextGear 
79  1033 
end; 
1034 
end; 

1035 

371  1036 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  1037 
var t: PGear; 
1038 
begin 

1039 
t:= GearsList; 

1040 
rX:= sqr(rX); 

1041 
rY:= sqr(rY); 

1042 
while t <> nil do 

1043 
begin 

351  1044 
if t^.Kind in Kind then 
498  1045 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  1046 
exit(t); 
1047 
t:= t^.NextGear 

16  1048 
end; 
351  1049 
CheckGearsNear:= nil 
16  1050 
end; 
1051 

1052 
function CountGears(Kind: TGearType): Longword; 

1053 
var t: PGear; 

351  1054 
Result: Longword; 
16  1055 
begin 
1056 
Result:= 0; 

1057 
t:= GearsList; 

1058 
while t <> nil do 

1059 
begin 

351  1060 
if t^.Kind = Kind then inc(Result); 
1061 
t:= t^.NextGear 

16  1062 
end; 
351  1063 
CountGears:= Result 
16  1064 
end; 
1065 

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

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

1068 
i: TAmmoType; 
15  1069 
begin 
614  1070 
if (cCaseFactor = 0) or 
1071 
(CountGears(gtCase) >= 5) or 

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

498  1073 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  1074 
case getrandom(2) of 
1075 
0: begin 

351  1076 
FollowGear^.Health:= 25; 
1077 
FollowGear^.Pos:= posCaseHealth 

295  1078 
end; 
1079 
1: begin 

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

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

1081 
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

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

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

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

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

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

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

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

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

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

1093 
FollowGear^.State:= Longword(i) 
295  1094 
end; 
1095 
end; 

70  1096 
FindPlace(FollowGear, true, 0, 2048) 
1097 
end; 

1098 

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

371  1101 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
1102 
var i: LongInt; 

1103 
Result: LongInt; 

70  1104 
begin 
1105 
Result:= 0; 

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

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

70  1110 
end; 
1111 

495  1112 
var x: LongInt; 
371  1113 
y, sy: LongInt; 
386  1114 
ar: array[0..511] of TPoint; 
1115 
ar2: array[0..1023] of TPoint; 

392  1116 
cnt, cnt2: Longword; 
1117 
delta: LongInt; 

70  1118 
begin 
386  1119 
delta:= 250; 
1120 
cnt2:= 0; 

16  1121 
repeat 
392  1122 
x:= Left + LongInt(GetRandom(Delta)); 
70  1123 
repeat 
386  1124 
inc(x, Delta); 
70  1125 
cnt:= 0; 
351  1126 
y:= Gear^.Radius * 2; 
70  1127 
while y < 1023 do 
16  1128 
begin 
70  1129 
repeat 
701  1130 
inc(y, 2); 
351  1131 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  1132 
sy:= y; 
1133 
repeat 

1134 
inc(y); 

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

70  1137 
and (y < 1023) 
351  1138 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  1139 
begin 
1140 
ar[cnt].X:= x; 

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

70  1143 
inc(cnt) 
1144 
end; 

386  1145 
inc(y, 45) 
16  1146 
end; 
70  1147 
if cnt > 0 then 
1148 
with ar[GetRandom(cnt)] do 

1149 
begin 

386  1150 
ar2[cnt2].x:= x; 
1151 
ar2[cnt2].y:= y; 

1152 
inc(cnt2) 

70  1153 
end 
386  1154 
until (x + Delta > Right); 
1155 
dec(Delta, 60) 

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

1157 
if cnt2 > 0 then 

1158 
with ar2[GetRandom(cnt2)] do 

1159 
begin 

498  1160 
Gear^.X:= int2hwFloat(x); 
1161 
Gear^.Y:= int2hwFloat(y); 

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

1164 
{$ENDIF} 

1165 
end 

1166 
else 

1167 
begin 

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

1169 
DeleteGear(Gear) 

1170 
end 

10  1171 
end; 
1172 

4  1173 
initialization 
1174 

1175 
finalization 

95  1176 
FreeGearsList; 
4  1177 

1178 
end. 