author  unc0rr 
Sat, 29 Sep 2007 16:39:21 +0000  
changeset 614  0e04504bc140 
parent 604  2f1165467a66 
child 621  8bdbc240f50f 
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; 
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; 
293  62 
procedure AddClouds; 
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, 
593  73 
uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos, uTriggers; 
68  74 
var RopePoints: record 
4  75 
Count: Longword; 
371  76 
HookAngle: LongInt; 
4  77 
ar: array[0..300] of record 
351  78 
X, Y: hwFloat; 
79 
dLen: hwFloat; 

4  80 
b: boolean; 
81 
end; 

82 
end; 

307  83 
StepDamage: Longword = 0; 
4  84 

85 
procedure DeleteGear(Gear: PGear); forward; 

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

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

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

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

98 
{$INCLUDE GSHandlers.inc} 

99 
{$INCLUDE HHHandlers.inc} 

100 

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

351  102 
@doStepCloud, 
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); 
139 
var tmp: PGear; 

140 
begin 

141 
if GearsList = nil then 

142 
GearsList:= Gear 

143 
else begin 

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

145 
tmp:= GearsList; 

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

294  148 

351  149 
if tmp^.PrevGear <> nil then tmp^.PrevGear^.NextGear:= Gear; 
150 
Gear^.PrevGear:= tmp^.PrevGear; 

151 
tmp^.PrevGear:= Gear; 

152 
Gear^.NextGear:= tmp; 

294  153 
if GearsList = tmp then GearsList:= Gear 
154 
end 

155 
end; 

156 

157 
procedure RemoveGearFromList(Gear: PGear); 

158 
begin 

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

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

294  164 
end; 
165 
end; 

166 

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

351  178 
Result^.Kind := Kind; 
179 
Result^.State:= State; 

180 
Result^.Active:= true; 

181 
Result^.dX:= dX; 

182 
Result^.dY:= dY; 

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

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

186 

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

188 
begin 
602  189 
Result^.Hedgehog:= CurrentHedgehog; 
190 
Result^.IntersectGear:= CurrentHedgehog^.Gear 

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

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

192 

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

198 
Result^.Friction:= _0_995; 

4  199 
end; 
200 
gtHedgehog: begin 

351  201 
Result^.Radius:= cHHRadius; 
202 
Result^.Elasticity:= _0_35; 

203 
Result^.Friction:= _0_999; 

204 
Result^.Angle:= cMaxAngle div 2; 

205 
Result^.Z:= cHHZ; 

4  206 
end; 
207 
gtAmmo_Grenade: begin 

351  208 
Result^.Radius:= 4; 
4  209 
end; 
210 
gtHealthTag: begin 

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

351  215 
Result^.Radius:= 10; 
216 
Result^.Elasticity:= _0_6; 

4  217 
end; 
218 
gtUFO: begin 

351  219 
Result^.Radius:= 5; 
220 
Result^.Timer:= 500; 

221 
Result^.Elasticity:= _0_9 

4  222 
end; 
223 
gtShotgunShot: begin 

351  224 
Result^.Timer:= 900; 
225 
Result^.Radius:= 2 

4  226 
end; 
227 
gtPickHammer: begin 

351  228 
Result^.Radius:= 10; 
229 
Result^.Timer:= 4000 

4  230 
end; 
231 
gtSmokeTrace: begin 

498  232 
Result^.X:= Result^.X  _16; 
233 
Result^.Y:= Result^.Y  _16; 

351  234 
Result^.State:= 8 
4  235 
end; 
236 
gtRope: begin 

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

9  241 
gtExplosion: begin 
498  242 
Result^.X:= Result^.X  _25; 
243 
Result^.Y:= Result^.Y  _25; 

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

249 
Result^.Friction:= _0_995; 

250 
Result^.Timer:= 3000; 

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

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

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

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

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

263 
Result^.Friction:= _0_03; 

264 
Result^.Timer:= 5000; 

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

269 
Result^.Friction:= _0_995; 

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

274 
Result^.Health:= 2; 

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

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

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

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

