author  unc0rr 
Mon, 02 Jul 2007 21:33:21 +0000  
changeset 547  b81a055f2d06 
parent 543  465e2ec8f05f 
child 568  d0690b7aa808 
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; 
351  40 
DirAngle: hwFloat; 
4  41 
Timer : LongWord; 
351  42 
Elasticity: hwFloat; 
43 
Friction : hwFloat; 

4  44 
Message : Longword; 
45 
Hedgehog: pointer; 

371  46 
Health, Damage: LongInt; 
511  47 
CollisionIndex: LongInt; 
371  48 
Tag: LongInt; 
95  49 
Surf: PSDL_Surface; 
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; 
4  52 
end; 
53 

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

57 
procedure SetAllHHToActive; 

58 
procedure DrawGears(Surface: PSDL_Surface); 

59 
procedure FreeGearsList; 

10  60 
procedure AddMiscGears; 
293  61 
procedure AddClouds; 
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, 
295  72 
uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos; 
68  73 
var RopePoints: record 
4  74 
Count: Longword; 
371  75 
HookAngle: LongInt; 
4  76 
ar: array[0..300] of record 
351  77 
X, Y: hwFloat; 
78 
dLen: hwFloat; 

4  79 
b: boolean; 
80 
end; 

81 
end; 

307  82 
StepDamage: Longword = 0; 
4  83 

84 
procedure DeleteGear(Gear: PGear); forward; 

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

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

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

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

97 
{$INCLUDE GSHandlers.inc} 

98 
{$INCLUDE HHHandlers.inc} 

99 

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

351  101 
@doStepCloud, 
102 
@doStepBomb, 

103 
@doStepHedgehog, 

104 
@doStepGrenade, 

105 
@doStepHealthTag, 

106 
@doStepGrave, 

107 
@doStepUFO, 

108 
@doStepShotgunShot, 

109 
@doStepPickHammer, 

110 
@doStepRope, 

111 
@doStepSmokeTrace, 

112 
@doStepExplosion, 

113 
@doStepMine, 

114 
@doStepCase, 

115 
@doStepDEagleShot, 

116 
@doStepDynamite, 

117 
@doStepTeamHealthSorter, 

118 
@doStepBomb, 

119 
@doStepCluster, 

120 
@doStepShover, 

121 
@doStepFlame, 

122 
@doStepFirePunch, 

123 
@doStepActionTimer, 

124 
@doStepActionTimer, 

125 
@doStepActionTimer, 

126 
@doStepParachute, 

127 
@doStepAirAttack, 

128 
@doStepAirBomb, 

409  129 
@doStepBlowTorch, 
520  130 
@doStepGirder, 
522  131 
@doStepTeleport, 
534  132 
@doStepHealthTag, 
133 
@doStepSwitcher 

4  134 
); 
135 

294  136 
procedure InsertGearToList(Gear: PGear); 
137 
var tmp: PGear; 

138 
begin 

139 
if GearsList = nil then 

140 
GearsList:= Gear 

141 
else begin 

142 
// WARNING: this code assumes that the first gears added to the list are clouds (have maximal Z) 

143 
tmp:= GearsList; 

351  144 
while (tmp <> nil) and (tmp^.Z < Gear^.Z) do 
145 
tmp:= tmp^.NextGear; 

294  146 

351  147 
if tmp^.PrevGear <> nil then tmp^.PrevGear^.NextGear:= Gear; 
148 
Gear^.PrevGear:= tmp^.PrevGear; 

149 
tmp^.PrevGear:= Gear; 

150 
Gear^.NextGear:= tmp; 

294  151 
if GearsList = tmp then GearsList:= Gear 
152 
end 

153 
end; 

154 

155 
procedure RemoveGearFromList(Gear: PGear); 

156 
begin 

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

294  159 
else begin 
351  160 
GearsList:= Gear^.NextGear; 
161 
if GearsList <> nil then GearsList^.PrevGear:= nil 

294  162 
end; 
163 
end; 

164 

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

351  176 
Result^.Kind := Kind; 
177 
Result^.State:= State; 

178 
Result^.Active:= true; 

