author  unc0rr 
Tue, 22 Apr 2008 19:41:20 +0000  
changeset 862  7c82903753a4 
parent 861  9588286683be 
child 865  a4a5ec6c61d4 
permissions  rwrr 
4  1 
(* 
2 
* Hedgewars, a wormslike game 

393  3 
* Copyright (c) 20042007 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; 

24 

25 
type PGear = ^TGear; 

26 
TGearStepProcedure = procedure (Gear: PGear); 

27 
TGear = record 

28 
NextGear, PrevGear: PGear; 

29 
Active: Boolean; 

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

33 
dX: hwFloat; 

34 
dY: hwFloat; 

42  35 
Kind: TGearType; 
36 
Pos: Longword; 

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

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

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

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

52 
TriggerId: Longword; 
4  53 
end; 
54 

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

58 
procedure SetAllHHToActive; 

59 
procedure DrawGears(Surface: PSDL_Surface); 

60 
procedure FreeGearsList; 

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

4  65 

66 
var CurAmmoGear: PGear = nil; 

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

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

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

73 
uStats; 
789  74 

75 
const MAXROPEPOINTS = 300; 

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

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

4  82 
b: boolean; 
83 
end; 

84 
end; 

85 

86 
procedure DeleteGear(Gear: PGear); forward; 

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

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

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

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

99 
{$INCLUDE GSHandlers.inc} 

100 
{$INCLUDE HHHandlers.inc} 

101 

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

351  103 
@doStepBomb, 
104 
@doStepHedgehog, 

105 
@doStepGrenade, 

106 
@doStepHealthTag, 

107 
@doStepGrave, 

108 
@doStepUFO, 

109 
@doStepShotgunShot, 

110 
@doStepPickHammer, 

111 
@doStepRope, 

112 
@doStepSmokeTrace, 

113 
@doStepExplosion, 

114 
@doStepMine, 

115 
@doStepCase, 

116 
@doStepDEagleShot, 

117 
@doStepDynamite, 

118 
@doStepTeamHealthSorter, 

119 
@doStepBomb, 

120 
@doStepCluster, 

121 
@doStepShover, 

122 
@doStepFlame, 

123 
@doStepFirePunch, 

124 
@doStepActionTimer, 

125 
@doStepActionTimer, 

126 
@doStepActionTimer, 

127 
@doStepParachute, 

128 
@doStepAirAttack, 

129 
@doStepAirBomb, 

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

4  136 
); 
137 

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

142 
GearsList:= Gear 

143 
else begin 

144 
tmp:= GearsList; 

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

147 
begin 

148 
ptmp:= tmp; 

149 
tmp:= tmp^.NextGear 

150 
end; 

294  151 

803  152 
if ptmp <> nil then 
153 
begin 

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

155 
Gear^.PrevGear:= ptmp; 

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

157 
ptmp^.NextGear:= Gear 

158 
end 

159 
else GearsList:= Gear 

294  160 
end 
161 
end; 

162 

163 
procedure RemoveGearFromList(Gear: PGear); 

164 
begin 

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

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

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

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

183 
Result^.Active:= true; 

184 
Result^.dX:= dX; 

185 
Result^.dY:= dY; 

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

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

189 

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

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

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

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

195 

4  196 
case Kind of 
197 
gtAmmo_Bomb: begin 

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

200 
Result^.Friction:= _0_995; 

4  201 
end; 
202 
gtHedgehog: begin 

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

205 
Result^.Friction:= _0_999; 

206 
Result^.Angle:= cMaxAngle div 2; 

207 
Result^.Z:= cHHZ; 

4  208 
end; 
209 
gtAmmo_Grenade: begin 

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

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

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

4  219 
end; 
220 
gtUFO: begin 

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

223 
Result^.Elasticity:= _0_9 

4  224 
end; 
225 
gtShotgunShot: begin 

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

4  228 
end; 
229 
gtPickHammer: begin 

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

4  232 
end; 
233 
gtSmokeTrace: begin 

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

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

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

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

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

251 
Result^.Friction:= _0_995; 

252 
Result^.Timer:= 3000; 

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

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

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

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

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

265 
Result^.Friction:= _0_03; 

266 
Result^.Timer:= 5000; 

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

271 
Result^.Friction:= _0_995; 

78  272 
end; 
79  273 
gtFlame: begin 
351  274 
Result^.Angle:= Counter mod 64; 
275 
Result^.Radius:= 1; 