283 
Result^.Radius:= 5; 
302  284 
end; 
285 
gtBlowTorch: begin 

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

291 
Result^.Z:= 2000; 

292 
end; 

540  293 
gtSwitcher: begin 
294 
Result^.Z:= cCurrHHZ 

295 
end; 

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

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

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

4  303 
end; 
304 

305 
procedure DeleteGear(Gear: PGear); 

48  306 
var team: PTeam; 
307  307 
t: Longword; 
4  308 
begin 
503  309 
DeleteCI(Gear); 
522  310 
if Gear^.Surf <> nil then 
311 
begin 

312 
SDL_FreeSurface(Gear^.Surf); 

313 
Gear^.Surf:= nil 

314 
end; 

351  315 
if Gear^.Kind = gtHedgehog then 
4  316 
if CurAmmoGear <> nil then 
317 
begin 

351  318 
Gear^.Message:= gm_Destroy; 
319 
CurAmmoGear^.Message:= gm_Destroy; 

4  320 
exit 
47  321 
end else 
322 
begin 

498  323 
if not (hwRound(Gear^.Y) < cWaterLine) then 
307  324 
begin 
351  325 
t:= max(Gear^.Damage, Gear^.Health); 
498  326 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
307  327 
inc(StepDamage, t) 
328 
end; 

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

337 
if Gear^.TriggerId <> 0 then TickTrigger(Gear^.TriggerId); 
82  338 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  339 
if FollowGear = Gear then FollowGear:= nil; 
294  340 
RemoveGearFromList(Gear); 
4  341 
Dispose(Gear) 
342 
end; 

343 

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

345 
var Gear: PGear; 

346 
begin 

351  347 
CheckNoDamage:= true; 
4  348 
Gear:= GearsList; 
349 
while Gear <> nil do 

350 
begin 

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

4  353 
begin 
351  354 
CheckNoDamage:= false; 
355 
inc(StepDamage, Gear^.Damage); 

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

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

498  359 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
351  360 
RenderHealth(PHedgehog(Gear^.Hedgehog)^); 
361 
RecountTeamHealth(PHedgehog(Gear^.Hedgehog)^.Team); 

362 

363 
Gear^.Damage:= 0 

4  364 
end; 
351  365 
Gear:= Gear^.NextGear 
83  366 
end; 
4  367 
end; 
368 

522  369 
procedure AddDamageTag(X, Y, Damage: LongWord; Gear: PGear); 
370 
begin 

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

522  373 
end; 
374 

4  375 
procedure ProcessGears; 
614  376 
const delay: LongWord = 0; 
92
0c359a7a2356
 Fix win message to appear only after all hedgehogs death
unc0rr
parents:
89
diff
changeset

377 
step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay; 
4  378 
var Gear, t: PGear; 
379 
begin 

380 
AllInactive:= true; 

381 
t:= GearsList; 

382 
while t<>nil do 

383 
begin 

384 
Gear:= t; 

351  385 
t:= Gear^.NextGear; 
386 
if Gear^.Active then Gear^.doStep(Gear); 

4  387 
end; 
89  388 

4  389 
if AllInactive then 
15  390 
case step of 
391 
stDelay: begin 

392 
if delay = 0 then 

393 
delay:= cInactDelay 

614  394 
else 
395 
dec(delay); 

396 

397 
if delay = 0 then 

398 
inc(step) 

15  399 
end; 
400 
stChDmg: if CheckNoDamage then inc(step) else step:= stDelay; 

351  401 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
15  402 
stSpawn: begin 
403 
if not isInMultiShoot then SpawnBoxOfSmth; 

404 
inc(step) 

405 
end; 

406 
stNTurn: begin 

351  407 
//AwareOfExplosion(0, 0, 0); 
15  408 
if isInMultiShoot then isInMultiShoot:= false 
307  409 
else begin 
602  410 
with CurrentHedgehog^ do 
307  411 
if MaxStepDamage < StepDamage then MaxStepDamage:= StepDamage; 
412 
StepDamage:= 0; 

351  413 
ParseCommand('/nextturn', true); 
307  414 
end; 
15  415 
step:= Low(step) 
416 
end; 

