author  unc0rr 
Sun, 21 Jan 2007 19:51:02 +0000  
changeset 351  29bc9c36ad5f 
parent 307  96b428ac11f2 
child 355  40c68869899e 
permissions  rwrr 
4  1 
(* 
2 
* Hedgewars, a wormslike game 

47  3 
* Copyright (c) 2004, 2005, 2006 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; 
53  38 
Radius: integer; 
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; 

38  46 
Health, Damage: integer; 
4  47 
CollIndex: Longword; 
6  48 
Tag: integer; 
95  49 
Surf: PSDL_Surface; 
293  50 
Z: Longword; 
4  51 
end; 
52 

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

56 
procedure SetAllHHToActive; 

57 
procedure DrawGears(Surface: PSDL_Surface); 

58 
procedure FreeGearsList; 

10  59 
procedure AddMiscGears; 
293  60 
procedure AddClouds; 
4  61 
procedure AssignHHCoords; 
294  62 
procedure InsertGearToList(Gear: PGear); 
63 
procedure RemoveGearFromList(Gear: PGear); 

4  64 

65 
var CurAmmoGear: PGear = nil; 

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

4  69 
implementation 
81  70 
uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, 
295  71 
uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI, uAmmos; 
68  72 
var RopePoints: record 
4  73 
Count: Longword; 
74 
HookAngle: integer; 

75 
ar: array[0..300] of record 

351  76 
X, Y: hwFloat; 
77 
dLen: hwFloat; 

4  78 
b: boolean; 
79 
end; 

80 
end; 

307  81 
StepDamage: Longword = 0; 
4  82 

83 
procedure DeleteGear(Gear: PGear); forward; 

84 
procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward; 

75  85 
procedure AmmoShove(Ammo: PGear; Damage, Power: integer); forward; 
79  86 
procedure AmmoFlameWork(Ammo: PGear); forward; 
17  87 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; forward; 
15  88 
procedure SpawnBoxOfSmth; forward; 
32
78bff13b11c0
With this patch the game doesn't crash when gaming by net
unc0rr
parents:
24
diff
changeset

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

92 
procedure HedgehogChAngle(Gear: PGear); forward; 
4  93 

94 
{$INCLUDE GSHandlers.inc} 

95 
{$INCLUDE HHHandlers.inc} 

96 

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

351  98 
@doStepCloud, 
99 
@doStepBomb, 

100 
@doStepHedgehog, 

101 
@doStepGrenade, 

102 
@doStepHealthTag, 

103 
@doStepGrave, 

104 
@doStepUFO, 

105 
@doStepShotgunShot, 

106 
@doStepPickHammer, 

107 
@doStepRope, 

108 
@doStepSmokeTrace, 

109 
@doStepExplosion, 

110 
@doStepMine, 

111 
@doStepCase, 

112 
@doStepDEagleShot, 

113 
@doStepDynamite, 

114 
@doStepTeamHealthSorter, 

115 
@doStepBomb, 

116 
@doStepCluster, 

117 
@doStepShover, 

118 
@doStepFlame, 

119 
@doStepFirePunch, 

120 
@doStepActionTimer, 

121 
@doStepActionTimer, 

122 
@doStepActionTimer, 

123 
@doStepParachute, 

124 
@doStepAirAttack, 

125 
@doStepAirBomb, 

126 
@doStepBlowTorch 

4  127 
); 
128 

294  129 
procedure InsertGearToList(Gear: PGear); 
130 
var tmp: PGear; 

131 
begin 

132 
if GearsList = nil then 

133 
GearsList:= Gear 

134 
else begin 

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

136 
tmp:= GearsList; 

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

294  139 

351  140 
if tmp^.PrevGear <> nil then tmp^.PrevGear^.NextGear:= Gear; 
141 
Gear^.PrevGear:= tmp^.PrevGear; 

142 
tmp^.PrevGear:= Gear; 

143 
Gear^.NextGear:= tmp; 

294  144 
if GearsList = tmp then GearsList:= Gear 
145 
end 