276 
Result^.Health:= 2; 

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

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

79  279 
end; 
82  280 
gtFirePunch: begin 
351  281 
Result^.Radius:= 15; 
282 
Result^.Tag:= Y 

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

285 
Result^.Radius:= 5; 
302  286 
end; 
287 
gtBlowTorch: begin 

511  288 
Result^.Radius:= cHHRadius + cBlowTorchC; 
351  289 
Result^.Timer:= 7500; 
302  290 
end; 
522  291 
gtSmallDamage: begin 
292 
Result^.Timer:= 1100; 

293 
Result^.Z:= 2000; 

294 
end; 

540  295 
gtSwitcher: begin 
296 
Result^.Z:= cCurrHHZ 

297 
end; 

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

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

300 
Result^.Elasticity:= _0_3 
593  301 
end; 
4  302 
end; 
351  303 
InsertGearToList(Result); 
304 
AddGear:= Result 

4  305 
end; 
306 

307 
procedure DeleteGear(Gear: PGear); 

48  308 
var team: PTeam; 
307  309 
t: Longword; 
4  310 
begin 
503  311 
DeleteCI(Gear); 
762  312 

313 
if Gear^.Tex <> nil then 

522  314 
begin 
762  315 
FreeTexture(Gear^.Tex); 
316 
Gear^.Tex:= nil 

522  317 
end; 
762  318 

351  319 
if Gear^.Kind = gtHedgehog then 
4  320 
if CurAmmoGear <> nil then 
321 
begin 

351  322 
Gear^.Message:= gm_Destroy; 
323 
CurAmmoGear^.Message:= gm_Destroy; 

4  324 
exit 
47  325 
end else 
326 
begin 

498  327 
if not (hwRound(Gear^.Y) < cWaterLine) then 
307  328 
begin 
351  329 
t:= max(Gear^.Damage, Gear^.Health); 
498  330 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
814
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

331 
uStats.HedgehogDamaged(Gear, t) 
307  332 
end; 
351  333 
team:= PHedgehog(Gear^.Hedgehog)^.Team; 
602  334 
if CurrentHedgehog^.Gear = Gear then 
145  335 
FreeActionsList; // to avoid ThinkThread on drawned gear 
351  336 
PHedgehog(Gear^.Hedgehog)^.Gear:= nil; 
307  337 
inc(KilledHHs); 
48  338 
RecountTeamHealth(team); 
47  339 
end; 
357  340 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear');{$ENDIF} 
595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
593
diff
changeset

341 
if Gear^.TriggerId <> 0 then TickTrigger(Gear^.TriggerId); 
82  342 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  343 
if FollowGear = Gear then FollowGear:= nil; 
294  344 
RemoveGearFromList(Gear); 
4  345 
Dispose(Gear) 
346 
end; 

347 

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

349 
var Gear: PGear; 

350 
begin 

351  351 
CheckNoDamage:= true; 
4  352 
Gear:= GearsList; 
353 
while Gear <> nil do 

354 
begin 

351  355 
if Gear^.Kind = gtHedgehog then 
356 
if Gear^.Damage <> 0 then 

4  357 
begin 
351  358 
CheckNoDamage:= false; 
359 
if Gear^.Health < Gear^.Damage then Gear^.Health:= 0 

522  360 
else dec(Gear^.Health, Gear^.Damage); 
361 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y)  cHHRadius  12, 

498  362 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
351  363 
RenderHealth(PHedgehog(Gear^.Hedgehog)^); 
364 
RecountTeamHealth(PHedgehog(Gear^.Hedgehog)^.Team); 

365 

366 
Gear^.Damage:= 0 

4  367 
end; 
351  368 
Gear:= Gear^.NextGear 
83  369 
end; 
4  370 
end; 
371 

522  372 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); 
373 
begin 

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

522  376 
end; 
377 

4  378 
procedure ProcessGears; 
614  379 
const delay: LongWord = 0; 
815  380 
step: (stDelay, stChDmg, stChWin, stTurnReact, 
381 
stAfterDelay, stSpawn, stNTurn) = stDelay; 

4  382 
var Gear, t: PGear; 
383 
begin 

384 
AllInactive:= true; 

385 
t:= GearsList; 

386 
while t<>nil do 

387 
begin 

388 
Gear:= t; 

351  389 
t:= Gear^.NextGear; 
390 
if Gear^.Active then Gear^.doStep(Gear); 