179 
Result^.dX:= dX; 

180 
Result^.dY:= dY; 

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

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

184 

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

186 
begin 
351  187 
Result^.Hedgehog:= @(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]); 
505
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
503
diff
changeset

188 
Result^.IntersectGear:= CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear 
fcba7d7aea0d
Fix old bug with grenade(bomd, etc..) not colliding with attacking hedgehog
unc0rr
parents:
503
diff
changeset

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

190 

4  191 
case Kind of 
351  192 
gtCloud: Result^.Z:= High(Result^.Z); 
4  193 
gtAmmo_Bomb: begin 
351  194 
Result^.Radius:= 4; 
195 
Result^.Elasticity:= _0_6; 

196 
Result^.Friction:= _0_995; 

4  197 
end; 
198 
gtHedgehog: begin 

351  199 
Result^.Radius:= cHHRadius; 
200 
Result^.Elasticity:= _0_35; 

201 
Result^.Friction:= _0_999; 

202 
Result^.Angle:= cMaxAngle div 2; 

203 
Result^.Z:= cHHZ; 

4  204 
end; 
205 
gtAmmo_Grenade: begin 

351  206 
Result^.Radius:= 4; 
4  207 
end; 
208 
gtHealthTag: begin 

351  209 
Result^.Timer:= 1500; 
522  210 
Result^.Z:= 2001; 
4  211 
end; 
212 
gtGrave: begin 

351  213 
Result^.Radius:= 10; 
214 
Result^.Elasticity:= _0_6; 

4  215 
end; 
216 
gtUFO: begin 

351  217 
Result^.Radius:= 5; 
218 
Result^.Timer:= 500; 

219 
Result^.Elasticity:= _0_9 

4  220 
end; 
221 
gtShotgunShot: begin 

351  222 
Result^.Timer:= 900; 
223 
Result^.Radius:= 2 

4  224 
end; 
225 
gtPickHammer: begin 

351  226 
Result^.Radius:= 10; 
227 
Result^.Timer:= 4000 

4  228 
end; 
229 
gtSmokeTrace: begin 

498  230 
Result^.X:= Result^.X  _16; 
231 
Result^.Y:= Result^.Y  _16; 

351  232 
Result^.State:= 8 
4  233 
end; 
234 
gtRope: begin 

351  235 
Result^.Radius:= 3; 
498  236 
Result^.Friction:= _450; 
4  237 
RopePoints.Count:= 0; 
238 
end; 

9  239 
gtExplosion: begin 
498  240 
Result^.X:= Result^.X  _25; 
241 
Result^.Y:= Result^.Y  _25; 

9  242 
end; 
10  243 
gtMine: begin 
503  244 
Result^.State:= Result^.State or gstMoving; 
351  245 
Result^.Radius:= 3; 
246 
Result^.Elasticity:= _0_55; 

247 
Result^.Friction:= _0_995; 

248 
Result^.Timer:= 3000; 

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

250 
gtCase: begin 
351  251 
Result^.Radius:= 16; 
252 
Result^.Elasticity:= _0_4 

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

253 
end; 
37  254 
gtDEagleShot: begin 
351  255 
Result^.Radius:= 1; 
256 
Result^.Health:= 50 

37  257 
end; 
39  258 
gtDynamite: begin 
351  259 
Result^.Radius:= 3; 
260 
Result^.Elasticity:= _0_55; 

261 
Result^.Friction:= _0_03; 

262 
Result^.Timer:= 5000; 

39  263 
end; 
78  264 
gtClusterBomb: begin 
351  265 
Result^.Radius:= 4; 
266 
Result^.Elasticity:= _0_6; 

267 
Result^.Friction:= _0_995; 

78  268 
end; 
79  269 
gtFlame: begin 
351  270 
Result^.Angle:= Counter mod 64; 
271 
Result^.Radius:= 1; 

272 
Result^.Health:= 2; 

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

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

79  275 
end; 
82  276 
gtFirePunch: begin 
351  277 
Result^.Radius:= 15; 
278 
Result^.Tag:= Y 

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

