author  unc0rr 
Sat, 17 Mar 2007 18:17:19 +0000  
changeset 498  9c8b385dc9a1 
parent 495  62c1c2b4414c 
child 503  2cfdc4bfc2be 
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 
351  233 
Result^.Radius:= 3; 
234 
Result^.Elasticity:= _0_55; 

235 
Result^.Friction:= _0_995; 

236 
Result^.Timer:= 3000; 

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

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

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

241 
end; 
37  242 
gtDEagleShot: begin 
351  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 

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

4  291 
exit 
47  292 
end else 
293 
begin 

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

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

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

313 

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

315 
var Gear: PGear; 

316 
begin 

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

320 
begin 

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

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

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

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

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

498  329 
gtHealthTag, Gear^.Damage, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog; 
351  330 
RenderHealth(PHedgehog(Gear^.Hedgehog)^); 
331 
RecountTeamHealth(PHedgehog(Gear^.Hedgehog)^.Team); 

332 

333 
Gear^.Damage:= 0 

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

339 
procedure ProcessGears; 

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

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

344 
tickcntA, tickcntB: LongWord; 

345 
const cntSecTicks: LongWord = 0; 

346 
{$ENDIF} 

347 
begin 

348 
{$IFDEF COUNTTICKS} 

349 
asm 

350 
push eax 

351 
push edx 

352 
rdtsc 

353 
mov tickcntA, eax 

354 
mov tickcntB, edx 

355 
pop edx 

356 
pop eax 

357 
end; 

358 
{$ENDIF} 

359 
AllInactive:= true; 

360 
t:= GearsList; 

361 
while t<>nil do 

362 
begin 

363 
Gear:= t; 

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

4  366 
end; 
89  367 

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

371 
dec(delay); 

372 
if delay = 0 then 

373 
begin 

374 
inc(step); 

375 
delay:= cInactDelay 

376 
end 

377 
end; 

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

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

382 
inc(step) 

383 
end; 

384 
stNTurn: begin 

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

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

395 
end; 

396 

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

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

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

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

405 
asm 

406 
push eax 

407 
push edx 

408 
rdtsc 

409 
sub eax, [tickcntA] 

410 
sbb edx, [tickcntB] 

411 
add [cntSecTicks], eax 

412 
pop edx 

413 
pop eax 

414 
end; 

415 
if (GameTicks and 1023) = 0 then 

416 
begin 

417 
cntTicks:= cntSecTicks shr 10; 

418 
{$IFDEF DEBUGFILE} 

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

420 
{$ENDIF} 

421 
cntSecTicks:= 0 

422 
end; 

423 
{$ENDIF} 

424 
end; 

425 

426 
procedure SetAllToActive; 

427 
var t: PGear; 

428 
begin 

429 
AllInactive:= false; 

430 
t:= GearsList; 

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

4  435 
end 
436 
end; 

437 

438 
procedure SetAllHHToActive; 

439 
var t: PGear; 

440 
begin 

441 
AllInactive:= false; 

442 
t:= GearsList; 

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

4  447 
end 
448 
end; 

449 

292  450 
procedure DrawHH(Gear: PGear; Surface: PSDL_Surface); 
371  451 
var t: LongInt; 
292  452 
begin 
351  453 
DrawHedgehog(hwRound(Gear^.X)  14 + WorldDx, hwRound(Gear^.Y)  18 + WorldDy, 
454 
hwSign(Gear^.dX), 0, 

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

292  456 
Surface); 
457 

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

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

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

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

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

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

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

292  468 
end else // Current hedgehog 
469 
begin 

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

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

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

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

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

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

484 

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

487 
i: Longword; 

371  488 
roplen: LongInt; 
4  489 

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

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

366  493 
b: boolean; 
4  494 
begin 
37  495 
if (X1 = X2) and (Y1 = Y2) then 
496 
begin 

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

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

502 
dX:= X2  X1; 

503 
dY:= Y2  Y1; 

504 

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

506 
else 

507 
if (dX < 0) then 

508 
begin 

509 
sX:= 1; 

510 
dX:= dX 

511 
end else sX:= dX; 

512 

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

514 
else 

515 
if (dY < 0) then 

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

519 
end else sY:= dY; 

520 

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

522 
else d:= dY; 

523 

524 
x:= X1; 

525 
y:= Y1; 

526 

527 
for i:= 0 to d do 

528 
begin 

529 
inc(eX, dX); 

530 
inc(eY, dY); 

531 
b:= false; 

532 
if (eX > d) then 

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

536 
b:= true 

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

542 
b:= true 

35  543 
end; 
366  544 
if b then 
545 
begin 

546 
inc(roplen); 

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

548 
end 

4  549 
end 
366  550 
end; 
4  551 

552 
begin 

553 
Gear:= GearsList; 

554 
while Gear<>nil do 

555 
begin 

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

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

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

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

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

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

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

569 
i:= 0; 

570 
while i < Pred(RopePoints.Count) do 

571 
begin 

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

4  574 
inc(i) 
575 
end; 

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

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

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

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

4  581 
end else 
35  582 
begin 
351  583 
DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 
584 
hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.X) + WorldDx, hwRound(PHedgehog(Gear^.Hedgehog)^.Gear^.Y) + WorldDy); 

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

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

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

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

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

593 
gtCase: case Gear^.Pos of 

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

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

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

599 
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

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

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

607 

608 
procedure FreeGearsList; 

609 
var t, tt: PGear; 

610 
begin 

611 
tt:= GearsList; 

612 
GearsList:= nil; 

613 
while tt<>nil do 