417 
end; 

418 

4  419 
if TurnTimeLeft > 0 then 
420 
if CurrentTeam <> nil then 

602  421 
if CurrentHedgehog^.Gear <> nil then 
422 
if ((CurrentHedgehog^.Gear^.State and gstAttacking) = 0) 

4  423 
and not isInMultiShoot then dec(TurnTimeLeft); 
351  424 

515  425 
inc(GameTicks) 
4  426 
end; 
427 

428 
procedure SetAllToActive; 

429 
var t: PGear; 

430 
begin 

431 
AllInactive:= false; 

432 
t:= GearsList; 

351  433 
while t <> nil do 
4  434 
begin 
351  435 
t^.Active:= true; 
436 
t:= t^.NextGear 

4  437 
end 
438 
end; 

439 

440 
procedure SetAllHHToActive; 

441 
var t: PGear; 

442 
begin 

443 
AllInactive:= false; 

444 
t:= GearsList; 

351  445 
while t <> nil do 
4  446 
begin 
351  447 
if t^.Kind = gtHedgehog then t^.Active:= true; 
448 
t:= t^.NextGear 

4  449 
end 
450 
end; 

451 

292  452 
procedure DrawHH(Gear: PGear; Surface: PSDL_Surface); 
371  453 
var t: LongInt; 
292  454 
begin 
503  455 
DrawHedgehog(hwRound(Gear^.X)  15 + WorldDx, hwRound(Gear^.Y)  18 + WorldDy, 
351  456 
hwSign(Gear^.dX), 0, 
457 
PHedgehog(Gear^.Hedgehog)^.visStepPos div 2, 

292  458 
Surface); 
459 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