281 
Result^.Radius:= 5; 
302  282 
end; 
283 
gtBlowTorch: begin 

511  284 
Result^.Radius:= cHHRadius + cBlowTorchC; 
351  285 
Result^.Timer:= 7500; 
302  286 
end; 
522  287 
gtSmallDamage: begin 
288 
Result^.Timer:= 1100; 

289 
Result^.Z:= 2000; 

290 
end; 

540  291 
gtSwitcher: begin 
292 
Result^.Z:= cCurrHHZ 

293 
end; 

4  294 
end; 
351  295 
InsertGearToList(Result); 
296 
AddGear:= Result 

4  297 
end; 
298 

299 
procedure DeleteGear(Gear: PGear); 

48  300 
var team: PTeam; 
307  301 
t: Longword; 
4  302 
begin 
503  303 
DeleteCI(Gear); 
522  304 
if Gear^.Surf <> nil then 
305 
begin 

306 
SDL_FreeSurface(Gear^.Surf); 

307 
Gear^.Surf:= nil 

308 
end; 

351  309 
if Gear^.Kind = gtHedgehog then 
4  310 
if CurAmmoGear <> nil then 
311 
begin 

351  312 
Gear^.Message:= gm_Destroy; 
313 
CurAmmoGear^.Message:= gm_Destroy; 

4  314 
exit 
47  315 
end else 
316 
begin 

498  317 
if not (hwRound(Gear^.Y) < cWaterLine) then 
307  318 
begin 
351  319 
t:= max(Gear^.Damage, Gear^.Health); 
498  320 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
307  321 
inc(StepDamage, t) 
322 
end; 

351  323 
team:= PHedgehog(Gear^.Hedgehog)^.Team; 
324 
if CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear = Gear then 

145  325 
FreeActionsList; // to avoid ThinkThread on drawned gear 
351  326 
PHedgehog(Gear^.Hedgehog)^.Gear:= nil; 
307  327 
inc(KilledHHs); 
48  328 
RecountTeamHealth(team); 
47  329 
end; 
357  330 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear');{$ENDIF} 
82  331 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  332 
if FollowGear = Gear then FollowGear:= nil; 
294  333 
RemoveGearFromList(Gear); 
4  334 
Dispose(Gear) 
335 
end; 

336 

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

338 
var Gear: PGear; 

339 
begin 

351  340 
CheckNoDamage:= true; 
4  341 
Gear:= GearsList; 
342 
while Gear <> nil do 

343 
begin 

351  344 
if Gear^.Kind = gtHedgehog then 
345 
if Gear^.Damage <> 0 then 

4  346 
begin 
351  347 
CheckNoDamage:= false; 
348 
inc(StepDamage, Gear^.Damage); 

349 
if Gear^.Health < Gear^.Damage then Gear^.Health:= 0 

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

498  352 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
351  353 
RenderHealth(PHedgehog(Gear^.Hedgehog)^); 
354 
RecountTeamHealth(PHedgehog(Gear^.Hedgehog)^.Team); 

355 

356 
Gear^.Damage:= 0 

4  357 
end; 
351  358 
Gear:= Gear^.NextGear 
83  359 
end; 
4  360 
end; 
361 

522  362 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); 
363 
begin 

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

522  366 
end; 
367 

4  368 
procedure ProcessGears; 
371  369 
const delay: LongInt = cInactDelay; 
92
0c359a7a2356
 Fix win message to appear only after all hedgehogs death
unc0rr
parents:
89
diff
changeset

370 
step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay; 
4  371 
var Gear, t: PGear; 
372 
begin 

373 
AllInactive:= true; 

374 
t:= GearsList; 

375 
while t<>nil do 

376 
begin 

377 
Gear:= t; 

351  378 
t:= Gear^.NextGear; 
379 
if Gear^.Active then Gear^.doStep(Gear); 

4  380 
end; 
89  381 

4  382 
if AllInactive then 
15  383 
case step of 
384 
stDelay: begin 

385 
dec(delay); 

386 
if delay = 0 then 

387 
begin 

388 
inc(step); 

389 
delay:= cInactDelay 

390 
end 

391 
end; 

