author  unc0rr 
Wed, 02 May 2007 18:41:44 +0000  
changeset 503  2cfdc4bfc2be 
parent 498  9c8b385dc9a1 
child 505  fcba7d7aea0d 
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; 
4  47 
CollIndex: Longword; 
371  48 
Tag: LongInt; 
95  49 
Surf: PSDL_Surface; 
293  50 
Z: Longword; 
4  51 
end; 
52 

371  53 
function AddGear(X, Y: LongInt; 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; 
371  74 
HookAngle: LongInt; 
4  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; 

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

79  86 
procedure AmmoFlameWork(Ammo: PGear); forward; 
371  87 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): 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; 
371  90 
procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: LongInt); 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, 

409  126 
@doStepBlowTorch, 
127 
@doStepGirder 

4  128 
); 
129 

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

132 
begin 

133 
if GearsList = nil then 

134 
GearsList:= Gear 

135 
else begin 

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

137 
tmp:= GearsList; 

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

294  140 

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

143 
tmp^.PrevGear:= Gear; 

144 
Gear^.NextGear:= tmp; 

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

147 
end; 

148 

149 
procedure RemoveGearFromList(Gear: PGear); 

150 
begin 

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

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

294  156 
end; 
157 
end; 

158 

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

351  170 
Result^.Kind := Kind; 
171 
Result^.State:= State; 

172 
Result^.Active:= true; 

173 
Result^.dX:= dX; 

174 
Result^.dY:= dY; 

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

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

177 
Result^.Timer:= Timer; 

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

185 
Result^.Friction:= _0_995; 

4  186 
end; 
187 
gtHedgehog: begin 

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

190 
Result^.Friction:= _0_999; 

191 
Result^.Angle:= cMaxAngle div 2; 

192 
Result^.Z:= cHHZ; 

4  193 
end; 
194 
gtAmmo_Grenade: begin 

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

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

4  200 
end; 
201 
gtGrave: begin 

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

4  204 
end; 
205 
gtUFO: begin 

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

208 
Result^.Elasticity:= _0_9 

4  209 
end; 
210 
gtShotgunShot: begin 

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

4  213 
end; 
214 
gtPickHammer: begin 

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

4  217 
end; 
218 
gtSmokeTrace: begin 

498  219 
Result^.X:= Result^.X  _16; 
220 
Result^.Y:= Result^.Y  _16; 

351  221 
Result^.State:= 8 
4  222 
end; 
223 
gtRope: begin 

351  224 
Result^.Radius:= 3; 
498  225 
Result^.Friction:= _450; 
4  226 
RopePoints.Count:= 0; 
227 
end; 

9  228 
gtExplosion: begin 
498  229 
Result^.X:= Result^.X  _25; 
230 
Result^.Y:= Result^.Y  _25; 

9  231 
end; 
10  232 
gtMine: begin 
503  233 
Result^.State:= Result^.State or gstMoving; 
351  234 
Result^.Radius:= 3; 
235 
Result^.Elasticity:= _0_55; 

236 
Result^.Friction:= _0_995; 

237 
Result^.Timer:= 3000; 

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

239 
gtCase: begin 
351  240 
Result^.Radius:= 16; 
241 
Result^.Elasticity:= _0_4 

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

242 
end; 
37  243 
gtDEagleShot: begin 
351  244 
Result^.Radius:= 1; 
245 
Result^.Health:= 50 

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

250 
Result^.Friction:= _0_03; 

251 
Result^.Timer:= 5000; 

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

256 
Result^.Friction:= _0_995; 

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

261 
Result^.Health:= 2; 

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

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

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

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

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

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

4  279 
end; 
280 

281 
procedure DeleteGear(Gear: PGear); 

48  282 
var team: PTeam; 
307  283 
t: Longword; 
4  284 
begin 
503  285 
DeleteCI(Gear); 
351  286 
if Gear^.Surf <> nil then SDL_FreeSurface(Gear^.Surf); 
287 
if Gear^.Kind = gtHedgehog then 

4  288 
if CurAmmoGear <> nil then 
289 
begin 

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

