author | unc0rr |
Sun, 27 Jan 2008 18:39:02 +0000 | |
changeset 767 | 697728ffe39f |
parent 764 | 7513452b1d51 |
child 783 | 4f59db6f147d |
permissions | -rw-r--r-- |
4 | 1 |
(* |
2 |
* Hedgewars, a worms-like game |
|
393 | 3 |
* Copyright (c) 2004-2007 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 02111-1307, USA |
|
4 | 17 |
*) |
18 |
||
19 |
unit uTeams; |
|
20 |
interface |
|
534 | 21 |
uses SDLh, uConsts, uKeys, uGears, uRandom, uFloat; |
4 | 22 |
{$INCLUDE options.inc} |
534 | 23 |
|
24 |
type PHHAmmo = ^THHAmmo; |
|
25 |
THHAmmo = array[0..cMaxSlotIndex, 0..cMaxSlotAmmoIndex] of TAmmo; |
|
26 |
||
4 | 27 |
type PHedgehog = ^THedgehog; |
28 |
PTeam = ^TTeam; |
|
549 | 29 |
PClan = ^TClan; |
4 | 30 |
THedgehog = record |
74 | 31 |
Name: string[MAXNAMELEN]; |
4 | 32 |
Gear: PGear; |
762 | 33 |
NameTagTex: PTexture; |
34 |
HealthTagTex: PTexture; |
|
4 | 35 |
Ammo: PHHAmmo; |
288 | 36 |
AmmoStore: Longword; |
4 | 37 |
CurSlot, CurAmmo: LongWord; |
38 |
AltSlot, AltAmmo: LongWord; |
|
39 |
Team: PTeam; |
|
40 |
AttacksNum: Longword; |
|
41 |
visStepPos: LongWord; |
|
5 | 42 |
BotLevel : LongWord; // 0 - Human player |
307 | 43 |
DamageGiven: Longword; |
44 |
MaxStepDamage: Longword; |
|
4 | 45 |
end; |
46 |
TTeam = record |
|
549 | 47 |
Clan: PClan; |
74 | 48 |
TeamName: string[MAXNAMELEN]; |
4 | 49 |
ExtDriven: boolean; |
167 | 50 |
Binds: TBinds; |
4 | 51 |
Hedgehogs: array[0..cMaxHHIndex] of THedgehog; |
551 | 52 |
CurrHedgehog: LongWord; |
762 | 53 |
NameTagTex: PTexture; |
764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset
|
54 |
CrosshairTex, |
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset
|
55 |
GraveTex, |
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset
|
56 |
HealthTex: PTexture; |
4 | 57 |
GraveName: string; |
58 |
FortName: string; |
|
371 | 59 |
TeamHealth: LongInt; |
557 | 60 |
TeamHealthBarWidth, |
61 |
NewTeamHealthBarWidth: LongInt; |
|
371 | 62 |
DrawHealthY: LongInt; |
4 | 63 |
AttackBar: LongWord; |
550 | 64 |
HedgehogsNumber: Longword; |
4 | 65 |
end; |
549 | 66 |
TClan = record |
764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset
|
67 |
Color: Longword; |
549 | 68 |
Teams: array[0..Pred(cMaxTeams)] of PTeam; |
69 |
TeamsNumber: Longword; |
|
551 | 70 |
CurrTeam: LongWord; |
549 | 71 |
ClanHealth: LongInt; |
550 | 72 |
ClanIndex: LongInt; |
549 | 73 |
end; |
4 | 74 |
|
75 |
var CurrentTeam: PTeam = nil; |
|
602 | 76 |
CurrentHedgehog: PHedgehog = nil; |
547 | 77 |
TeamsArray: array[0..Pred(cMaxTeams)] of PTeam; |
78 |
TeamsCount: Longword = 0; |
|
549 | 79 |
ClansArray: array[0..Pred(cMaxTeams)] of PClan; |
80 |
ClansCount: Longword = 0; |
|
304 | 81 |
CurMinAngle, CurMaxAngle: Longword; |
4 | 82 |
|
549 | 83 |
function AddTeam(TeamColor: Longword): PTeam; |
4 | 84 |
procedure SwitchHedgehog; |
85 |
procedure InitTeams; |
|
86 |
function TeamSize(p: PTeam): Longword; |
|
47 | 87 |
procedure RecountTeamHealth(team: PTeam); |
72 | 88 |
procedure RestoreTeamsFromSave; |
92
0c359a7a2356
- Fix win message to appear only after all hedgehogs death
unc0rr
parents:
89
diff
changeset
|
89 |
function CheckForWin: boolean; |
165 | 90 |
procedure SetWeapon(weap: TAmmoType); |
307 | 91 |
procedure SendStats; |
4 | 92 |
|
93 |
implementation |
|
534 | 94 |
uses uMisc, uWorld, uAI, uLocale, uConsole, uAmmos; |
371 | 95 |
const MaxTeamHealth: LongInt = 0; |
4 | 96 |
|
97 |
procedure FreeTeamsList; forward; |
|
98 |
||
92
0c359a7a2356
- Fix win message to appear only after all hedgehogs death
unc0rr
parents:
89
diff
changeset
|
99 |
function CheckForWin: boolean; |
576 | 100 |
var AliveClan: PClan; |
306 | 101 |
s: shortstring; |
548 | 102 |
t, AliveCount: LongInt; |
83 | 103 |
begin |
548 | 104 |
AliveCount:= 0; |
549 | 105 |
for t:= 0 to Pred(ClansCount) do |
106 |
if ClansArray[t]^.ClanHealth > 0 then |
|
548 | 107 |
begin |
108 |
inc(AliveCount); |
|
549 | 109 |
AliveClan:= ClansArray[t] |
548 | 110 |
end; |
111 |
||
601
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
576
diff
changeset
|
112 |
if (AliveCount > 1) or |
78a68cc4d846
Special game mode allowing the only clan on map for training mode
unc0rr
parents:
576
diff
changeset
|
113 |
((AliveCount = 1) and ((GameFlags and gfOneClanMode) <> 0)) then exit(false); |
351 | 114 |
CheckForWin:= true; |
83 | 115 |
|
116 |
TurnTimeLeft:= 0; |
|
548 | 117 |
if AliveCount = 0 then |
83 | 118 |
begin // draw |
119 |
AddCaption(trmsg[sidDraw], $FFFFFF, capgrpGameState); |
|
306 | 120 |
SendStat(siGameResult, trmsg[sidDraw]); |
498 | 121 |
AddGear(0, 0, gtATFinishGame, 0, _0, _0, 2000) |
83 | 122 |
end else // win |
549 | 123 |
with AliveClan^ do |
124 |
begin |
|
125 |
if TeamsNumber = 1 then |
|
126 |
s:= Format(trmsg[sidWinner], Teams[0]^.TeamName) // team wins |
|
127 |
else |
|
128 |
s:= Format(trmsg[sidWinner], Teams[0]^.TeamName); // clan wins |
|
129 |
||
130 |
AddCaption(s, $FFFFFF, capgrpGameState); |
|
131 |
SendStat(siGameResult, s); |
|
132 |
AddGear(0, 0, gtATFinishGame, 0, _0, _0, 2000) |
|
133 |
end; |
|
307 | 134 |
SendStats |
83 | 135 |
end; |
136 |
||
4 | 137 |
procedure SwitchHedgehog; |
551 | 138 |
var c: LongWord; |
351 | 139 |
g: PGear; |
552 | 140 |
PrevHH, PrevTeam: LongWord; |
4 | 141 |
begin |
142 |
FreeActionsList; |
|
143 |
TargetPoint.X:= NoPointX; |
|
89 | 144 |
TryDo(CurrentTeam <> nil, 'nil Team', true); |
547 | 145 |
|
351 | 146 |
with CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog] do |
294 | 147 |
if Gear <> nil then |
148 |
begin |
|
540 | 149 |
AttacksNum:= 0; |
351 | 150 |
Gear^.Message:= 0; |
534 | 151 |
Gear^.Z:= cHHZ; |
553
5478386d935f
- Switch to bazooka (or whatever) after use of some weapon (fixes problem with bots)
unc0rr
parents:
552
diff
changeset
|
152 |
SwitchNotHoldedAmmo(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]); |
534 | 153 |
RemoveGearFromList(Gear); |
154 |
InsertGearToList(Gear) |
|
294 | 155 |
end; |
4 | 156 |
|
550 | 157 |
c:= CurrentTeam^.Clan^.ClanIndex; |
4 | 158 |
repeat |
550 | 159 |
c:= Succ(c) mod ClansCount; |
160 |
with ClansArray[c]^ do |
|
161 |
repeat |
|
552 | 162 |
PrevTeam:= CurrTeam; |
550 | 163 |
CurrTeam:= Succ(CurrTeam) mod TeamsNumber; |
164 |
CurrentTeam:= Teams[CurrTeam]; |
|
165 |
with CurrentTeam^ do |
|
552 | 166 |
begin |
167 |
PrevHH:= CurrHedgehog; |
|
550 | 168 |
repeat |
552 | 169 |
CurrHedgehog:= Succ(CurrHedgehog) mod HedgehogsNumber; |
170 |
until (Hedgehogs[CurrHedgehog].Gear <> nil) or (CurrHedgehog = PrevHH) |
|
171 |
end |
|
172 |
until (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil) or (PrevTeam = CurrTeam); |
|
550 | 173 |
until CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil; |
83 | 174 |
|
602 | 175 |
CurrentHedgehog:= @(CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]); |
176 |
with CurrentHedgehog^ do |
|
4 | 177 |
begin |
178 |
with Gear^ do |
|
179 |
begin |
|
294 | 180 |
Z:= cCurrHHZ; |
32
78bff13b11c0
With this patch the game doesn't crash when gaming by net
unc0rr
parents:
17
diff
changeset
|
181 |
State:= gstHHDriven; |
4 | 182 |
Active:= true |
183 |
end; |
|
294 | 184 |
RemoveGearFromList(Gear); |
185 |
InsertGearToList(Gear); |
|
4 | 186 |
FollowGear:= Gear |
187 |
end; |
|
188 |
ResetKbd; |
|
351 | 189 |
|
190 |
cWindSpeed:= rndSign(GetRandom * cMaxWindSpeed); |
|
498 | 191 |
g:= AddGear(0, 0, gtATSmoothWindCh, 0, _0, _0, 1); |
351 | 192 |
g^.Tag:= hwRound(cWindSpeed * 72 / cMaxWindSpeed); |
4 | 193 |
{$IFDEF DEBUGFILE}AddFileLog('Wind = '+FloatToStr(cWindSpeed));{$ENDIF} |
602 | 194 |
ApplyAmmoChanges(CurrentHedgehog^); |
351 | 195 |
if CurrentTeam^.ExtDriven then SetDefaultBinds |
196 |
else SetBinds(CurrentTeam^.Binds); |
|
176 | 197 |
bShowFinger:= true; |
4 | 198 |
TurnTimeLeft:= cHedgehogTurnTime |
199 |
end; |
|
200 |
||
549 | 201 |
function AddTeam(TeamColor: Longword): PTeam; |
351 | 202 |
var Result: PTeam; |
549 | 203 |
c: LongInt; |
4 | 204 |
begin |
547 | 205 |
TryDo(TeamsCount <= cMaxTeams, 'Too many teams', true); |
17 | 206 |
New(Result); |
80 | 207 |
TryDo(Result <> nil, 'AddTeam: Result = nil', true); |
4 | 208 |
FillChar(Result^, sizeof(TTeam), 0); |
351 | 209 |
Result^.AttackBar:= 2; |
210 |
Result^.CurrHedgehog:= cMaxHHIndex; |
|
547 | 211 |
|
212 |
TeamsArray[TeamsCount]:= Result; |
|
213 |
inc(TeamsCount); |
|
214 |
||
549 | 215 |
c:= Pred(ClansCount); |
216 |
while (c >= 0) and (ClansArray[c]^.Color <> TeamColor) do dec(c); |
|
217 |
if c < 0 then |
|
218 |
begin |
|
219 |
new(Result^.Clan); |
|
220 |
FillChar(Result^.Clan^, sizeof(TClan), 0); |
|
221 |
ClansArray[ClansCount]:= Result^.Clan; |
|
222 |
inc(ClansCount); |
|
223 |
with Result^.Clan^ do |
|
224 |
begin |
|
550 | 225 |
ClanIndex:= Pred(ClansCount); |
764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
762
diff
changeset
|
226 |
Color:= TeamColor |
549 | 227 |
end |
228 |
end else |
|
229 |
begin |
|
230 |
Result^.Clan:= ClansArray[c]; |
|
231 |
end; |
|
232 |
||
233 |
with Result^.Clan^ do |
|
234 |
begin |
|
235 |
Teams[TeamsNumber]:= Result; |
|
236 |
inc(TeamsNumber) |
|
237 |
end; |
|
238 |
||
351 | 239 |
CurrentTeam:= Result; |
240 |
AddTeam:= Result |
|
4 | 241 |
end; |
242 |
||
243 |
procedure FreeTeamsList; |
|
547 | 244 |
var t: LongInt; |
4 | 245 |
begin |
547 | 246 |
for t:= 0 to Pred(TeamsCount) do Dispose(TeamsArray[t]); |
247 |
TeamsCount:= 0 |
|
4 | 248 |
end; |
249 |
||
47 | 250 |
procedure RecountAllTeamsHealth; |
547 | 251 |
var t: LongInt; |
252 |
begin |
|
253 |
for t:= 0 to Pred(TeamsCount) do |
|
254 |
RecountTeamHealth(TeamsArray[t]) |
|
47 | 255 |
end; |
256 |
||
257 |
procedure InitTeams; |
|
547 | 258 |
var i, t: LongInt; |
371 | 259 |
th: LongInt; |
47 | 260 |
begin |
547 | 261 |
for t:= 0 to Pred(TeamsCount) do |
262 |
with TeamsArray[t]^ do |
|
47 | 263 |
begin |
264 |
th:= 0; |
|
4 | 265 |
for i:= 0 to cMaxHHIndex do |
547 | 266 |
if Hedgehogs[i].Gear <> nil then |
267 |
inc(th, Hedgehogs[i].Gear^.Health); |
|
47 | 268 |
if th > MaxTeamHealth then MaxTeamHealth:= th; |
4 | 269 |
end; |
47 | 270 |
RecountAllTeamsHealth |
4 | 271 |
end; |
272 |
||
273 |
function TeamSize(p: PTeam): Longword; |
|
351 | 274 |
var i, Result: Longword; |
4 | 275 |
begin |
276 |
Result:= 0; |
|
277 |
for i:= 0 to cMaxHHIndex do |
|
351 | 278 |
if p^.Hedgehogs[i].Gear <> nil then inc(Result); |
279 |
TeamSize:= Result |
|
4 | 280 |
end; |
281 |
||
549 | 282 |
procedure RecountClanHealth(clan: PClan); |
283 |
var i: LongInt; |
|
284 |
begin |
|
285 |
with clan^ do |
|
286 |
begin |
|
287 |
ClanHealth:= 0; |
|
288 |
for i:= 0 to Pred(TeamsNumber) do |
|
289 |
inc(ClanHealth, Teams[i]^.TeamHealth) |
|
290 |
end |
|
291 |
end; |
|
292 |
||
47 | 293 |
procedure RecountTeamHealth(team: PTeam); |
371 | 294 |
var i: LongInt; |
47 | 295 |
begin |
296 |
with team^ do |
|
297 |
begin |
|
557 | 298 |
NewTeamHealthBarWidth:= 0; |
47 | 299 |
for i:= 0 to cMaxHHIndex do |
300 |
if Hedgehogs[i].Gear <> nil then |
|
557 | 301 |
inc(NewTeamHealthBarWidth, Hedgehogs[i].Gear^.Health); |
302 |
TeamHealth:= NewTeamHealthBarWidth; |
|
303 |
if NewTeamHealthBarWidth > MaxTeamHealth then |
|
47 | 304 |
begin |
557 | 305 |
MaxTeamHealth:= NewTeamHealthBarWidth; |
47 | 306 |
RecountAllTeamsHealth; |
557 | 307 |
end else NewTeamHealthBarWidth:= (NewTeamHealthBarWidth * cTeamHealthWidth) div MaxTeamHealth |
49 | 308 |
end; |
549 | 309 |
|
310 |
RecountClanHealth(team^.Clan); |
|
311 |
||
498 | 312 |
AddGear(0, 0, gtTeamHealthSorter, 0, _0, _0, 0) |
47 | 313 |
end; |
314 |
||
72 | 315 |
procedure RestoreTeamsFromSave; |
547 | 316 |
var t: LongInt; |
72 | 317 |
begin |
547 | 318 |
for t:= 0 to Pred(TeamsCount) do |
319 |
TeamsArray[t]^.ExtDriven:= false |
|
72 | 320 |
end; |
321 |
||
165 | 322 |
procedure SetWeapon(weap: TAmmoType); |
371 | 323 |
var t: LongInt; |
165 | 324 |
begin |
247
07605d2a2024
- Fix infinite loop when selecting weapon with ammo menu
unc0rr
parents:
198
diff
changeset
|
325 |
t:= cMaxSlotAmmoIndex; |
165 | 326 |
with CurrentTeam^ do |
327 |
with Hedgehogs[CurrHedgehog] do |
|
351 | 328 |
while (Ammo^[CurSlot, CurAmmo].AmmoType <> weap) and (t >= 0) do |
247
07605d2a2024
- Fix infinite loop when selecting weapon with ammo menu
unc0rr
parents:
198
diff
changeset
|
329 |
begin |
351 | 330 |
ParseCommand('/slot ' + chr(49 + Ammoz[TAmmoType(weap)].Slot), true); |
247
07605d2a2024
- Fix infinite loop when selecting weapon with ammo menu
unc0rr
parents:
198
diff
changeset
|
331 |
dec(t) |
07605d2a2024
- Fix infinite loop when selecting weapon with ammo menu
unc0rr
parents:
198
diff
changeset
|
332 |
end |
165 | 333 |
end; |
334 |
||
307 | 335 |
procedure SendStats; |
547 | 336 |
var i, t: LongInt; |
307 | 337 |
msd: Longword; msdhh: PHedgehog; |
338 |
begin |
|
339 |
msd:= 0; msdhh:= nil; |
|
547 | 340 |
for t:= 0 to Pred(TeamsCount) do |
341 |
with TeamsArray[t]^ do |
|
307 | 342 |
begin |
343 |
for i:= 0 to cMaxHHIndex do |
|
547 | 344 |
if Hedgehogs[i].MaxStepDamage > msd then |
307 | 345 |
begin |
547 | 346 |
msdhh:= @Hedgehogs[i]; |
347 |
msd:= Hedgehogs[i].MaxStepDamage |
|
307 | 348 |
end; |
349 |
end; |
|
351 | 350 |
if msdhh <> nil then SendStat(siMaxStepDamage, inttostr(msdhh^.MaxStepDamage) + ' ' + |
351 |
msdhh^.Name + ' (' + msdhh^.Team^.TeamName + ')'); |
|
307 | 352 |
if KilledHHs > 0 then SendStat(siKilledHHs, inttostr(KilledHHs)); |
353 |
end; |
|
354 |
||
4 | 355 |
initialization |
356 |
||
357 |
finalization |
|
358 |
||
359 |
FreeTeamsList |
|
360 |
||
361 |
end. |