4  391 
end; 
89  392 

4  393 
if AllInactive then 
15  394 
case step of 
395 
stDelay: begin 

396 
if delay = 0 then 

397 
delay:= cInactDelay 

614  398 
else 
399 
dec(delay); 

400 

401 
if delay = 0 then 

402 
inc(step) 

15  403 
end; 
404 
stChDmg: if CheckNoDamage then inc(step) else step:= stDelay; 

351  405 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
814
7fb4417b7bc1
Start implementing better statistics implementation (does nothing yet)
unc0rr
parents:
809
diff
changeset

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

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

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

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

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

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

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

413 
end; 
815  414 
stAfterDelay: begin 
415 
if delay = 0 then 

416 
delay:= cInactDelay 

417 
else 

418 
dec(delay); 

419 

420 
if delay = 0 then 

421 
inc(step) 

422 
end; 

15  423 
stSpawn: begin 
424 
if not isInMultiShoot then SpawnBoxOfSmth; 

425 
inc(step) 

426 
end; 

427 
stNTurn: begin 

351  428 
//AwareOfExplosion(0, 0, 0); 
15  429 
if isInMultiShoot then isInMultiShoot:= false 
307  430 
else begin 
351  431 
ParseCommand('/nextturn', true); 
307  432 
end; 
15  433 
step:= Low(step) 
434 
end; 

435 
end; 

436 

4  437 
if TurnTimeLeft > 0 then 
602  438 
if CurrentHedgehog^.Gear <> nil then 
439 
if ((CurrentHedgehog^.Gear^.State and gstAttacking) = 0) 

4  440 
and not isInMultiShoot then dec(TurnTimeLeft); 
351  441 

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

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

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

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

446 
inc(hiTicks) // we do not recieve a message for it 
6d6d9d7b1054
Fix network game bug caused by recent protocol changes
unc0rr
parents:
651
diff
changeset

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

448 

515  449 
inc(GameTicks) 
4  450 
end; 
451 

452 
procedure SetAllToActive; 

453 
var t: PGear; 

454 
begin 

455 
AllInactive:= false; 

456 
t:= GearsList; 

351  457 
while t <> nil do 
4  458 
begin 
351  459 
t^.Active:= true; 
460 
t:= t^.NextGear 

4  461 
end 
462 
end; 

463 

464 
procedure SetAllHHToActive; 

465 
var t: PGear; 

466 
begin 

467 
AllInactive:= false; 

468 
t:= GearsList; 

351  469 
while t <> nil do 
4  470 
begin 
351  471 
if t^.Kind = gtHedgehog then t^.Active:= true; 
472 
t:= t^.NextGear 

4  473 
end 
474 
end; 

475 

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

476 
procedure DrawHH(Gear: PGear); 
371  477 
var t: LongInt; 
822  478 
amt: TAmmoType; 
862  479 
hx, hy, m: LongInt; 
480 
aAngle, dAngle: real; 

824  481 
defaultPos: boolean; 
292  482 
begin 
824  483 
defaultPos:= true; 
847  484 

485 
hx:= hwRound(Gear^.X) + 1 + 8 * hwSign(Gear^.dX) + WorldDx; 

486 
hy:= hwRound(Gear^.Y)  2 + WorldDy; 

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

488 

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

489 
if (Gear^.State and gstHHDriven) <> 0 then 
822  490 
begin 
491 
if CurAmmoGear <> nil then 

492 
begin 

847  493 
case CurAmmoGear^.Kind of 
861  494 
gtShotgunShot: DrawRotated(sprHandShotgun, hx, hy, hwSign(Gear^.dX), aangle); 
495 
gtRope: begin 

862  496 
if Gear^.X < CurAmmoGear^.X then 
497 
begin 

498 
dAngle:= 0; 

499 
m:= 1 

500 
end else 

501 
begin 

502 
dAngle:= 180; 

503 
m:= 1 

504 
end; 

847  505 
DrawHedgehog(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
862  506 
m, 
847  507 
1, 
508 
0, 

862  509 
DxDy2Angle(CurAmmoGear^.dY, CurAmmoGear^.dX) + dAngle); 
847  510 
defaultPos:= false 
511 
end; 

512 
gtBlowTorch: begin 

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

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

515 
hwSign(Gear^.dX), 

516 
1, 

517 
3, 

518 
0); 

519 
end; 

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