478 
end 
292  479 
end else // Current hedgehog 
538  480 
if (Gear^.State and gstHHDriven) <> 0 then 
292  481 
begin 
351  482 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
483 
DrawSprite(sprFinger, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  64 + WorldDy, 

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

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

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

371  492 
24, (18 + hwSign(Gear^.dX) * LongInt(((Gear^.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18, 
351  493 
Team^.CrosshairSurf, Surface); 
292  494 
end; 
495 
end; 

496 

4  497 
procedure DrawGears(Surface: PSDL_Surface); 
498 
var Gear: PGear; 

499 
i: Longword; 

371  500 
roplen: LongInt; 
4  501 

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

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

366  505 
b: boolean; 
4  506 
begin 
37  507 
if (X1 = X2) and (Y1 = Y2) then 
508 
begin 

351  509 
OutError('WARNING: zero length rope line!', false); 
37  510 
exit 
511 
end; 

366  512 
eX:= 0; 
513 
eY:= 0; 

514 
dX:= X2  X1; 

515 
dY:= Y2  Y1; 

516 

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

518 
else 

519 
if (dX < 0) then 

520 
begin 

521 
sX:= 1; 

522 
dX:= dX 

523 
end else sX:= dX; 

524 

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

526 
else 

527 
if (dY < 0) then 

4  528 
begin 
366  529 
sY:= 1; 
530 
dY:= dY 

531 
end else sY:= dY; 

532 

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

534 
else d:= dY; 

535 

536 
x:= X1; 

537 
y:= Y1; 

538 

539 
for i:= 0 to d do 

540 
begin 

541 
inc(eX, dX); 

542 
inc(eY, dY); 

543 
b:= false; 

544 
if (eX > d) then 

35  545 
begin 
366  546 
dec(eX, d); 
547 
inc(x, sX); 

548 
b:= true 

35  549 
end; 
366  550 
if (eY > d) then 
35  551 
begin 
366  552 
dec(eY, d); 
553 
inc(y, sY); 

554 
b:= true 

35  555 
end; 
366  556 
if b then 
557 
begin 

558 
inc(roplen); 

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

560 
end 

4  561 
end 
366  562 
end; 
4  563 

564 
begin 

565 
Gear:= GearsList; 

566 
while Gear<>nil do 

567 
begin 

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

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

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

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

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

4  577 
gtRope: begin 
35  578 
roplen:= 0; 
4  579 
if RopePoints.Count > 0 then 
580 
begin 

581 
i:= 0; 

582 
while i < Pred(RopePoints.Count) do 

583 
begin 

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

4  586 
inc(i) 
587 
end; 

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

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

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

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

4  593 
end else 
35  594 
begin 
351  595 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
596 
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

597 
DrawSprite(sprRopeHook, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
35  598 
end; 
4  599 
end; 
568  600 
gtSmokeTrace: if Gear^.State < 8 then DrawSprite(sprSmokeTrace, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 
351  601 
gtExplosion: DrawSprite(sprExplosion50, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 
602 
gtMine: if ((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420) 

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

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

605 
gtCase: case Gear^.Pos of 

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

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

42  608 
end; 
568  609 
gtDynamite: DrawSprite2(sprDynamite, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, Gear^.Tag and 1, Gear^.Tag shr 1, Surface); 
351  610 
gtClusterBomb: DrawSprite(sprClusterBomb, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, hwRound(Gear^.DirAngle), Surface); 
611 
gtCluster: DrawSprite(sprClusterParticle, hwRound(Gear^.X)  8 + WorldDx, hwRound(Gear^.Y)  8 + WorldDy, 0, Surface); 

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

568  613 
gtParachute: DrawSprite(sprParachute, hwRound(Gear^.X)  24 + WorldDx, hwRound(Gear^.Y)  48 + WorldDy, 0, Surface); 
408  614 
gtAirAttack: if Gear^.Tag > 0 then DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0, Surface) 
534  615 
else DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 1, Surface); 
568  616 
gtAirBomb: DrawSprite(sprAirBomb , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
534  617 
gtSwitcher: DrawSprite(sprSwitch, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  56 + WorldDy, 0, Surface); 
593  618 
gtTarget: DrawSprite(sprTarget, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, 0, Surface); 
4  619 
end; 
351  620 
Gear:= Gear^.NextGear 
4  621 
end; 
622 
end; 

623 

624 
procedure FreeGearsList; 

625 
var t, tt: PGear; 

626 
begin 

627 
tt:= GearsList; 

628 
GearsList:= nil; 

629 
while tt<>nil do 

630 
begin 

631 
t:= tt; 

351  632 
tt:= tt^.NextGear; 
4  633 
Dispose(t) 
634 
end; 

635 
end; 

636 

10  637 
procedure AddMiscGears; 
371  638 
var i: LongInt; 
4  639 
begin 
498  640 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  641 
if (GameFlags and gfForts) = 0 then 
642 
for i:= 0 to 3 do 

498  643 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  644 
end; 
645 

293  646 
procedure AddClouds; 
371  647 
var i: LongInt; 
360  648 
dx, dy: hwFloat; 
293  649 
begin 
650 
for i:= 0 to cCloudsNumber do 

360  651 
begin 
652 
dx.isNegative:= random(2) = 1; 

653 
dx.QWordValue:= random(214748364); 

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

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

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

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

658 
end 

293  659 
end; 
660 

371  661 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  662 
var Gear: PGear; 
506  663 
dmg, dmgRadius: LongInt; 
4  664 
begin 
665 
TargetPoint.X:= NoPointX; 

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

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

4  671 
Gear:= GearsList; 
672 
while Gear <> nil do 

673 
begin 

506  674 
dmg:= dmgRadius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
538  675 
if (dmg > 1) and 
522  676 
((Gear^.State and gstNoDamage) = 0) then 
4  677 
begin 
355  678 
dmg:= dmg div 2; 
351  679 
case Gear^.Kind of 
10  680 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

681 
gtMine, 
79  682 
gtCase, 
593  683 
gtTarget, 
79  684 
gtFlame: begin 
355  685 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
522  686 
if (Mask and EXPLNoDamage) = 0 then 
687 
begin 

688 
inc(Gear^.Damage, dmg); 

689 
if Gear^.Kind = gtHedgehog then 

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

691 
end; 

351  692 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 
42  693 
begin 
506  694 
DeleteCI(Gear); 
498  695 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
696 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  697 
Gear^.State:= Gear^.State or gstMoving; 
351  698 
Gear^.Active:= true; 
42  699 
FollowGear:= Gear 
700 
end; 

4  701 
end; 
51  702 
gtGrave: begin 
351  703 
Gear^.dY:=  _0_004 * dmg; 
704 
Gear^.Active:= true; 

51  705 
end; 
4  706 
end; 
707 
end; 

351  708 
Gear:= Gear^.NextGear 
80  709 
end; 
506  710 
if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius); 
498  711 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  712 
end; 
713 

506  714 
procedure ShotgunShot(Gear: PGear); 
715 
var t: PGear; 

716 
dmg: integer; 

522  717 
hh: PHedgehog; 
506  718 
begin 
509  719 
Gear^.Radius:= cShotgunRadius; 
522  720 
hh:= Gear^.Hedgehog; 
506  721 
t:= GearsList; 
722 
while t <> nil do 

723 
begin 

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

538  725 
if dmg > 0 then 
506  726 
case t^.Kind of 
727 
gtHedgehog, 

728 
gtMine, 

593  729 
gtCase, 
730 
gtTarget: begin 

506  731 
inc(t^.Damage, dmg); 
522  732 
if t^.Kind = gtHedgehog then 
733 
begin 

531  734 
AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), dmg, t); 
522  735 
inc(hh^.DamageGiven, dmg) 
736 
end; 

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

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

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

741 
t^.Active:= true; 

742 
FollowGear:= t 

743 
end; 

744 
gtGrave: begin 

745 
t^.dY:=  _0_1; 

746 
t^.Active:= true 

747 
end; 

748 
end; 

749 
t:= t^.NextGear 

750 
end; 

509  751 
DrawExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), cShotgunRadius) 
506  752 
end; 
753 

371  754 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  755 
var t: PGearArray; 
371  756 
i: LongInt; 
307  757 
hh: PHedgehog; 
38  758 
begin 
53  759 
t:= CheckGearsCollision(Ammo); 
351  760 
i:= t^.Count; 
761 
hh:= Ammo^.Hedgehog; 

53  762 
while i > 0 do 
763 
begin 

764 
dec(i); 

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

53  767 
gtHedgehog, 
768 
gtMine, 

593  769 
gtTarget, 
53  770 
gtCase: begin 
351  771 
inc(t^.ar[i]^.Damage, Damage); 
522  772 
if t^.ar[i]^.Kind = gtHedgehog then 
773 
begin 

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

775 
inc(hh^.DamageGiven, Damage) 

776 
end; 

538  777 
DeleteCI(t^.ar[i]); 
351  778 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 
779 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

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

503  781 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  782 
FollowGear:= t^.ar[i] 
53  783 
end; 
784 
end 

126  785 
end; 
786 
SetAllToActive 

38  787 
end; 
788 

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

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

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

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

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

796 
t:= 0; 
547  797 
for p:= 0 to Pred(TeamsCount) do 
798 
with TeamsArray[p]^ do 

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

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

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

802 
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

803 
inc(t, 1024); 
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 else // mix hedgehogs 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

807 
Count:= 0; 
547  808 
for p:= 0 to Pred(TeamsCount) do 
809 
with TeamsArray[p]^ do 

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

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

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

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

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

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

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

819 

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

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

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

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

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

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

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

827 
end 
4  828 
end; 
829 

371  830 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  831 
var t: PGear; 
832 
begin 

833 
t:= GearsList; 

834 
rX:= sqr(rX); 

835 
rY:= sqr(rY); 

836 
while t <> nil do 

837 
begin 

351  838 
if (t <> Gear) and (t^.Kind = Kind) then 
498  839 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  840 
exit(t); 
841 
t:= t^.NextGear 

10  842 
end; 
351  843 
CheckGearNear:= nil 
15  844 
end; 
845 

79  846 
procedure AmmoFlameWork(Ammo: PGear); 
847 
var t: PGear; 

848 
begin 

849 
t:= GearsList; 

850 
while t <> nil do 

851 
begin 

351  852 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  853 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  854 
begin 
351  855 
inc(t^.Damage, 5); 
856 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

857 
t^.dY:=  _0_25; 

858 
t^.Active:= true; 

79  859 
DeleteCI(t); 
860 
FollowGear:= t 

861 
end; 

351  862 
t:= t^.NextGear 
79  863 
end; 
864 
end; 

865 

371  866 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  867 
var t: PGear; 
868 
begin 

869 
t:= GearsList; 

870 
rX:= sqr(rX); 

871 
rY:= sqr(rY); 

872 
while t <> nil do 

873 
begin 

351  874 
if t^.Kind in Kind then 
498  875 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  876 
exit(t); 
877 
t:= t^.NextGear 

16  878 
end; 
351  879 
CheckGearsNear:= nil 
16  880 
end; 
881 

882 
function CountGears(Kind: TGearType): Longword; 

883 
var t: PGear; 

351  884 
Result: Longword; 
16  885 
begin 
886 
Result:= 0; 

887 
t:= GearsList; 

888 
while t <> nil do 

889 
begin 

351  890 
if t^.Kind = Kind then inc(Result); 
891 
t:= t^.NextGear 

16  892 
end; 
351  893 
CountGears:= Result 
16  894 
end; 
895 

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

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

898 
i: TAmmoType; 
15  899 
begin 
614  900 
if (cCaseFactor = 0) or 
901 
(CountGears(gtCase) >= 5) or 

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

498  903 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  904 
case getrandom(2) of 
905 
0: begin 

351  906 
FollowGear^.Health:= 25; 
907 
FollowGear^.Pos:= posCaseHealth 

295  908 
end; 
909 
1: begin 

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

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

911 
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

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

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

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

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

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

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

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

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

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

922 
FollowGear^.State:= Longword(i) 
295  923 
end; 
924 
end; 

70  925 
FindPlace(FollowGear, true, 0, 2048) 
926 
end; 

927 

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

371  930 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
931 
var i: LongInt; 

932 
Result: LongInt; 

70  933 
begin 
934 
Result:= 0; 

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

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

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

70  939 
end; 
940 

495  941 
var x: LongInt; 
371  942 
y, sy: LongInt; 
386  943 
ar: array[0..511] of TPoint; 
944 
ar2: array[0..1023] of TPoint; 

392  945 
cnt, cnt2: Longword; 
946 
delta: LongInt; 

70  947 
begin 
386  948 
delta:= 250; 
949 
cnt2:= 0; 

16  950 
repeat 
392  951 
x:= Left + LongInt(GetRandom(Delta)); 
70  952 
repeat 
386  953 
inc(x, Delta); 
70  954 
cnt:= 0; 
351  955 
y:= Gear^.Radius * 2; 
70  956 
while y < 1023 do 
16  957 
begin 
70  958 
repeat 
959 
inc(y, 2); 

351  960 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  961 
sy:= y; 
962 
repeat 

963 
inc(y); 

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

70  966 
and (y < 1023) 
351  967 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  968 
begin 
969 
ar[cnt].X:= x; 

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

70  972 
inc(cnt) 
973 
end; 

386  974 
inc(y, 45) 
16  975 
end; 
70  976 
if cnt > 0 then 
977 
with ar[GetRandom(cnt)] do 

978 
begin 

386  979 
ar2[cnt2].x:= x; 
980 
ar2[cnt2].y:= y; 

981 
inc(cnt2) 

70  982 
end 
386  983 
until (x + Delta > Right); 
984 
dec(Delta, 60) 

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

986 
if cnt2 > 0 then 

987 
with ar2[GetRandom(cnt2)] do 

988 
begin 

498  989 
Gear^.X:= int2hwFloat(x); 
990 
Gear^.Y:= int2hwFloat(y); 

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

993 
{$ENDIF} 

994 
end 

995 
else 

996 
begin 

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

998 
DeleteGear(Gear) 

999 
end 

10  1000 
end; 
1001 

4  1002 
initialization 
1003 

1004 
finalization 

95  1005 
FreeGearsList; 
4  1006 

1007 
end. 