146 
end; 

147 

148 
procedure RemoveGearFromList(Gear: PGear); 

149 
begin 

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

294  152 
else begin 
351  153 
GearsList:= Gear^.NextGear; 
154 
if GearsList <> nil then GearsList^.PrevGear:= nil 

294  155 
end; 
156 
end; 

157 

351  158 
function AddGear(X, Y: integer; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear; 
79  159 
const Counter: Longword = 0; 
351  160 
var Result: PGear; 
4  161 
begin 
79  162 
inc(Counter); 
108  163 
{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+'), d('+floattostr(dX)+','+floattostr(dY)+')');{$ENDIF} 
4  164 
New(Result); 
293  165 
{$IFDEF DEBUGFILE}AddFileLog('AddGear: type = '+inttostr(ord(Kind))+'; handle = '+inttostr(integer(Result)));{$ENDIF} 
4  166 
FillChar(Result^, sizeof(TGear), 0); 
351  167 
Result^.X:= X; 
168 
Result^.Y:= Y; 

169 
Result^.Kind := Kind; 

170 
Result^.State:= State; 

171 
Result^.Active:= true; 

172 
Result^.dX:= dX; 

173 
Result^.dY:= dY; 

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

175 
Result^.CollIndex:= High(Longword); 

176 
Result^.Timer:= Timer; 

4  177 
if CurrentTeam <> nil then 
351  178 
Result^.Hedgehog:= @(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]); 
4  179 
case Kind of 
351  180 
gtCloud: Result^.Z:= High(Result^.Z); 
4  181 
gtAmmo_Bomb: begin 
351  182 
Result^.Radius:= 4; 
183 
Result^.Elasticity:= _0_6; 

184 
Result^.Friction:= _0_995; 

4  185 
end; 
186 
gtHedgehog: begin 

351  187 
Result^.Radius:= cHHRadius; 
188 
Result^.Elasticity:= _0_35; 

189 
Result^.Friction:= _0_999; 

190 
Result^.Angle:= cMaxAngle div 2; 

191 
Result^.Z:= cHHZ; 

4  192 
end; 
193 
gtAmmo_Grenade: begin 

351  194 
Result^.Radius:= 4; 
4  195 
end; 
196 
gtHealthTag: begin 

351  197 
Result^.Timer:= 1500; 
198 
Result^.Z:= 2000; 

4  199 
end; 
200 
gtGrave: begin 

351  201 
Result^.Radius:= 10; 
202 
Result^.Elasticity:= _0_6; 

4  203 
end; 
204 
gtUFO: begin 

351  205 
Result^.Radius:= 5; 
206 
Result^.Timer:= 500; 

207 
Result^.Elasticity:= _0_9 

4  208 
end; 
209 
gtShotgunShot: begin 

351  210 
Result^.Timer:= 900; 
211 
Result^.Radius:= 2 

4  212 
end; 
213 
gtPickHammer: begin 

351  214 
Result^.Radius:= 10; 
215 
Result^.Timer:= 4000 

4  216 
end; 
217 
gtSmokeTrace: begin 

351  218 
Result^.X:= Result^.X  16; 
219 
Result^.Y:= Result^.Y  16; 

220 
Result^.State:= 8 

4  221 
end; 
222 
gtRope: begin 

351  223 
Result^.Radius:= 3; 
224 
Result^.Friction:= 500; 

4  225 
RopePoints.Count:= 0; 
226 
end; 

9  227 
gtExplosion: begin 
351  228 
Result^.X:= Result^.X  25; 
229 
Result^.Y:= Result^.Y  25; 

9  230 
end; 
10  231 
gtMine: begin 
351  232 
Result^.Radius:= 3; 
233 
Result^.Elasticity:= _0_55; 

234 
Result^.Friction:= _0_995; 

235 
Result^.Timer:= 3000; 

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

237 
gtCase: begin 
351  238 
Result^.Radius:= 16; 
239 
Result^.Elasticity:= _0_4 

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