847  523 
end 
822  524 
end else 
824  525 
if ((Gear^.State and gstHHJumping) <> 0) then 
526 
begin 

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

528 
hwSign(Gear^.dX), 

529 
1, 

530 
1, 

531 
0); 

532 
defaultPos:= false 

533 
end else 

534 
if (Gear^.Message and (gm_Left or gm_Right) <> 0) 

535 
or ((Gear^.State and gstAttacked) <> 0) then 

536 
begin 

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

539 
0, 

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

824  541 
0); 
542 
defaultPos:= false 

543 
end 

822  544 
else 
545 
begin 

546 
amt:= CurrentHedgehog^.Ammo^[CurrentHedgehog^.CurSlot, CurrentHedgehog^.CurAmmo].AmmoType; 

547 
case amt of 

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

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

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

551 
amDEagle: DrawRotated(sprHandDEagle, hx, hy, hwSign(Gear^.dX), aangle); 
847  552 
amBlowTorch: DrawRotated(sprHandBlowTorch, hx, hy, hwSign(Gear^.dX), aangle); 
822  553 
end; 
826  554 

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

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

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

558 
amShotgun, 
834  559 
amDEagle, 
847  560 
amBaseballBat: DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
825  561 
hwSign(Gear^.dX), 
562 
0, 

563 
4, 

564 
0); 

565 
amAirAttack, 

847  566 
amMineStrike: DrawRotated(sprHandAirAttack, hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y) + WorldDy, hwSign(Gear^.dX), 0); 
567 
amPickHammer: DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 

834  568 
hwSign(Gear^.dX), 
569 
1, 

570 
2, 

571 
0); 

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

574 
1, 

575 
3, 

576 
0); 

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

580 
hwSign(Gear^.dX), 

581 
0, 

847  582 
4, 
822  583 
0); 
834  584 
end; 
585 

586 
case amt of 

587 
amBaseballBat: DrawRotated(sprHandBaseball, 

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

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

590 
end; 

591 

592 
defaultPos:= false 

822  593 
end 
824  594 
end; 
595 

845  596 
if defaultPos then 
822  597 
DrawHedgehog(hwRound(Gear^.X) + 1 + WorldDx, hwRound(Gear^.Y)  3 + WorldDy, 
598 
hwSign(Gear^.dX), 

599 
0, 

600 
3, 

601 
0); 

292  602 

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

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

608 
begin 
762  609 
dec(t, HealthTagTex^.h + 2); 
610 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, HealthTagTex) 

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

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

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

613 
begin 
762  614 
dec(t, NameTagTex^.h + 2); 
615 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, NameTagTex) 

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

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

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

618 
begin 
762  619 
dec(t, Team^.NameTagTex^.h + 2); 
620 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, Team^.NameTagTex) 

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

621 
end 
292  622 
end else // Current hedgehog 
538  623 
if (Gear^.State and gstHHDriven) <> 0 then 
292  624 
begin 
351  625 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
626 
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

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

628 

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