4  292 
exit 
47  293 
end else 
294 
begin 

498  295 
if not (hwRound(Gear^.Y) < cWaterLine) then 
307  296 
begin 
351  297 
t:= max(Gear^.Damage, Gear^.Health); 
498  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; 
357  308 
{$IFDEF DEBUGFILE}AddFileLog('DeleteGear');{$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, 

498  330 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
351  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; 

371  341 
const delay: LongInt = 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); 
371  452 
var t: LongInt; 
292  453 
begin 
503  454 
DrawHedgehog(hwRound(Gear^.X)  15 + WorldDx, hwRound(Gear^.Y)  18 + WorldDy, 
351  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, 

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

485 

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

488 
i: Longword; 

371  489 
roplen: LongInt; 
4  490 

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

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

366  494 
b: boolean; 
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; 

366  501 
eX:= 0; 
502 
eY:= 0; 

503 
dX:= X2  X1; 

504 
dY:= Y2  Y1; 

505 

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

507 
else 

508 
if (dX < 0) then 

509 
begin 

510 
sX:= 1; 

511 
dX:= dX 

512 
end else sX:= dX; 

513 

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

515 
else 

516 
if (dY < 0) then 

4  517 
begin 
366  518 
sY:= 1; 
519 
dY:= dY 

520 
end else sY:= dY; 

521 

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

523 
else d:= dY; 

524 

525 
x:= X1; 

526 
y:= Y1; 

527 

528 
for i:= 0 to d do 

529 
begin 

530 
inc(eX, dX); 

531 
inc(eY, dY); 

532 
b:= false; 

533 
if (eX > d) then 

35  534 
begin 
366  535 
dec(eX, d); 
536 
inc(x, sX); 

537 
b:= true 

35  538 
end; 
366  539 
if (eY > d) then 
35  540 
begin 
366  541 
dec(eY, d); 
542 
inc(y, sY); 

543 
b:= true 

35  544 
end; 
366  545 
if b then 
546 
begin 

547 
inc(roplen); 

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

549 
end 

4  550 
end 
366  551 
end; 
4  552 

553 
begin 

554 
Gear:= GearsList; 

555 
while Gear<>nil do 

556 
begin 

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

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

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

561 
gtAmmo_Grenade: DrawSprite(sprGrenade , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
351  562 
gtHealthTag: if Gear^.Surf <> nil then DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Surf, Surface); 
563 
gtGrave: DrawSpriteFromRect(PHedgehog(Gear^.Hedgehog)^.Team^.GraveRect, hwRound(Gear^.X) + WorldDx  16, hwRound(Gear^.Y) + WorldDy  16, 32, (GameTicks shr 7) and 7, Surface); 

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

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

4  566 
gtRope: begin 
35  567 
roplen:= 0; 
4  568 
if RopePoints.Count > 0 then 
569 
begin 

570 
i:= 0; 

571 
while i < Pred(RopePoints.Count) do 

572 
begin 

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

4  575 
inc(i) 
576 
end; 

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

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

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

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

4  582 
end else 
35  583 
begin 
351  584 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
585 
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

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

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

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

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

594 
gtCase: case Gear^.Pos of 

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

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

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

600 
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

601 
gtAirBomb: DrawSprite(sprAirBomb , hwRound(Gear^.X)  16 + WorldDx, hwRound(Gear^.Y)  16 + WorldDy, DxDy2Angle32(Gear^.dY, Gear^.dX), Surface); 
408  602 
gtAirAttack: if Gear^.Tag > 0 then DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0, Surface) 
603 
else DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 1, Surface) 

4  604 
end; 
351  605 
Gear:= Gear^.NextGear 
4  606 
end; 
607 
end; 

608 

609 
procedure FreeGearsList; 

610 
var t, tt: PGear; 

611 
begin 

612 
tt:= GearsList; 

613 
GearsList:= nil; 

614 
while tt<>nil do 

615 
begin 

616 
t:= tt; 

351  617 
tt:= tt^.NextGear; 
4  618 
Dispose(t) 
619 
end; 