240 
end; 
37  241 
gtDEagleShot: begin 
351  242 
Result^.Radius:= 1; 
243 
Result^.Radius:= 1; 

244 
Result^.Health:= 50 

37  245 
end; 
39  246 
gtDynamite: begin 
351  247 
Result^.Radius:= 3; 
248 
Result^.Elasticity:= _0_55; 

249 
Result^.Friction:= _0_03; 

250 
Result^.Timer:= 5000; 

39  251 
end; 
78  252 
gtClusterBomb: begin 
351  253 
Result^.Radius:= 4; 
254 
Result^.Elasticity:= _0_6; 

255 
Result^.Friction:= _0_995; 

78  256 
end; 
79  257 
gtFlame: begin 
351  258 
Result^.Angle:= Counter mod 64; 
259 
Result^.Radius:= 1; 

260 
Result^.Health:= 2; 

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

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

79  263 
end; 
82  264 
gtFirePunch: begin 
351  265 
Result^.Radius:= 15; 
266 
Result^.Tag:= Y 

82  267 
end; 
302  268 
gtAirBomb: begin 
351  269 
Result^.Radius:= 10; 
302  270 
end; 
271 
gtBlowTorch: begin 

351  272 
Result^.Radius:= cHHRadius; 
273 
Result^.Timer:= 7500; 

302  274 
end; 
4  275 
end; 
351  276 
InsertGearToList(Result); 
277 
AddGear:= Result 

4  278 
end; 
279 

280 
procedure DeleteGear(Gear: PGear); 

48  281 
var team: PTeam; 
307  282 
t: Longword; 
4  283 
begin 
351  284 
if Gear^.CollIndex < High(Longword) then DeleteCI(Gear); 
285 
if Gear^.Surf <> nil then SDL_FreeSurface(Gear^.Surf); 

286 
if Gear^.Kind = gtHedgehog then 

4  287 
if CurAmmoGear <> nil then 
288 
begin 

289 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: Sending gm_Destroy, hh handle = '+inttostr(integer(Gear)));{$ENDIF} 

351  290 
Gear^.Message:= gm_Destroy; 
291 
CurAmmoGear^.Message:= gm_Destroy; 

4  292 
exit 
47  293 
end else 
294 
begin 

351  295 
if not (Gear^.Y < cWaterLine) then 
307  296 
begin 
351  297 
t:= max(Gear^.Damage, Gear^.Health); 
298 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtHealthTag, t, 0, 0, 0)^.Hedgehog:= Gear^.Hedgehog; 

307  299 
inc(StepDamage, t) 
300 
end; 

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

145  303 
FreeActionsList; // to avoid ThinkThread on drawned gear 
351  304 
PHedgehog(Gear^.Hedgehog)^.Gear:= nil; 
307  305 
inc(KilledHHs); 
48  306 
RecountTeamHealth(team); 
47  307 
end; 
95  308 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF} 
82  309 
if CurAmmoGear = Gear then CurAmmoGear:= nil; 
4  310 
if FollowGear = Gear then FollowGear:= nil; 
294  311 
RemoveGearFromList(Gear); 
4  312 
Dispose(Gear) 
313 
end; 

314 

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

316 
var Gear: PGear; 

317 
begin 

351  318 
CheckNoDamage:= true; 
4  319 
Gear:= GearsList; 
320 
while Gear <> nil do 

321 
begin 

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

4  324 
begin 
351  325 
CheckNoDamage:= false; 
326 
inc(StepDamage, Gear^.Damage); 

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

328 
else dec(Gear^.Health, Gear^.Damage); 

329 
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y)  cHHRadius  12  PHedgehog(Gear^.Hedgehog)^.HealthTag^.h, 

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

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

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

333 

334 
Gear^.Damage:= 0 

4  335 
end; 
351  336 
Gear:= Gear^.NextGear 
83  337 
end; 
4  338 
end; 
339 

340 
procedure ProcessGears; 

341 
const delay: integer = cInactDelay; 

92
0c359a7a2356
 Fix win message to appear only after all hedgehogs death