631 
DrawSprite(sprQuestion, hwRound(Gear^.X)  10 + WorldDx, hwRound(Gear^.Y)  cHHRadius  34 + WorldDy, 0) 
292  632 
else 
351  633 
if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then 
777  634 
DrawRotatedTex(Team^.CrosshairTex, 
635 
12, 12, 

636 
Round(hwRound(Gear^.X) + 

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

638 
Round(hwRound(Gear^.Y)  

822  639 
Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy, 0, 
840  640 
hwSign(Gear^.dX) * (Gear^.Angle * 180.0) / cMaxAngle) 
292  641 
end; 
642 
end; 

643 

4  644 
procedure DrawGears(Surface: PSDL_Surface); 
853  645 
var Gear, HHGear: PGear; 
4  646 
i: Longword; 
371  647 
roplen: LongInt; 
4  648 

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

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

366  652 
b: boolean; 
4  653 
begin 
37  654 
if (X1 = X2) and (Y1 = Y2) then 
655 
begin 

351  656 
OutError('WARNING: zero length rope line!', false); 
37  657 
exit 
658 
end; 

366  659 
eX:= 0; 
660 
eY:= 0; 

661 
dX:= X2  X1; 

662 
dY:= Y2  Y1; 

663 

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

665 
else 

666 
if (dX < 0) then 

667 
begin 

668 
sX:= 1; 

669 
dX:= dX 

670 
end else sX:= dX; 

671 

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

673 
else 

674 
if (dY < 0) then 

4  675 
begin 
366  676 
sY:= 1; 
677 
dY:= dY 

678 
end else sY:= dY; 

679 

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

681 
else d:= dY; 

682 

683 
x:= X1; 

684 
y:= Y1; 

685 

686 
for i:= 0 to d do 

687 
begin 

688 
inc(eX, dX); 

689 
inc(eY, dY); 

690 
b:= false; 

691 
if (eX > d) then 

35  692 
begin 
366  693 
dec(eX, d); 
694 
inc(x, sX); 

695 
b:= true 

35  696 
end; 
366  697 
if (eY > d) then 
35  698 
begin 
366  699 
dec(eY, d); 
700 
inc(y, sY); 

701 
b:= true 

35  702 
end; 
366  703 
if b then 
704 
begin 

705 
inc(roplen); 

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

706 
if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x  2, y  2, 0) 
366  707 
end 
4  708 
end 
366  709 
end; 
4  710 

711 
begin 

712 
Gear:= GearsList; 

713 
while Gear<>nil do 

714 
begin 

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

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

721 
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

722 
gtUFO: DrawSprite(sprUFO, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, (GameTicks shr 7) mod 4); 
848  723 
gtPickHammer: DrawSprite(sprPHammer, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  50 + LongInt(((GameTicks shr 5) and 1) * 2) + WorldDy, 0); 
4  724 
gtRope: begin 
35  725 
roplen:= 0; 
4  726 
if RopePoints.Count > 0 then 
727 
begin 

728 
i:= 0; 

729 
while i < Pred(RopePoints.Count) do 

730 
begin 

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

4  733 
inc(i) 
734 
end; 

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

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

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

822  739 
DrawRotated(sprRopeHook, hwRound(RopePoints.ar[0].X) + WorldDx, hwRound(RopePoints.ar[0].Y) + WorldDy, 1, RopePoints.HookAngle) 
4  740 
end else 
35  741 
begin 
351  742 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
743 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

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

747 
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

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

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

753 
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

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

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

758 
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

759 
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

760 
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

761 
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

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

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

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

768 
end; 

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

769 
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

770 
gtTarget: DrawSprite(sprTarget, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0); 
4  771 
end; 
351  772 
Gear:= Gear^.NextGear 
4  773 
end; 
774 
end; 

775 

776 
procedure FreeGearsList; 

777 
var t, tt: PGear; 

778 
begin 

779 
tt:= GearsList; 

780 
GearsList:= nil; 

781 
while tt<>nil do 

782 
begin 

783 
t:= tt; 

351  784 
tt:= tt^.NextGear; 
4  785 
Dispose(t) 
786 
end; 

787 
end; 

788 

10  789 
procedure AddMiscGears; 
371  790 
var i: LongInt; 
4  791 
begin 
498  792 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  793 
if (GameFlags and gfForts) = 0 then 
622  794 
for i:= 0 to Pred(cLandAdditions) do 
498  795 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  796 
end; 
797 

371  798 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  799 
var Gear: PGear; 
506  800 
dmg, dmgRadius: LongInt; 
4  801 
begin 
802 
TargetPoint.X:= NoPointX; 

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

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

4  808 
Gear:= GearsList; 
809 
while Gear <> nil do 

810 
begin 

506  811 
dmg:= dmgRadius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
538  812 
if (dmg > 1) and 
522  813 
((Gear^.State and gstNoDamage) = 0) then 
4  814 
begin 
355  815 
dmg:= dmg div 2; 
351  816 
case Gear^.Kind of 
10  817 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

818 
gtMine, 
79  819 
gtCase, 
593  820 
gtTarget, 
79  821 
gtFlame: begin 
355  822 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
522  823 
if (Mask and EXPLNoDamage) = 0 then 
824 
begin 

825 
inc(Gear^.Damage, dmg); 

826 
if Gear^.Kind = gtHedgehog then 

831  827 
begin 
828 
uStats.HedgehogDamaged(Gear, dmg); 

522  829 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, Gear) 
831  830 
end 
522  831 
end; 
351  832 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 
42  833 
begin 
506  834 
DeleteCI(Gear); 
498  835 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
836 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  837 
Gear^.State:= Gear^.State or gstMoving; 
351  838 
Gear^.Active:= true; 
42  839 
FollowGear:= Gear 
840 
end; 

