author  unc0rr 
Sun, 04 Feb 2007 15:46:52 +0000  
changeset 386  21eeb5ac0486 
parent 371  731ad6d27bd1 
child 392  25be13ae29da 
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; 
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, 

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 

371  158 
function AddGear(X, Y: LongInt; 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); 
357  165 
{$IFDEF DEBUGFILE}AddFileLog('AddGear: type = ' + inttostr(ord(Kind)));{$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 

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

4  291 
exit 
47  292 
end else 
293 
begin 

351  294 
if not (Gear^.Y < cWaterLine) then 
307  295 
begin 
351  296 
t:= max(Gear^.Damage, Gear^.Health); 
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, 

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

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); 
351  601 
gtAirAttack: DrawSprite(sprAirplane, hwRound(Gear^.X)  60 + WorldDx, hwRound(Gear^.Y)  25 + WorldDy, 0, Surface); 
4  602 
end; 
351  603 
Gear:= Gear^.NextGear 
4  604 
end; 
605 
end; 

606 

607 
procedure FreeGearsList; 

608 
var t, tt: PGear; 

609 
begin 

610 
tt:= GearsList; 

611 
GearsList:= nil; 

612 
while tt<>nil do 

613 
begin 

614 
t:= tt; 

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

618 
end; 

619 

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

351  626 
FindPlace(AddGear(0, 0, gtMine, 0, 0, 0, 0), false, 0, 2048); 
4  627 
end; 
628 

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

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

636 
dx.QWordValue:= random(214748364); 

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

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

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

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

641 
end 

293  642 
end; 
643 

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

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

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

655 
while Gear <> nil do 

656 
begin 

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

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

663 
gtMine, 
79  664 
gtCase, 
665 
gtFlame: begin 

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

42  669 
begin 
355  670 
Gear^.dX:= Gear^.dX + (_0_005 * dmg + cHHKick) * hwSign(Gear^.X  X); 
671 
Gear^.dY:= Gear^.dY + (_0_005 * dmg + cHHKick) * hwSign(Gear^.Y  Y); 

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

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

51  679 
end; 
4  680 
end; 
681 
end; 

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

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

53  695 
while i > 0 do 
696 
begin 

697 
dec(i); 

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

53  700 
gtHedgehog, 
701 
gtMine, 

702 
gtCase: begin 

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

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

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

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

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

709 
FollowGear:= t^.ar[i] 

53  710 
end; 
711 
end 

126  712 
end; 
713 
SetAllToActive 

38  714 
end; 
715 

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

722 
while Team <> nil do 

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

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

729 
inc(t, 1024); 

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

733 

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

737 
t:= GearsList; 

738 
rX:= sqr(rX); 

739 
rY:= sqr(rY); 

740 
while t <> nil do 

741 
begin 

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

744 
exit(t); 

745 
t:= t^.NextGear 

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

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

752 
begin 

753 
t:= GearsList; 

754 
while t <> nil do 

755 
begin 

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

79  758 
begin 
351  759 
inc(t^.Damage, 5); 
760 
t^.dX:= t^.dX + (t^.X  Ammo^.X) * _0_02; 

761 
t^.dY:=  _0_25; 

762 
t^.Active:= true; 

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

765 
end; 

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

769 

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

773 
t:= GearsList; 

774 
rX:= sqr(rX); 

775 
rY:= sqr(rY); 

776 
while t <> nil do 

777 
begin 

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

780 
exit(t); 

781 
t:= t^.NextGear 

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

786 
function CountGears(Kind: TGearType): Longword; 

787 
var t: PGear; 

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

791 
t:= GearsList; 

792 
while t <> nil do 

793 
begin 

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

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

15  800 
procedure SpawnBoxOfSmth; 
801 
begin 

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

351  806 
FollowGear^.Health:= 25; 
807 
FollowGear^.Pos:= posCaseHealth 

295  808 
end; 
809 
1: begin 

351  810 
FollowGear^.Pos:= posCaseAmmo; 
811 
FollowGear^.State:= Longword(amMineStrike) 

295  812 
end; 
813 
end; 

70  814 
FindPlace(FollowGear, true, 0, 2048) 
815 
end; 

816 

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

371  819 
function CountNonZeroz(x, y, r: LongInt): LongInt; 
820 
var i: LongInt; 

821 
Result: LongInt; 

70  822 
begin 
823 
Result:= 0; 

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

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

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

70  828 
end; 
829 

371  830 
var fx, x: LongInt; 
831 
y, sy: LongInt; 

386  832 
ar: array[0..511] of TPoint; 
833 
ar2: array[0..1023] of TPoint; 

834 
cnt, cnt2, delta: Longword; 

70  835 
begin 
386  836 
delta:= 250; 
837 
cnt2:= 0; 

16  838 
repeat 
386  839 
x:= Left + GetRandom(Delta); 
70  840 
repeat 
386  841 
inc(x, Delta); 
70  842 
cnt:= 0; 
351  843 
y:= Gear^.Radius * 2; 
70  844 
while y < 1023 do 
16  845 
begin 
70  846 
repeat 
847 
inc(y, 2); 

351  848 
until (y > 1023) or (CountNonZeroz(x, y, Gear^.Radius  1) = 0); 
70  849 
sy:= y; 
850 
repeat 

851 
inc(y); 

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

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

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

70  860 
inc(cnt) 
861 
end; 

386  862 
inc(y, 45) 
16  863 
end; 
70  864 
if cnt > 0 then 
865 
with ar[GetRandom(cnt)] do 

866 
begin 

386  867 
ar2[cnt2].x:= x; 
868 
ar2[cnt2].y:= y; 

869 
inc(cnt2) 

70  870 
end 
386  871 
until (x + Delta > Right); 
872 
dec(Delta, 60) 

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

874 
if cnt2 > 0 then 

875 
with ar2[GetRandom(cnt2)] do 

876 
begin 

877 
Gear^.X:= x; 

878 
Gear^.Y:= y; 

879 
{$IFDEF DEBUGFILE} 

880 
AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')'); 

881 
{$ENDIF} 

882 
end 

883 
else 

884 
begin 

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

886 
DeleteGear(Gear) 

887 
end 

10  888 
end; 
889 

4  890 
initialization 
891 

892 
finalization 

95  893 
FreeGearsList; 
4  894 

895 
end. 