unc0rr
parents:
89
diff
changeset

342 
step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay; 
4  343 
var Gear, t: PGear; 
344 
{$IFDEF COUNTTICKS} 

345 
tickcntA, tickcntB: LongWord; 

346 
const cntSecTicks: LongWord = 0; 

347 
{$ENDIF} 

348 
begin 

349 
{$IFDEF COUNTTICKS} 

350 
asm 

351 
push eax 

352 
push edx 

353 
rdtsc 

354 
mov tickcntA, eax 

355 
mov tickcntB, edx 

356 
pop edx 

357 
pop eax 

358 
end; 

359 
{$ENDIF} 

360 
AllInactive:= true; 

361 
t:= GearsList; 

362 
while t<>nil do 

363 
begin 

364 
Gear:= t; 

351  365 
t:= Gear^.NextGear; 
366 
if Gear^.Active then Gear^.doStep(Gear); 

4  367 
end; 
89  368 

4  369 
if AllInactive then 
15  370 
case step of 
371 
stDelay: begin 

372 
dec(delay); 

373 
if delay = 0 then 

374 
begin 

375 
inc(step); 

376 
delay:= cInactDelay 

377 
end 

378 
end; 

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

351  380 
stChWin: if not CheckForWin then inc(step) else step:= stDelay; 
15  381 
stSpawn: begin 
382 
if not isInMultiShoot then SpawnBoxOfSmth; 

383 
inc(step) 

384 
end; 

385 
stNTurn: begin 

351  386 
//AwareOfExplosion(0, 0, 0); 
15  387 
if isInMultiShoot then isInMultiShoot:= false 
307  388 
else begin 
351  389 
with CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog] do 
307  390 
if MaxStepDamage < StepDamage then MaxStepDamage:= StepDamage; 
391 
StepDamage:= 0; 

351  392 
ParseCommand('/nextturn', true); 
307  393 
end; 
15  394 
step:= Low(step) 
395 
end; 

396 
end; 

397 

4  398 
if TurnTimeLeft > 0 then 
399 
if CurrentTeam <> nil then 

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

4  402 
and not isInMultiShoot then dec(TurnTimeLeft); 
351  403 

4  404 
inc(GameTicks); 
405 
{$IFDEF COUNTTICKS} 

406 
asm 

407 
push eax 

408 
push edx 

409 
rdtsc 

410 
sub eax, [tickcntA] 

411 
sbb edx, [tickcntB] 

412 
add [cntSecTicks], eax 

413 
pop edx 

414 
pop eax 

415 
end; 

416 
if (GameTicks and 1023) = 0 then 

417 
begin 

418 
cntTicks:= cntSecTicks shr 10; 

419 
{$IFDEF DEBUGFILE} 

420 
AddFileLog('<' + inttostr(cntTicks) + '>x1024 ticks'); 

421 
{$ENDIF} 

422 
cntSecTicks:= 0 

423 
end; 

424 
{$ENDIF} 

425 
end; 

426 

427 
procedure SetAllToActive; 

428 
var t: PGear; 

429 
begin 

430 
AllInactive:= false; 

431 
t:= GearsList; 

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

4  436 
end 
437 
end; 

438 

439 
procedure SetAllHHToActive; 

440 
var t: PGear; 

441 
begin 

442 
AllInactive:= false; 

443 
t:= GearsList; 

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

4  448 
end 
449 
end; 

450 

292  451 
procedure DrawHH(Gear: PGear; Surface: PSDL_Surface); 
452 
var t: integer; 

453 
begin 

351  454 
DrawHedgehog(hwRound(Gear^.X)  14 + WorldDx, hwRound(Gear^.Y)  18 + WorldDy, 
455 
hwSign(Gear^.dX), 0, 

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

292  457 
Surface); 
458 

351  459 
with PHedgehog(Gear^.Hedgehog)^ do 
460 
if Gear^.State = 0 then 