620 
end; 

621 

10  622 
procedure AddMiscGears; 
371  623 
var i: LongInt; 
4  624 
begin 
498  625 
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000); 
22  626 
if (GameFlags and gfForts) = 0 then 
627 
for i:= 0 to 3 do 

498  628 
FindPlace(AddGear(0, 0, gtMine, 0, _0, _0, 0), false, 0, 2048); 
4  629 
end; 
630 

293  631 
procedure AddClouds; 
371  632 
var i: LongInt; 
360  633 
dx, dy: hwFloat; 
293  634 
begin 
635 
for i:= 0 to cCloudsNumber do 

360  636 
begin 
637 
dx.isNegative:= random(2) = 1; 

638 
dx.QWordValue:= random(214748364); 

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

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

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

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

643 
end 

293  644 
end; 
645 

371  646 
procedure doMakeExplosion(X, Y, Radius: LongInt; Mask: LongWord); 
4  647 
var Gear: PGear; 
371  648 
dmg: LongInt; 
4  649 
begin 
650 
TargetPoint.X:= NoPointX; 

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

305  652 
if (Mask and EXPLDontDraw) = 0 then DrawExplosion(X, Y, Radius); 
498  653 
if Radius = 50 then AddGear(X, Y, gtExplosion, 0, _0, _0, 0); 
355  654 
if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion, false); 
4  655 
if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1; 
656 
Gear:= GearsList; 

657 
while Gear <> nil do 

658 
begin 

498  659 
dmg:= Radius  hwRound(Distance(Gear^.X  int2hwFloat(X), Gear^.Y  int2hwFloat(Y))); 
4  660 
if dmg > 0 then 
661 
begin 

355  662 
dmg:= dmg div 2; 
351  663 
case Gear^.Kind of 
10  664 
gtHedgehog, 
14
81f125629b25
 Mine checks whether a hedgehog is near less frequently
unc0rr
parents:
10
diff
changeset

665 
gtMine, 
79  666 
gtCase, 
667 
gtFlame: begin 

355  668 
{$IFDEF DEBUGFILE}AddFileLog('Damage: ' + inttostr(dmg));{$ENDIF} 
351  669 
if (Mask and EXPLNoDamage) = 0 then inc(Gear^.Damage, dmg); 
670 
if ((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog) then 

42  671 
begin 
498  672 
Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X  int2hwFloat(X)); 
673 
Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y  int2hwFloat(Y)); 

503  674 
Gear^.State:= Gear^.State or gstMoving; 
351  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; 
498  687 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  688 
end; 
689 

371  690 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  691 
var t: PGearArray; 
371  692 
i: LongInt; 
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; 

503  711 
t^.ar[i]^.State:= t^.ar[i]^.State or gstMoving; 
351  712 
DeleteCI(t^.ar[i]); 
713 
FollowGear:= t^.ar[i] 

53  714 
end; 
715 
end 

126  716 
end; 
717 
SetAllToActive 

38  718 
end; 
719 

4  720 
procedure AssignHHCoords; 
82  721 
var Team: PTeam; 
371  722 
i, t: LongInt; 
4  723 
begin 
82  724 
Team:= TeamsList; 
725 
t:= 0; 

726 
while Team <> nil do 

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

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

733 
inc(t, 1024); 

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

737 

371  738 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  739 
var t: PGear; 
740 
begin 

741 
t:= GearsList; 

742 
rX:= sqr(rX); 

743 
rY:= sqr(rY); 

744 
while t <> nil do 

745 
begin 

351  746 
if (t <> Gear) and (t^.Kind = Kind) then 
498  747 
if not((hwSqr(Gear^.X  t^.X) / rX + hwSqr(Gear^.Y  t^.Y) / rY) > _1) then 
351  748 
exit(t); 
749 
t:= t^.NextGear 

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

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

756 
begin 

757 
t:= GearsList; 

758 
while t <> nil do 

759 
begin 