4  841 
end; 
51  842 
gtGrave: begin 
351  843 
Gear^.dY:=  _0_004 * dmg; 
844 
Gear^.Active:= true; 

51  845 
end; 
4  846 
end; 
847 
end; 

351  848 
Gear:= Gear^.NextGear 
80  849 
end; 
621  850 
if (Mask and EXPLDontDraw) = 0 then 
851 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(X, Y, Radius); 

498  852 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  853 
end; 
854 

506  855 
procedure ShotgunShot(Gear: PGear); 
856 
var t: PGear; 

857 
dmg: integer; 

858 
begin 

509  859 
Gear^.Radius:= cShotgunRadius; 
506  860 
t:= GearsList; 
861 
while t <> nil do 

862 
begin 

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

538  864 
if dmg > 0 then 
506  865 
case t^.Kind of 
866 
gtHedgehog, 

867 
gtMine, 

593  868 
gtCase, 
869 
gtTarget: begin 

506  870 
inc(t^.Damage, dmg); 
522  871 
if t^.Kind = gtHedgehog then 
872 
begin 

531  873 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, t); 
837
05e910ef2bf8
 Fix hedgehog moveing direction after being shot by shotgun
unc0rr
parents:
834
diff
changeset

874 
uStats.HedgehogDamaged(t, dmg) 
522  875 
end; 
506  876 
DeleteCI(t); 
856  877 
t^.dX:= t^.dX + Gear^.dX * dmg * _0_01 + SignAs(cHHKick, Gear^.dX); 
506  878 
t^.dY:= t^.dY + Gear^.dY * dmg * _0_01; 
879 
t^.State:= t^.State or gstMoving; 

880 
t^.Active:= true; 

881 
FollowGear:= t 

882 
end; 

883 
gtGrave: begin 

884 
t^.dY:=  _0_1; 

885 
t^.Active:= true 

886 
end; 

887 
end; 

888 
t:= t^.NextGear 

889 
end; 

621  890 
if (GameFlags and gfSolidLand) = 0 then DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius) 
506  891 
end; 
892 

371  893 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  894 
var t: PGearArray; 
371  895 
i: LongInt; 
38  896 
begin 
53  897 
t:= CheckGearsCollision(Ammo); 
351  898 
i:= t^.Count; 
53  899 
while i > 0 do 
900 
begin 

901 
dec(i); 

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

53  904 
gtHedgehog, 
905 
gtMine, 

593  906 
gtTarget, 
53  907 
gtCase: begin 
351  908 
inc(t^.ar[i]^.Damage, Damage); 
522  909 
if t^.ar[i]^.Kind = gtHedgehog then 
910 
begin 

911 
AddDamageTag(hwRound(t^.ar[i]^.X), hwRound(t^.ar[i]^.Y), Damage, t^.ar[i]); 

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

912 
uStats.HedgehogDamaged(t^.ar[i], Damage) 
522  913 
end; 
538  914 
DeleteCI(t^.ar[i]); 
351  915 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 
916 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

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

503  918 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  919 
FollowGear:= t^.ar[i] 
53  920 
end; 
921 
end 

126  922 
end; 
923 
SetAllToActive 

38  924 
end; 
925 

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

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

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

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

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

933 
t:= 0; 
547  934 
for p:= 0 to Pred(TeamsCount) do 
935 
with TeamsArray[p]^ do 

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

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

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

939 
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

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

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

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

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

944 
Count:= 0; 
547  945 
for p:= 0 to Pred(TeamsCount) do 
946 
with TeamsArray[p]^ do 

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

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

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

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

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

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

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

956 

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

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

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

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

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

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

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

964 
end 
4  965 
end; 
966 

371  967 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  968 
var t: PGear; 
969 
begin 

970 
t:= GearsList; 

971 
rX:= sqr(rX); 

972 
rY:= sqr(rY); 

973 
while t <> nil do 

974 
begin 

351  975 
if (t <> Gear) and (t^.Kind = Kind) then 
498  976 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  977 
exit(t); 
978 
t:= t^.NextGear 

10  979 
end; 
351  980 
CheckGearNear:= nil 
15  981 
end; 
982 

79  983 
procedure AmmoFlameWork(Ammo: PGear); 
984 
var t: PGear; 

985 
begin 

986 
t:= GearsList; 

987 
while t <> nil do 

988 
begin 

351  989 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  990 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  991 
begin 
351  992 
inc(t^.Damage, 5); 
993 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