292  461 
begin 
351  462 
t:= hwRound(Gear^.Y)  cHHRadius  10 + WorldDy; 
463 
dec(t, HealthTag^.h + 2); 

464 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, HealthTag, Surface); 

465 
dec(t, NameTag^.h + 2); 

466 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, NameTag, Surface); 

467 
dec(t, Team^.NameTag^.h + 2); 

468 
DrawCentered(hwRound(Gear^.X) + WorldDx, t, Team^.NameTag, Surface) 

292  469 
end else // Current hedgehog 
470 
begin 

351  471 
if bShowFinger and ((Gear^.State and gstHHDriven) <> 0) then 
472 
DrawSprite(sprFinger, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  64 + WorldDy, 

292  473 
GameTicks div 32 mod 16, Surface); 
351  474 
if (Gear^.State and (gstMoving or gstDrowning or gstFalling)) = 0 then 
475 
if (Gear^.State and gstHHThinking) <> 0 then 

476 
DrawGear(sQuestion, hwRound(Gear^.X)  10 + WorldDx, hwRound(Gear^.Y)  cHHRadius  34 + WorldDy, Surface) 

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

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

481 
24, (18 + hwSign(Gear^.dX) * integer(((Gear^.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18, 

482 
Team^.CrosshairSurf, Surface); 

292  483 
end; 
484 
end; 

485 

4  486 
procedure DrawGears(Surface: PSDL_Surface); 
487 
var Gear: PGear; 

488 
i: Longword; 

351  489 
roplen: hwFloat; 
4  490 

491 
procedure DrawRopeLine(X1, Y1, X2, Y2: integer); 

35  492 
const nodlen = 5; 
493 
var i, x, y: integer; 

351  494 
t, k, ladd: hwFloat; 
4  495 
begin 
37  496 
if (X1 = X2) and (Y1 = Y2) then 
497 
begin 

351  498 
OutError('WARNING: zero length rope line!', false); 
37  499 
exit 
500 
end; 

351  501 
{ if abs(X1  X2) > abs(Y1  Y2) then 
4  502 
begin 
503 
if X1 > X2 then 

504 
begin 

505 
i:= X1; 

506 
X1:= X2; 

507 
X2:= i; 

508 
i:= Y1; 

509 
Y1:= Y2; 

510 
Y2:= i 

511 
end; 

512 
k:= (Y2  Y1) / (X2  X1); 

35  513 
ladd:= sqrt(1 + sqr(k)); 
4  514 
if X1 < 0 then 
515 
begin 

516 
t:= Y1  2  k * X1; 

517 
X1:= 0 

518 
end else t:= Y1  2; 

519 
if X2 > cScreenWidth then X2:= cScreenWidth; 

35  520 
for x:= X1 to X2 do 
521 
begin 

522 
roplen:= roplen + ladd; 

523 
if roplen > nodlen then 

524 
begin 

525 
DrawGear(sRopeNode, x  2, round(t)  2, Surface); 

526 
roplen:= roplen  nodlen; 

527 
end; 

528 
t:= t + k; 

529 
end; 

4  530 
end else 
531 
begin 

532 
if Y1 > Y2 then 

533 
begin 

534 
i:= X1; 

535 
X1:= X2; 

536 
X2:= i; 

537 
i:= Y1; 

538 
Y1:= Y2; 

539 
Y2:= i 

540 
end; 

541 
k:= (X2  X1) / (Y2  Y1); 

35  542 
ladd:= sqrt(1 + sqr(k)); 
4  543 
if Y1 < 0 then 
544 
begin 

545 
t:= X1  2  k * Y1; 

546 
Y1:= 0 

547 
end else t:= X1  2; 

548 
if Y2 > cScreenHeight then Y2:= cScreenHeight; 

35  549 
for y:= Y1 to Y2 do 
550 
begin 

551 
roplen:= roplen + ladd; 

552 
if roplen > nodlen then 

553 
begin 

554 
DrawGear(sRopeNode, round(t)  2, y  2, Surface); 

555 
roplen:= roplen  nodlen; 

556 
end; 

557 
t:= t + k; 

558 
end; 

4  559 
end 
351  560 
} end; 
4  561 

562 
begin 

563 
Gear:= GearsList; 

564 
while Gear<>nil do 

565 
begin 

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

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

292  569 
gtHedgehog: DrawHH(Gear, Surface); 
351  570 
gtAmmo_Grenade: DrawSprite(sprGrenade , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY.QWordValue, Gear^.dX.QWordValue), Surface); 
571 
gtHealthTag: if Gear^.Surf <> nil then DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Surf, Surface); 

572 
gtGrave: DrawSpriteFromRect(PHedgehog(Gear^.Hedgehog)^.Team^.GraveRect, hwRound(Gear^.X) + WorldDx  16, hwRound(Gear^.Y) + WorldDy  16, 32, (GameTicks shr 7) and 7, Surface); 

573 
gtUFO: DrawSprite(sprUFO, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, (GameTicks shr 7) mod 4, Surface); 

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

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

579 
i:= 0; 

580 
while i < Pred(RopePoints.Count) do 

581 
begin 

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

4  584 
inc(i) 
585 
end; 

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

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); 

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