392 
stChDmg: if CheckNoDamage then inc(step) else step:= stDelay; 

351  393 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
15  394 
stSpawn: begin 
395 
if not isInMultiShoot then SpawnBoxOfSmth; 

396 
inc(step) 

397 
end; 

398 
stNTurn: begin 

351  399 
//AwareOfExplosion(0, 0, 0); 
15  400 
if isInMultiShoot then isInMultiShoot:= false 
307  401 
else begin 
351  402 
with CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog] do 
307  403 
if MaxStepDamage < StepDamage then MaxStepDamage:= StepDamage; 
404 
StepDamage:= 0; 

351  405 
ParseCommand('/nextturn', true); 
307  406 
end; 
15  407 
step:= Low(step) 
408 
end; 

409 
end; 

410 

4  411 
if TurnTimeLeft > 0 then 
412 
if CurrentTeam <> nil then 

351  413 
if CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil then 
414 
if ((CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear^.State and gstAttacking) = 0) 

4  415 
and not isInMultiShoot then dec(TurnTimeLeft); 
351  416 

515  417 
inc(GameTicks) 
4  418 
end; 
419 

420 
procedure SetAllToActive; 

421 
var t: PGear; 

422 
begin 

423 
AllInactive:= false; 

424 
t:= GearsList; 

351  425 
while t <> nil do 
4  426 
begin 
351  427 
t^.Active:= true; 
428 
t:= t^.NextGear 

4  429 
end 
430 
end; 

431 

432 
procedure SetAllHHToActive; 

433 
var t: PGear; 

434 
begin 

435 
AllInactive:= false; 

436 
t:= GearsList; 

351  437 
while t <> nil do 
4  438 
begin 
351  439 
if t^.Kind = gtHedgehog then t^.Active:= true; 
440 
t:= t^.NextGear 

4  441 
end 
442 
end; 

443 

292  444 
procedure DrawHH(Gear: PGear; Surface: PSDL_Surface); 
371  445 
var t: LongInt; 
292  446 
begin 
503  447 
DrawHedgehog(hwRound(Gear^.X)  15 + WorldDx, hwRound(Gear^.Y)  18 + WorldDy, 
351  448 
hwSign(Gear^.dX), 0, 
449 
PHedgehog(Gear^.Hedgehog)^.visStepPos div 2, 

292  450 
Surface); 
451 

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

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

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

458 
dec(t, HealthTag^.h + 2); 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

459 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, HealthTag, Surface) 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

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

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

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

463 
dec(t, NameTag^.h + 2); 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

464 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, NameTag, Surface) 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

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

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

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

468 
dec(t, Team^.NameTag^.h + 2); 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

469 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, Team^.NameTag, Surface) 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
538
diff
changeset

470 
end 
292  471 
end else // Current hedgehog 
538  472 
if (Gear^.State and gstHHDriven) <> 0 then 
292  473 
begin 
351  474 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
475 
DrawSprite(sprFinger, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  64 + WorldDy, 

292  476 
GameTicks div 32 mod 16, Surface); 
542  477 
if (Gear^.State and (gstMoving or gstDrowning)) = 0 then 
351  478 
if (Gear^.State and gstHHThinking) <> 0 then 
479 
DrawGear(sQuestion, hwRound(Gear^.X)  10 + WorldDx, hwRound(Gear^.Y)  cHHRadius  34 + WorldDy, Surface) 