614 
begin 

615 
t:= tt; 

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

619 
end; 

620 

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

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

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

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

637 
dx.QWordValue:= random(214748364); 

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

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

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

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

642 
end 

293  643 
end; 
644 

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

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

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

656 
while Gear <> nil do 

657 
begin 

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

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

664 
gtMine, 
79  665 
gtCase, 
666 
gtFlame: begin 

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

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

351  673 
Gear^.Active:= true; 
42  674 
FollowGear:= Gear 
675 
end; 

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

51  680 
end; 
4  681 
end; 
682 
end; 

351  683 
Gear:= Gear^.NextGear 
80  684 
end; 
498  685 
uAIMisc.AwareOfExplosion(0, 0, 0) 
4  686 
end; 
687 

371  688 
procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); 
53  689 
var t: PGearArray; 
371  690 
i: LongInt; 
307  691 
hh: PHedgehog; 
38  692 
begin 
53  693 
t:= CheckGearsCollision(Ammo); 
351  694 
i:= t^.Count; 
695 
hh:= Ammo^.Hedgehog; 

53  696 
while i > 0 do 
697 
begin 

698 
dec(i); 

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

53  701 
gtHedgehog, 
702 
gtMine, 

703 
gtCase: begin 

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

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

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

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

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

710 
FollowGear:= t^.ar[i] 

53  711 
end; 
712 
end 

126  713 
end; 
714 
SetAllToActive 

38  715 
end; 
716 

4  717 
procedure AssignHHCoords; 
82  718 
var Team: PTeam; 
371  719 
i, t: LongInt; 
4  720 
begin 
82  721 
Team:= TeamsList; 
722 
t:= 0; 

723 
while Team <> nil do 

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

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

730 
inc(t, 1024); 

351  731 
Team:= Team^.Next 
4  732 
end 
733 
end; 

734 

371  735 
function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear; 
10  736 
var t: PGear; 
737 
begin 

738 
t:= GearsList; 

739 
rX:= sqr(rX); 

740 
rY:= sqr(rY); 

741 
while t <> nil do 

742 
begin 

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

10  747 
end; 
351  748 
CheckGearNear:= nil 
15  749 
end; 
750 

79  751 
procedure AmmoFlameWork(Ammo: PGear); 
752 
var t: PGear; 

753 
begin 

754 
t:= GearsList; 

755 
while t <> nil do 

756 
begin 

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

762 
t^.dY:=  _0_25; 

763 
t^.Active:= true; 

79  764 
DeleteCI(t); 
765 
FollowGear:= t 

766 
end; 

351  767 
t:= t^.NextGear 
79  768 
end; 
769 
end; 

770 

371  771 
function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear; 
16  772 
var t: PGear; 
773 
begin 

774 
t:= GearsList; 

775 
rX:= sqr(rX); 

776 
rY:= sqr(rY); 

777 
while t <> nil do 

778 
begin 

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

16  783 
end; 
351  784 
CheckGearsNear:= nil 
16  785 
end; 
786 

787 
function CountGears(Kind: TGearType): Longword; 

788 
var t: PGear; 

351  789 
Result: Longword; 
16  790 
begin 
791 
Result:= 0; 

792 
t:= GearsList; 

793 
while t <> nil do 

794 
begin 

351  795 
if t^.Kind = Kind then inc(Result); 
796 
t:= t^.NextGear 

16  797 
end; 
351  798 
CountGears:= Result 
16  799 
end; 
800 

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

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

803 
i: TAmmoType; 
15  804 
begin 
295  805 
if (CountGears(gtCase) >= 5) or (getrandom(cCaseFactor) <> 0) then exit; 
498  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 

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

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

814 
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

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

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

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

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

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

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

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

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

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

825 
FollowGear^.State:= Longword(i) 
295  826 
end; 
827 
end; 

70  828 
FindPlace(FollowGear, true, 0, 2048) 
829 
end; 

830 

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

371  833 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
834 
var i: LongInt; 

835 
Result: LongInt; 

70  836 
begin 
837 
Result:= 0; 

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

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

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

70  842 
end; 
843 

495  844 
var x: LongInt; 
371  845 
y, sy: LongInt; 
386  846 
ar: array[0..511] of TPoint; 
847 
ar2: array[0..1023] of TPoint; 

392  848 
cnt, cnt2: Longword; 
849 
delta: LongInt; 

70  850 
begin 
386  851 
delta:= 250; 
852 
cnt2:= 0; 

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

351  863 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  864 
sy:= y; 
865 
repeat 

866 
inc(y); 

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

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

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

70  875 
inc(cnt) 
876 
end; 

386  877 
inc(y, 45) 
16  878 
end; 
70  879 
if cnt > 0 then 
880 
with ar[GetRandom(cnt)] do 

881 
begin 

386  882 
ar2[cnt2].x:= x; 
883 
ar2[cnt2].y:= y; 

884 
inc(cnt2) 

70  885 
end 
386  886 
until (x + Delta > Right); 
887 
dec(Delta, 60) 

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

889 
if cnt2 > 0 then 

890 
with ar2[GetRandom(cnt2)] do 

891 
begin 

498  892 
Gear^.X:= int2hwFloat(x); 
893 
Gear^.Y:= int2hwFloat(y); 

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

896 
{$ENDIF} 

897 
end 

898 
else 

899 
begin 

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

901 
DeleteGear(Gear) 

902 
end 

10  903 
end; 
904 

4  905 
initialization 
906 

907 
finalization 

95  908 
FreeGearsList; 
4  909 

910 
end. 