4  591 
end else 
35  592 
begin 
351  593 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
594 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

595 
DrawSprite(sprRopeHook, hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY.QWordValue, Gear^.dX.QWordValue), Surface); 

35  596 
end; 
4  597 
end; 
351  598 
gtExplosion: DrawSprite(sprExplosion50, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.State, Surface); 
599 
gtMine: if ((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420) 

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

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

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

603 
gtCase: case Gear^.Pos of 

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

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

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

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

610 
gtAirBomb: DrawSprite(sprAirBomb , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY.QWordValue, Gear^.dX.QWordValue), Surface); 

611 
gtAirAttack: DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0, Surface); 

4  612 
end; 
351  613 
Gear:= Gear^.NextGear 
4  614 
end; 
615 
end; 

616 

617 
procedure FreeGearsList; 

618 
var t, tt: PGear; 

619 
begin 

620 
tt:= GearsList; 

621 
GearsList:= nil; 

622 
while tt<>nil do 

623 
begin 

624 
t:= tt; 

351  625 
tt:= tt^.NextGear; 
4  626 
Dispose(t) 
627 
end; 

628 
end; 

629 

10  630 
procedure AddMiscGears; 
70  631 
var i: integer; 
4  632 
begin 
83  633 
AddGear(0, 0, gtATStartGame, 0, 0, 0, 2000); 
22  634 
if (GameFlags and gfForts) = 0 then 
635 
for i:= 0 to 3 do 

351  636 
FindPlace(AddGear(0, 0, gtMine, 0, 0, 0, 0), false, 0, 2048); 
4  637 
end; 
638 

293  639 
procedure AddClouds; 
640 
var i: integer; 

641 
begin 

642 
for i:= 0 to cCloudsNumber do 

643 
AddGear(  cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), 140, gtCloud, random(4), 

351  644 
// (0.5random)*0.1, ((i mod 2) * 2  1) * (0.005 + 0.015*random), 0) 
645 
0, 0, 0) 

293  646 
end; 
647 

4  648 
procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); 
649 
var Gear: PGear; 

650 
dmg: integer; 

651 
begin 

652 
TargetPoint.X:= NoPointX; 

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

305  654 
if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius); 
351  655 
if Radius = 50 then AddGear(X, Y, gtExplosion, 0, 0, 0, 0); 
656 
if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion, false); 

4  657 
if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1; 
658 
Gear:= GearsList; 

659 
while Gear <> nil do 

660 
begin 

351  661 
dmg:= Radius  hwRound(Distance(Gear^.X  X, Gear^.Y  Y)); 
4  662 
if dmg > 0 then 
663 
begin 

664 
dmg:= dmg shr 1; 

351  665 
case Gear^.Kind of 
10  666 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

667 
gtMine, 
79  668 
gtCase, 
669 
gtFlame: begin 

