hedgewars/uTeams.pas
changeset 4398 36d7e4b6ca81
parent 4393 883b979697e4
child 4401 9cb6990af584
equal deleted inserted replaced
4397:ab577db125c4 4398:36d7e4b6ca81
    22 interface
    22 interface
    23 uses uConsts, uKeys, uGears, uRandom, uFloat, uStats, uVisualGears, uCollisions, GLunit, uSound, uTypes;
    23 uses uConsts, uKeys, uGears, uRandom, uFloat, uStats, uVisualGears, uCollisions, GLunit, uSound, uTypes;
    24 
    24 
    25 procedure initModule;
    25 procedure initModule;
    26 procedure freeModule;
    26 procedure freeModule;
       
    27 
    27 function  AddTeam(TeamColor: Longword): PTeam;
    28 function  AddTeam(TeamColor: Longword): PTeam;
    28 procedure SwitchHedgehog;
    29 procedure SwitchHedgehog;
    29 procedure AfterSwitchHedgehog;
    30 procedure AfterSwitchHedgehog;
    30 procedure InitTeams;
    31 procedure InitTeams;
    31 function  TeamSize(p: PTeam): Longword;
    32 function  TeamSize(p: PTeam): Longword;
    35 procedure TeamGone(s: shortstring);
    36 procedure TeamGone(s: shortstring);
    36 procedure TeamGoneEffect(var Team: TTeam);
    37 procedure TeamGoneEffect(var Team: TTeam);
    37 function  GetTeamStatString(p: PTeam): shortstring;
    38 function  GetTeamStatString(p: PTeam): shortstring;
    38 
    39 
    39 implementation
    40 implementation
    40 uses uLocale, uAmmos, uChat, uMobile, uVariables, uUtils, uIO, uCaptions;
    41 uses uLocale, uAmmos, uChat, uMobile, uVariables, uUtils, uIO, uCaptions, uCommands;
    41 
    42 
    42 const MaxTeamHealth: LongInt = 0;
    43 const MaxTeamHealth: LongInt = 0;
    43 
    44 
    44 function CheckForWin: boolean;
    45 function CheckForWin: boolean;
    45 var AliveClan: PClan;
    46 var AliveClan: PClan;
   429 begin
   430 begin
   430     s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
   431     s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
   431     GetTeamStatString:= s;
   432     GetTeamStatString:= s;
   432 end;
   433 end;
   433 
   434 
       
   435 procedure chAddHH(var id: shortstring);
       
   436 var s: shortstring;
       
   437     Gear: PGear;
       
   438 begin
       
   439     s:= '';
       
   440     if (not isDeveloperMode) or (CurrentTeam = nil) then exit;
       
   441     with CurrentTeam^ do
       
   442         begin
       
   443         SplitBySpace(id, s);
       
   444         CurrentHedgehog:= @Hedgehogs[HedgehogsNumber];
       
   445         val(id, CurrentHedgehog^.BotLevel);
       
   446         Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0);
       
   447         SplitBySpace(s, id);
       
   448         val(s, Gear^.Health);
       
   449         TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true);
       
   450         Gear^.Hedgehog^.Team:= CurrentTeam;
       
   451         if (GameFlags and gfSharedAmmo) <> 0 then CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex
       
   452         else if (GameFlags and gfPerHogAmmo) <> 0 then
       
   453             begin
       
   454             AddAmmoStore;
       
   455             CurrentHedgehog^.AmmoStore:= StoreCnt - 1
       
   456             end
       
   457         else CurrentHedgehog^.AmmoStore:= TeamsCount - 1;
       
   458         CurrentHedgehog^.Gear:= Gear;
       
   459         CurrentHedgehog^.Name:= id;
       
   460         CurrentHedgehog^.InitialHealth:= Gear^.Health;
       
   461         CurrHedgehog:= HedgehogsNumber;
       
   462         inc(HedgehogsNumber)
       
   463         end
       
   464 end;
       
   465 
       
   466 procedure chAddTeam(var s: shortstring);
       
   467 var Color: Longword;
       
   468     ts, cs: shortstring;
       
   469 begin
       
   470     cs:= '';
       
   471     ts:= '';
       
   472     if isDeveloperMode then
       
   473         begin
       
   474         SplitBySpace(s, cs);
       
   475         SplitBySpace(cs, ts);
       
   476         val(cs, Color);
       
   477         TryDo(Color <> 0, 'Error: black team color', true);
       
   478 
       
   479         // color is always little endian so the mask must be constant also in big endian archs
       
   480         Color:= Color or $FF000000;
       
   481 
       
   482         AddTeam(Color);
       
   483         CurrentTeam^.TeamName:= ts;
       
   484         CurrentTeam^.PlayerHash:= s;
       
   485         if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true;
       
   486 
       
   487         CurrentTeam^.voicepack:= AskForVoicepack('Default')
       
   488         end
       
   489 end;
       
   490 
       
   491 procedure chSetHHCoords(var x: shortstring);
       
   492 var y: shortstring;
       
   493     t: Longint;
       
   494 begin
       
   495 y:= '';
       
   496 if (not isDeveloperMode) or (CurrentHedgehog = nil) or (CurrentHedgehog^.Gear = nil) then exit;
       
   497 SplitBySpace(x, y);
       
   498 val(x, t);
       
   499 CurrentHedgehog^.Gear^.X:= int2hwFloat(t);
       
   500 val(y, t);
       
   501 CurrentHedgehog^.Gear^.Y:= int2hwFloat(t)
       
   502 end;
       
   503 
   434 procedure initModule;
   504 procedure initModule;
   435 begin
   505 begin
       
   506     RegisterVariable('addhh', vtCommand, @chAddHH, false);
       
   507     RegisterVariable('addteam', vtCommand, @chAddTeam, false);
       
   508     RegisterVariable('hhcoords', vtCommand, @chSetHHCoords  , false);
       
   509 
   436     CurrentTeam:= nil;
   510     CurrentTeam:= nil;
   437     PreviousTeam:= nil;
   511     PreviousTeam:= nil;
   438     CurrentHedgehog:= nil;
   512     CurrentHedgehog:= nil;
   439     TeamsCount:= 0;
   513     TeamsCount:= 0;
   440     ClansCount:= 0;
   514     ClansCount:= 0;