351  760 
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then 
498  761 
if not (hwSqr(Ammo^.X  t^.X) + hwSqr(Ammo^.Y  t^.Y  int2hwFloat(cHHRadius)) * 2 > _2) then 
79  762 
begin 
351  763 
inc(t^.Damage, 5); 
764 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

765 
t^.dY:=  _0_25; 

766 
t^.Active:= true; 

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

769 
end; 

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

773 

371  774 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  775 
var t: PGear; 
776 
begin 

777 
t:= GearsList; 

778 
rX:= sqr(rX); 

779 
rY:= sqr(rY); 

780 
while t <> nil do 

781 
begin 

351  782 
if t^.Kind in Kind then 
498  783 
if not (hwSqr(int2hwFloat(mX)  t^.X) / rX + hwSqr(int2hwFloat(mY)  t^.Y) / rY > _1) then 
351  784 
exit(t); 
785 
t:= t^.NextGear 

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

790 
function CountGears(Kind: TGearType): Longword; 

791 
var t: PGear; 

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

795 
t:= GearsList; 

796 
while t <> nil do 

797 
begin 

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

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

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

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

806 
i: TAmmoType; 
15  807 
begin 
295  808 
if (CountGears(gtCase) >= 5) or (getrandom(cCaseFactor) <> 0) then exit; 
498  809 
FollowGear:= AddGear(0, 0, gtCase, 0, _0, _0, 0); 
295  810 
case getrandom(2) of 
811 
0: begin 

351  812 
FollowGear^.Health:= 25; 
813 
FollowGear^.Pos:= posCaseHealth 

295  814 
end; 
815 
1: begin 

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

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

817 
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

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

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

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

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

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

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

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

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

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

828 
FollowGear^.State:= Longword(i) 
295  829 
end; 
830 
end; 

70  831 
FindPlace(FollowGear, true, 0, 2048) 
832 
end; 

833 

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

371  836 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
837 
var i: LongInt; 

838 
Result: LongInt; 

70  839 
begin 
840 
Result:= 0; 

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

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

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

70  845 
end; 
846 

495  847 
var x: LongInt; 
371  848 
y, sy: LongInt; 
386  849 
ar: array[0..511] of TPoint; 
850 
ar2: array[0..1023] of TPoint; 

392  851 
cnt, cnt2: Longword; 
852 
delta: LongInt; 

70  853 
begin 
386  854 
delta:= 250; 
855 
cnt2:= 0; 

16  856 
repeat 
392  857 
x:= Left + LongInt(GetRandom(Delta)); 
70  858 
repeat 
386  859 
inc(x, Delta); 
70  860 
cnt:= 0; 
351  861 
y:= Gear^.Radius * 2; 
70  862 
while y < 1023 do 
16  863 
begin 
70  864 
repeat 
865 
inc(y, 2); 

351  866 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  867 
sy:= y; 
868 
repeat 

869 
inc(y); 

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

70  872 
and (y < 1023) 
351  873 
and (CheckGearsNear(x, y  Gear^.Radius, [gtHedgehog, gtMine, gtCase], 110, 110) = nil) then 
70  874 
begin 
875 
ar[cnt].X:= x; 

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

70  878 
inc(cnt) 
879 
end; 

386  880 
inc(y, 45) 
16  881 
end; 
70  882 
if cnt > 0 then 
883 
with ar[GetRandom(cnt)] do 

884 
begin 

386  885 
ar2[cnt2].x:= x; 
886 
ar2[cnt2].y:= y; 

887 
inc(cnt2) 

70  888 
end 
386  889 
until (x + Delta > Right); 
890 
dec(Delta, 60) 

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

892 
if cnt2 > 0 then 

893 
with ar2[GetRandom(cnt2)] do 

894 
begin 

498  895 
Gear^.X:= int2hwFloat(x); 
896 
Gear^.Y:= int2hwFloat(y); 

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

899 
{$ENDIF} 

900 
end 

901 
else 

902 
begin 

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

904 
DeleteGear(Gear) 

905 
end 

10  906 
end; 
907 

4  908 
initialization 
909 

910 
finalization 

95  911 
FreeGearsList; 
4  912 

913 
end. 