351  670 
if (Mask and EXPLNoDamage) = 0 then inc(Gear^.Damage, dmg); 
671 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 

42  672 
begin 
351  673 
Gear^.dX:= Gear^.dX + (_0_005 * dmg + cHHKick)* hwSign(Gear^.X  X); 
674 
Gear^.dY:= Gear^.dY + (_0_005 * dmg + cHHKick)* hwSign(Gear^.Y  Y); 

675 
Gear^.Active:= true; 

42  676 
FollowGear:= Gear 
677 
end; 

4  678 
end; 
51  679 
gtGrave: begin 
351  680 
Gear^.dY:=  _0_004 * dmg; 
681 
Gear^.Active:= true; 

51  682 
end; 
4  683 
end; 
684 
end; 

351  685 
Gear:= Gear^.NextGear 
80  686 
end; 
351  687 
//uAIMisc.AwareOfExplosion(0, 0, 0) 
4  688 
end; 
689 

75  690 
procedure AmmoShove(Ammo: PGear; Damage, Power: integer); 
53  691 
var t: PGearArray; 
692 
i: integer; 

307  693 
hh: PHedgehog; 
38  694 
begin 
53  695 
t:= CheckGearsCollision(Ammo); 
351  696 
i:= t^.Count; 
697 
hh:= Ammo^.Hedgehog; 

53  698 
while i > 0 do 
699 
begin 

700 
dec(i); 

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

53  703 
gtHedgehog, 
704 
gtMine, 

705 
gtCase: begin 

351  706 
inc(t^.ar[i]^.Damage, Damage); 
707 
inc(hh^.DamageGiven, Damage); 

708 
t^.ar[i]^.dX:= Ammo^.dX * Power * _0_01; 

709 
t^.ar[i]^.dY:= Ammo^.dY * Power * _0_01; 

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

711 
DeleteCI(t^.ar[i]); 

712 
FollowGear:= t^.ar[i] 

53  713 
end; 
714 
end 

126  715 
end; 
716 
SetAllToActive 

38  717 
end; 
718 

4  719 
procedure AssignHHCoords; 
82  720 
var Team: PTeam; 
721 
i, t: integer; 

4  722 
begin 
82  723 
Team:= TeamsList; 
724 
t:= 0; 

725 
while Team <> nil do 

4  726 
begin 
82  727 
for i:= 0 to cMaxHHIndex do 
351  728 
with Team^.Hedgehogs[i] do 
82  729 
if Gear <> nil then 
730 
if (GameFlags and gfForts) = 0 then FindPlace(Gear, false, 0, 2048) 

731 
else FindPlace(Gear, false, t, t + 1024); 

732 
inc(t, 1024); 

351  733 
Team:= Team^.Next 
4  734 
end 
735 
end; 

736 

15  737 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; 
10  738 
var t: PGear; 
739 
begin 

740 
t:= GearsList; 

741 
rX:= sqr(rX); 

742 
rY:= sqr(rY); 

743 
while t <> nil do 

744 
begin 

351  745 
if (t <> Gear) and (t^.Kind = Kind) then 
746 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > 1) then 

747 
exit(t); 

748 
t:= t^.NextGear 

10  749 
end; 
351  750 
CheckGearNear:= nil 
15  751 
end; 
752 

79  753 
procedure AmmoFlameWork(Ammo: PGear); 
754 
var t: PGear; 

755 
begin 

756 
t:= GearsList; 

757 
while t <> nil do 

758 
begin 

351  759 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
760 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  cHHRadius) * 2 > 2) then 

79  761 
begin 
351  762 
inc(t^.Damage, 5); 
763 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

764 
t^.dY:=  _0_25; 

765 
t^.Active:= true; 

79  766 
DeleteCI(t); 
767 
FollowGear:= t 

768 
end; 

351  769 
t:= t^.NextGear 
79  770 
end; 
771 
end; 

772 

16  773 
function CheckGearsNear(mX, mY: integer; Kind: TGearsType; rX, rY: integer): PGear; 
774 
var t: PGear; 