994 
t^.dY:=  _0_25; 

995 
t^.Active:= true; 

79  996 
DeleteCI(t); 
997 
FollowGear:= t 

998 
end; 

351  999 
t:= t^.NextGear 
79  1000 
end; 
1001 
end; 

1002 

371  1003 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  1004 
var t: PGear; 
1005 
begin 

1006 
t:= GearsList; 

1007 
rX:= sqr(rX); 

1008 
rY:= sqr(rY); 

1009 
while t <> nil do 

1010 
begin 

351  1011 
if t^.Kind in Kind then 
498  1012 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  1013 
exit(t); 
1014 
t:= t^.NextGear 

16  1015 
end; 
351  1016 
CheckGearsNear:= nil 
16  1017 
end; 
1018 

1019 
function CountGears(Kind: TGearType): Longword; 

1020 
var t: PGear; 

351  1021 
Result: Longword; 
16  1022 
begin 
1023 
Result:= 0; 

1024 
t:= GearsList; 

1025 
while t <> nil do 

1026 
begin 

351  1027 
if t^.Kind = Kind then inc(Result); 
1028 
t:= t^.NextGear 

16  1029 
end; 
351  1030 
CountGears:= Result 
16  1031 
end; 
1032 

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

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

1035 
i: TAmmoType; 
15  1036 
begin 
614  1037 
if (cCaseFactor = 0) or 
1038 
(CountGears(gtCase) >= 5) or 

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

498  1040 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  1041 
case getrandom(2) of 
1042 
0: begin 

351  1043 
FollowGear^.Health:= 25; 
1044 
FollowGear^.Pos:= posCaseHealth 

295  1045 
end; 
1046 
1: begin 

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

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

1048 
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

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

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

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

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

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

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

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

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

1057 
end; 
351  1058 
FollowGear^.Pos:= posCaseAmmo; 
394
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

1059 
FollowGear^.State:= Longword(i) 
295  1060 
end; 
1061 
end; 

70  1062 
FindPlace(FollowGear, true, 0, 2048) 
1063 
end; 

1064 

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

371  1067 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
1068 
var i: LongInt; 

1069 
Result: LongInt; 

70  1070 
begin 
1071 
Result:= 0; 

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

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

70  1076 
end; 
1077 

495  1078 
var x: LongInt; 
371  1079 
y, sy: LongInt; 
386  1080 
ar: array[0..511] of TPoint; 
1081 
ar2: array[0..1023] of TPoint; 

392  1082 
cnt, cnt2: Longword; 
1083 
delta: LongInt; 

70  1084 
begin 
386  1085 
delta:= 250; 
1086 
cnt2:= 0; 

16  1087 
repeat 
392  1088 
x:= Left + LongInt(GetRandom(Delta)); 
70  1089 
repeat 
386  1090 
inc(x, Delta); 
70  1091 
cnt:= 0; 
351  1092 
y:= Gear^.Radius * 2; 
70  1093 
while y < 1023 do 
16  1094 
begin 
70  1095 
repeat 
701  1096 
inc(y, 2); 
351  1097 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  1098 
sy:= y; 
1099 
repeat 

1100 
inc(y); 

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

70  1103 
and (y < 1023) 
351  1104 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  1105 
begin 
1106 
ar[cnt].X:= x; 

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

70  1109 
inc(cnt) 
1110 
end; 

386  1111 
inc(y, 45) 
16  1112 
end; 
70  1113 
if cnt > 0 then 
1114 
with ar[GetRandom(cnt)] do 

1115 
begin 

386  1116 
ar2[cnt2].x:= x; 
1117 
ar2[cnt2].y:= y; 

1118 
inc(cnt2) 

70  1119 
end 
386  1120 
until (x + Delta > Right); 
1121 
dec(Delta, 60) 

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

1123 
if cnt2 > 0 then 

1124 
with ar2[GetRandom(cnt2)] do 

1125 
begin 

498  1126 
Gear^.X:= int2hwFloat(x); 
1127 
Gear^.Y:= int2hwFloat(y); 

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

1130 
{$ENDIF} 

1131 
end 

1132 
else 

1133 
begin 

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

1135 
DeleteGear(Gear) 

1136 
end 

10  1137 
end; 
1138 

4  1139 
initialization 
1140 

1141 
finalization 

95  1142 
FreeGearsList; 
4  1143 

1144 
end. 