292  480 
else 
351  481 
if ShowCrosshair and ((Gear^.State and gstAttacked) = 0) then 
482 
DrawSurfSprite(Round(hwRound(Gear^.X) + hwSign(Gear^.dX) * Sin(Gear^.Angle*pi/cMaxAngle)*60) + WorldDx  11, 

483 
Round(hwRound(Gear^.Y)  Cos(Gear^.Angle*pi/cMaxAngle)*60) + WorldDy  12, 

371  484 
24, (18 + hwSign(Gear^.dX) * LongInt(((Gear^.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18, 
351  485 
Team^.CrosshairSurf, Surface); 
292  486 
end; 
487 
end; 

488 

4  489 
procedure DrawGears(Surface: PSDL_Surface); 
490 
var Gear: PGear; 

491 
i: Longword; 

371  492 
roplen: LongInt; 
4  493 

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

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

366  497 
b: boolean; 
4  498 
begin 
37  499 
if (X1 = X2) and (Y1 = Y2) then 
500 
begin 

351  501 
OutError('WARNING: zero length rope line!', false); 
37  502 
exit 
503 
end; 

366  504 
eX:= 0; 
505 
eY:= 0; 

506 
dX:= X2  X1; 

507 
dY:= Y2  Y1; 

508 

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

510 
else 

511 
if (dX < 0) then 

512 
begin 

513 
sX:= 1; 

514 
dX:= dX 

515 
end else sX:= dX; 

516 

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

518 
else 

519 
if (dY < 0) then 

4  520 
begin 
366  521 
sY:= 1; 
522 
dY:= dY 

523 
end else sY:= dY; 

524 

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

526 
else d:= dY; 

527 

528 
x:= X1; 

529 
y:= Y1; 

530 

531 
for i:= 0 to d do 

532 
begin 

533 
inc(eX, dX); 

534 
inc(eY, dY); 

535 
b:= false; 

536 
if (eX > d) then 

35  537 
begin 
366  538 
dec(eX, d); 
539 
inc(x, sX); 

540 
b:= true 

35  541 
end; 
366  542 
if (eY > d) then 
35  543 
begin 
366  544 
dec(eY, d); 
545 
inc(y, sY); 

546 
b:= true 

35  547 
end; 
366  548 
if b then 
549 
begin 

550 
inc(roplen); 

551 
if (roplen mod 4) = 0 then DrawGear(sRopeNode, x  2, y  2, Surface) 

552 
end 

4  553 
end 
366  554 
end; 
4  555 

556 
begin 

557 
Gear:= GearsList; 

558 
while Gear<>nil do 

559 
begin 

351  560 
case Gear^.Kind of 
561 
gtCloud: DrawSprite(sprCloud , hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 

562 
gtAmmo_Bomb: DrawSprite(sprBomb , hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, hwRound(Gear^.DirAngle), Surface); 

292  563 
gtHedgehog: DrawHH(Gear, Surface); 
370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
366
diff
changeset

564 
gtAmmo_Grenade: DrawSprite(sprGrenade , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
522  565 
gtHealthTag, 
566 
gtSmallDamage: if Gear^.Surf <> nil then DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Surf, Surface); 

351  567 
gtGrave: DrawSpriteFromRect(PHedgehog(Gear^.Hedgehog)^.Team^.GraveRect, hwRound(Gear^.X) + WorldDx  16, hwRound(Gear^.Y) + WorldDy  16, 32, (GameTicks shr 7) and 7, Surface); 
568 
gtUFO: DrawSprite(sprUFO, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, (GameTicks shr 7) mod 4, Surface); 

569 
gtSmokeTrace: if Gear^.State < 8 then DrawSprite(sprSmokeTrace, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 

4  570 
gtRope: begin 
35  571 
roplen:= 0; 
4  572 
if RopePoints.Count > 0 then 
573 
begin 

574 
i:= 0; 

575 
while i < Pred(RopePoints.Count) do 

576 
begin 

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

4  579 
inc(i) 
580 
end; 

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

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

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

585 
DrawSprite(sprRopeHook, hwRound(RopePoints.ar[0].X) + WorldDx  16, hwRound(RopePoints.ar[0].Y) + WorldDy  16, RopePoints.HookAngle, Surface); 

4  586 
end else 
35  587 
begin 
351  588 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
589 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
366
diff
changeset

590 
DrawSprite(sprRopeHook, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
35  591 
end; 
4  592 
end; 
351  593 
gtExplosion: DrawSprite(sprExplosion50, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 
594 
gtMine: if ((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420) 

595 
then DrawSprite(sprMineOff , hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, hwRound(Gear^.DirAngle), Surface) 

596 
else DrawSprite(sprMineOn , hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, hwRound(Gear^.DirAngle), Surface); 

597 
gtDynamite: DrawSprite2(sprDynamite, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, Gear^.Tag and 1, Gear^.Tag shr 1, Surface); 

598 
gtCase: case Gear^.Pos of 

599 
posCaseAmmo : DrawSprite(sprCase, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0, Surface); 

600 
posCaseHealth: DrawSprite(sprFAid, hwRound(Gear^.X)  24 + WorldDx, hwRound(Gear^.Y)  24 + WorldDy, (GameTicks shr 6) mod 13, Surface); 

42  601 
end; 
351  602 
gtClusterBomb: DrawSprite(sprClusterBomb, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, hwRound(Gear^.DirAngle), Surface); 
603 
gtCluster: DrawSprite(sprClusterParticle, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, 0, Surface); 

604 
gtFlame: DrawSprite(sprFlame, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy,(GameTicks div 128 + Gear^.Angle) mod 8, Surface); 

370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
366
diff
changeset

605 
gtAirBomb: DrawSprite(sprAirBomb , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
408  606 
gtAirAttack: if Gear^.Tag > 0 then DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0, Surface) 
534  607 
else DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 1, Surface); 
608 
gtSwitcher: DrawSprite(sprSwitch, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  56 + WorldDy, 0, Surface); 

4  609 
end; 
351  610 
Gear:= Gear^.NextGear 
4  611 
end; 
612 
end; 

613 

614 
procedure FreeGearsList; 

615 
var t, tt: PGear; 

616 
begin 

617 
tt:= GearsList; 

618 
GearsList:= nil; 

619 
while tt<>nil do 

620 
begin 

621 
t:= tt; 

351  622 
tt:= tt^.NextGear; 
4  623 
Dispose(t) 
624 
end; 

625 
end; 

626 

10  627 
procedure AddMiscGears; 
371  628 
var i: LongInt; 
4  629 
begin 
498  630 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  631 
if (GameFlags and gfForts) = 0 then 
632 
for i:= 0 to 3 do 

498  633 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  634 
end; 
635 

293  636 
procedure AddClouds; 
371  637 
var i: LongInt; 
360  638 
dx, dy: hwFloat; 
293  639 
begin 
640 
for i:= 0 to cCloudsNumber do 

360  641 
begin 
642 
dx.isNegative:= random(2) = 1; 

643 
dx.QWordValue:= random(214748364); 

644 
dy.isNegative:= (i and 1) = 1; 

645 
dy.QWordValue:= 21474836 + random(64424509); 

646 
AddGear(  cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), 140, 

647 
gtCloud, random(4), dx, dy, 0) 

648 
end 

293  649 
end; 
650 

371  651 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  652 
var Gear: PGear; 
506  653 
dmg, dmgRadius: LongInt; 
4  654 
begin 
655 
TargetPoint.X:= NoPointX; 

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

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

4  661 
Gear:= GearsList; 
662 
while Gear <> nil do 

663 
begin 

506  664 
dmg:= dmgRadius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
538  665 
if (dmg > 1) and 
522  666 
((Gear^.State and gstNoDamage) = 0) then 
4  667 
begin 
355  668 
dmg:= dmg div 2; 
351  669 
case Gear^.Kind of 
10  670 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

671 
gtMine, 
79  672 
gtCase, 
673 
gtFlame: begin 

355  674 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
522  675 
if (Mask and EXPLNoDamage) = 0 then 
676 
begin 

677 
inc(Gear^.Damage, dmg); 

678 
if Gear^.Kind = gtHedgehog then 

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

680 
end; 

351  681 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 
42  682 
begin 
506  683 
DeleteCI(Gear); 
498  684 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
685 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  686 
Gear^.State:= Gear^.State or gstMoving; 
351  687 
Gear^.Active:= true; 
42  688 
FollowGear:= Gear 
689 
end; 

4  690 
end; 
51  691 
gtGrave: begin 
351  692 
Gear^.dY:=  _0_004 * dmg; 
693 
Gear^.Active:= true; 

51  694 
end; 
4  695 
end; 
696 
end; 

351  697 
Gear:= Gear^.NextGear 
80  698 
end; 
506  699 
if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius); 
498  700 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  701 
end; 
702 

506  703 
procedure ShotgunShot(Gear: PGear); 
704 
var t: PGear; 

705 
dmg: integer; 

522  706 
hh: PHedgehog; 
506  707 
begin 
509  708 
Gear^.Radius:= cShotgunRadius; 
522  709 
hh:= Gear^.Hedgehog; 
506  710 
t:= GearsList; 
711 
while t <> nil do 

712 
begin 

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

538  714 
if dmg > 0 then 
506  715 
case t^.Kind of 
716 
gtHedgehog, 

717 
gtMine, 

718 
gtCase: begin 

719 
inc(t^.Damage, dmg); 

522  720 
if t^.Kind = gtHedgehog then 
721 
begin 

531  722 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, t); 
522  723 
inc(hh^.DamageGiven, dmg) 
724 
end; 

506  725 
DeleteCI(t); 
726 
t^.dX:= t^.dX + SignAs(Gear^.dX * dmg * _0_01 + cHHKick, t^.X  Gear^.X); 

727 
t^.dY:= t^.dY + Gear^.dY * dmg * _0_01; 

728 
t^.State:= t^.State or gstMoving; 

729 
t^.Active:= true; 

730 
FollowGear:= t 

731 
end; 

732 
gtGrave: begin 

733 
t^.dY:=  _0_1; 

734 
t^.Active:= true 

735 
end; 

736 
end; 

737 
t:= t^.NextGear 

738 
end; 

509  739 
DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius) 
506  740 
end; 
741 

371  742 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  743 
var t: PGearArray; 
371  744 
i: LongInt; 
307  745 
hh: PHedgehog; 
38  746 
begin 
53  747 
t:= CheckGearsCollision(Ammo); 
351  748 
i:= t^.Count; 
749 
hh:= Ammo^.Hedgehog; 

53  750 
while i > 0 do 
751 
begin 

752 
dec(i); 

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

53  755 
gtHedgehog, 
756 
gtMine, 

757 
gtCase: begin 

351  758 
inc(t^.ar[i]^.Damage, Damage); 
522  759 
if t^.ar[i]^.Kind = gtHedgehog then 
760 
begin 

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

762 
inc(hh^.DamageGiven, Damage) 

763 
end; 

538  764 
DeleteCI(t^.ar[i]); 
351  765 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 
766 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

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

503  768 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  769 
FollowGear:= t^.ar[i] 
53  770 
end; 
771 
end 

126  772 
end; 
773 
SetAllToActive 

38  774 
end; 
775 

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

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

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

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

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

783 
t:= 0; 
547  784 
for p:= 0 to Pred(TeamsCount) do 
785 
with TeamsArray[p]^ do 

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

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

787 
for i:= 0 to cMaxHHIndex do 
547  788 
with Hedgehogs[i] do 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

789 
if Gear <> nil then FindPlace(Gear, false, t, t + 1024); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

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

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

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

794 
Count:= 0; 
547  795 
for p:= 0 to Pred(TeamsCount) do 
796 
with TeamsArray[p]^ do 

4  797 
begin 
82  798 
for i:= 0 to cMaxHHIndex do 
547  799 
with Hedgehogs[i] do 
82  800 
if Gear <> nil then 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

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

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

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

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

806 

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

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

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

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

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

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

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

814 
end 
4  815 
end; 
816 

371  817 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  818 
var t: PGear; 
819 
begin 

820 
t:= GearsList; 

821 
rX:= sqr(rX); 

822 
rY:= sqr(rY); 

823 
while t <> nil do 

824 
begin 

351  825 
if (t <> Gear) and (t^.Kind = Kind) then 
498  826 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  827 
exit(t); 
828 
t:= t^.NextGear 

10  829 
end; 
351  830 
CheckGearNear:= nil 
15  831 
end; 
832 

79  833 
procedure AmmoFlameWork(Ammo: PGear); 
834 
var t: PGear; 

835 
begin 

836 
t:= GearsList; 

837 
while t <> nil do 

838 
begin 

351  839 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  840 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  841 
begin 
351  842 
inc(t^.Damage, 5); 
843 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

844 
t^.dY:=  _0_25; 

845 
t^.Active:= true; 

79  846 
DeleteCI(t); 
847 
FollowGear:= t 

848 
end; 

351  849 
t:= t^.NextGear 
79  850 
end; 
851 
end; 

852 

371  853 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  854 
var t: PGear; 
855 
begin 

856 
t:= GearsList; 

857 
rX:= sqr(rX); 

858 
rY:= sqr(rY); 

859 
while t <> nil do 

860 
begin 

351  861 
if t^.Kind in Kind then 
498  862 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  863 
exit(t); 
864 
t:= t^.NextGear 

16  865 
end; 
351  866 
CheckGearsNear:= nil 
16  867 
end; 
868 

869 
function CountGears(Kind: TGearType): Longword; 

870 
var t: PGear; 

351  871 
Result: Longword; 
16  872 
begin 
873 
Result:= 0; 

874 
t:= GearsList; 

875 
while t <> nil do 

876 
begin 

351  877 
if t^.Kind = Kind then inc(Result); 
878 
t:= t^.NextGear 

16  879 
end; 
351  880 
CountGears:= Result 
16  881 
end; 
882 

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

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

885 
i: TAmmoType; 
15  886 
begin 
295  887 
if (CountGears(gtCase) >= 5) or (getrandom(cCaseFactor) <> 0) then exit; 
498  888 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  889 
case getrandom(2) of 
890 
0: begin 

351  891 
FollowGear^.Health:= 25; 
892 
FollowGear^.Pos:= posCaseHealth 

295  893 
end; 
894 
1: begin 

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

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

896 
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

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

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

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

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

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

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

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

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

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

907 
FollowGear^.State:= Longword(i) 
295  908 
end; 
909 
end; 

70  910 
FindPlace(FollowGear, true, 0, 2048) 
911 
end; 

912 

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

371  915 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
916 
var i: LongInt; 

917 
Result: LongInt; 

70  918 
begin 
919 
Result:= 0; 

920 
if (y and $FFFFFC00) <> 0 then exit; 

921 
for i:= max(x  r, 0) to min(x + r, 2043) do 

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

70  924 
end; 
925 

495  926 
var x: LongInt; 
371  927 
y, sy: LongInt; 
386  928 
ar: array[0..511] of TPoint; 
929 
ar2: array[0..1023] of TPoint; 

392  930 
cnt, cnt2: Longword; 
931 
delta: LongInt; 

70  932 
begin 
386  933 
delta:= 250; 
934 
cnt2:= 0; 

16  935 
repeat 
392  936 
x:= Left + LongInt(GetRandom(Delta)); 
70  937 
repeat 
386  938 
inc(x, Delta); 
70  939 
cnt:= 0; 
351  940 
y:= Gear^.Radius * 2; 
70  941 
while y < 1023 do 
16  942 
begin 
70  943 
repeat 
944 
inc(y, 2); 

351  945 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  946 
sy:= y; 
947 
repeat 

948 
inc(y); 

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

70  951 
and (y < 1023) 
351  952 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  953 
begin 
954 
ar[cnt].X:= x; 

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

70  957 
inc(cnt) 
958 
end; 

386  959 
inc(y, 45) 
16  960 
end; 
70  961 
if cnt > 0 then 
962 
with ar[GetRandom(cnt)] do 

963 
begin 

386  964 
ar2[cnt2].x:= x; 
965 
ar2[cnt2].y:= y; 

966 
inc(cnt2) 

70  967 
end 
386  968 
until (x + Delta > Right); 
969 
dec(Delta, 60) 

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

971 
if cnt2 > 0 then 

972 
with ar2[GetRandom(cnt2)] do 

973 
begin 

498  974 
Gear^.X:= int2hwFloat(x); 
975 
Gear^.Y:= int2hwFloat(y); 

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

978 
{$ENDIF} 

979 
end 

980 
else 

981 
begin 

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

983 
DeleteGear(Gear) 

984 
end 

10  985 
end; 
986 

4  987 
initialization 
988 

989 
finalization 

95  990 
FreeGearsList; 
4  991 

992 
end. 