775 
begin 

776 
t:= GearsList; 

777 
rX:= sqr(rX); 

778 
rY:= sqr(rY); 

779 
while t <> nil do 

780 
begin 

351  781 
if t^.Kind in Kind then 
782 
if not (hwSqr(mX  t^.X) / rX + hwSqr(mY  t^.Y) / rY > 1) then 

783 
exit(t); 

784 
t:= t^.NextGear 

16  785 
end; 
351  786 
CheckGearsNear:= nil 
16  787 
end; 
788 

789 
function CountGears(Kind: TGearType): Longword; 

790 
var t: PGear; 

351  791 
Result: Longword; 
16  792 
begin 
793 
Result:= 0; 

794 
t:= GearsList; 

795 
while t <> nil do 

796 
begin 

351  797 
if t^.Kind = Kind then inc(Result); 
798 
t:= t^.NextGear 

16  799 
end; 
351  800 
CountGears:= Result 
16  801 
end; 
802 

15  803 
procedure SpawnBoxOfSmth; 
804 
begin 

295  805 
if (CountGears(gtCase) >= 5) or (getrandom(cCaseFactor) <> 0) then exit; 
351  806 
FollowGear:= AddGear(0, 0, gtCase, 0, 0, 0, 0); 
295  807 
case getrandom(2) of 
808 
0: begin 

351  809 
FollowGear^.Health:= 25; 
810 
FollowGear^.Pos:= posCaseHealth 

295  811 
end; 
812 
1: begin 

351  813 
FollowGear^.Pos:= posCaseAmmo; 
814 
FollowGear^.State:= Longword(amMineStrike) 

295  815 
end; 
816 
end; 

70  817 
FindPlace(FollowGear, true, 0, 2048) 
818 
end; 

819 

820 
procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer); 

821 

822 
function CountNonZeroz(x, y, r: integer): integer; 

823 
var i: integer; 

351  824 
Result: integer; 
70  825 
begin 
826 
Result:= 0; 

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

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

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

70  831 
end; 
832 

833 
var fx, x: integer; 

834 
y, sy: integer; 

835 
ar: array[0..512] of TPoint; 

836 
cnt, delta: Longword; 

837 
begin 

838 
fx:= Left + integer(GetRandom(Right  Left)); 

839 
x:= fx; 

840 
delta:= 130; 

16  841 
repeat 
70  842 
repeat 
351  843 
inc(x, Gear^.Radius); 
70  844 
if x > Right then x:= Left + (x mod (Right  left)); 
845 
cnt:= 0; 

351  846 
y:= Gear^.Radius * 2; 
70  847 
while y < 1023 do 
16  848 
begin 
70  849 
repeat 
850 
inc(y, 2); 

351  851 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  852 
sy:= y; 
853 
repeat 

854 
inc(y); 

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

70  857 
and (y < 1023) 
351  858 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  859 
begin 
860 
ar[cnt].X:= x; 

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

70  863 
inc(cnt) 
864 
end; 

865 
inc(y, 80) 

16  866 
end; 
70  867 
if cnt > 0 then 
868 
with ar[GetRandom(cnt)] do 

869 
begin 

351  870 
Gear^.X:= x; 
871 
Gear^.Y:= y; 

70  872 
{$IFDEF DEBUGFILE} 
873 
AddFileLog('Assigned Gear ' + inttostr(integer(Gear)) + 

874 
' coordinates (' + inttostr(x) + 

875 
',' + inttostr(y) + ')'); 

876 
{$ENDIF} 

877 
exit 

878 
end 

351  879 
until (x  Gear^.Radius < fx) and (x + Gear^.Radius > fx); 
70  880 
dec(Delta, 20) 
881 
until (Delta < 70); 

882 
OutError('Couldn''t find place for Gear ' + inttostr(integer(Gear)), false); 

883 
DeleteGear(Gear) 

10  884 
end; 
885 

4  886 
initialization 
887 

888 
finalization 

95  889 
FreeGearsList; 
4  890 

891 
end. 