1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uTeams;

    35 interface

    36 uses SDLh, uConsts, uKeys, uGears, uRandom;

    37 {$INCLUDE options.inc}

    38 type PHedgehog = ^THedgehog;

    39      PTeam     = ^TTeam;

    40      PHHAmmo   = ^THHAmmo;

    41      THedgehog = record

    42                  Name: string[15];

    43                  Gear: PGear;

    44                  NameRect, HealthRect, HealthTagRect: TSDL_Rect;

    45                  Ammo: PHHAmmo;

    46                  CurSlot, CurAmmo: LongWord;

    47                  AltSlot, AltAmmo: LongWord;

    48                  Team: PTeam;

    49                  AttacksNum: Longword;

    50                  visStepPos: LongWord;

    51                  BotLevel  : LongWord; // 0 - человек

    52                  end;

    53      THHAmmo   = array[0..cMaxSlot, 0..cMaxSlotAmmo] of TAmmo;

    54      TTeam = record

    55              Next: PTeam;

    56              Color: Cardinal;

    57              TeamName: string[15];

    58              ExtDriven: boolean;

    59              Aliases: array[0..cKeyMaxIndex] of shortstring;

    60              Hedgehogs: array[0..cMaxHHIndex] of THedgehog;

    61              Ammos: array[0..cMaxHHIndex] of THHAmmo;

    62              CurrHedgehog: integer;

    63              NameRect, CrossHairRect, GraveRect: TSDL_Rect;

    64              GraveName: string;

    65              FortName: string;

    66              AttackBar: LongWord;

    67              end;

    68 

    69 var CurrentTeam: PTeam = nil;

    70     TeamsList: PTeam = nil;

    71 

    72 function AddTeam: PTeam;

    73 procedure ApplyAmmoChanges(Hedgehog: PHedgehog);

    74 procedure SwitchHedgehog;

    75 procedure InitTeams;

    76 procedure OnUsedAmmo(Ammo: PHHAmmo);

    77 

    78 implementation

    79 uses uMisc, uStore, uWorld, uIO, uAIActions;

    80 

    81 procedure FreeTeamsList; forward;

    82 

    83 procedure SwitchHedgehog;

    84 var tteam: PTeam;

    85     th: integer;

    86 begin

    87 FreeActionsList;

    88 TargetPoint.X:= NoPointX;

    89 if CurrentTeam = nil then OutError('nil Team', true);

    90 tteam:= CurrentTeam;

    91 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

    92      if Gear <> nil then Gear.Message:= 0;

    93 

    94 repeat

    95   CurrentTeam:= CurrentTeam.Next;

    96   if CurrentTeam = nil then CurrentTeam:= TeamsList;

    97   th:= CurrentTeam.CurrHedgehog;

    98   repeat

    99     CurrentTeam.CurrHedgehog:= Succ(CurrentTeam.CurrHedgehog) mod cMaxHHIndex;

   100   until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam.CurrHedgehog = th)

   101 until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam = tteam);

   102 

   103 if (CurrentTeam = tteam) then

   104    begin

   105    if GameType = gmtDemo then

   106       begin

   107       SendIPC('q');

   108       GameState:= gsExit;

   109       exit

   110       end else OutError('There''s only one team on map!', true);

   111    end;

   112 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

   113      begin

   114      AttacksNum:= 0;

   115      with Gear^ do

   116           begin

   117           State:= State or gstHHDriven;

   118           Active:= true

   119           end;

   120      FollowGear:= Gear

   121      end;

   122 ResetKbd;

   123 cWindSpeed:= (GetRandom * 2 - 1) * cMaxWindSpeed;

   124 {$IFDEF DEBUGFILE}AddFileLog('Wind = '+FloatToStr(cWindSpeed));{$ENDIF}

   125 ApplyAmmoChanges(@CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog]);

   126 TurnTimeLeft:= cHedgehogTurnTime

   127 end;

   128 

   129 procedure SetFirstTurnHedgehog;

   130 var i: integer;

   131 begin

   132 if CurrentTeam=nil then OutError('nil Team (SetFirstTurnHedgehog)', true);

   133 i:= 0;

   134 while (i<cMaxHHIndex)and(CurrentTeam.Hedgehogs[i].Gear=nil) do inc(i);

   135 if CurrentTeam.Hedgehogs[i].Gear = nil then OutError(errmsgIncorrectUse + ' (sfth)', true);

   136 CurrentTeam.CurrHedgehog:= i;

   137 end;

   138 

   139 function AddTeam: PTeam;

   140 begin

   141 try

   142    New(Result);

   143 except Result:= nil; OutError(errmsgDynamicVar, true) end;

   144 FillChar(Result^, sizeof(TTeam), 0);

   145 Result.AttackBar:= 1;

   146 if TeamsList = nil then TeamsList:= Result

   147                    else begin

   148                         Result.Next:= TeamsList;

   149                         TeamsList:= Result

   150                         end;

   151 CurrentTeam:= Result

   152 end;

   153 

   154 procedure FreeTeamsList;

   155 var t, tt: PTeam;

   156 begin

   157 tt:= TeamsList;

   158 TeamsList:= nil;

   159 while tt<>nil do

   160       begin

   161       t:= tt;

   162       tt:= tt.Next;

   163       try

   164       Dispose(t)

   165       except OutError(errmsgDynamicVar) end;

   166       end;

   167 end;

   168 

   169 procedure InitTeams;

   170 var p: PTeam;

   171     i: integer;

   172 begin

   173 p:= TeamsList;

   174 while p <> nil do

   175       begin

   176       for i:= 0 to cMaxHHIndex do

   177           if p.Hedgehogs[i].Gear <> nil then

   178              begin

   179              p.Ammos[i][0, 0]:= Ammoz[amGrenade].Ammo;

   180              p.Ammos[i][0, 1]:= Ammoz[amUFO].Ammo;

   181              p.Ammos[i][1, 0]:= Ammoz[amBazooka].Ammo;

   182              p.Ammos[i][2, 0]:= Ammoz[amShotgun].Ammo;

   183              p.Ammos[i][3, 0]:= Ammoz[amPickHammer].Ammo;

   184              p.Ammos[i][3, 1]:= Ammoz[amRope].Ammo;

   185              p.Ammos[i][4, 0]:= Ammoz[amSkip].Ammo;

   186              p.Hedgehogs[i].Gear.Health:= 100;

   187              p.Hedgehogs[i].Ammo:= @p.Ammos[0]

   188              {0 - общее на всех оружие, i - у каждого своё

   189              можно группировать ёжиков, чтобы у каждой группы было своё оружие}

   190              end;

   191       p:= p.Next

   192       end;

   193 SetFirstTurnHedgehog;

   194 end;

   195 

   196 procedure ApplyAmmoChanges(Hedgehog: PHedgehog);

   197 var s: shortstring;

   198 begin

   199 with Hedgehog^ do

   200      begin     

   201      if Ammo[CurSlot, CurAmmo].Count = 0 then

   202         begin

   203         CurAmmo:= 0;

   204         while (CurAmmo <= cMaxSlotAmmo) and (Ammo[CurSlot, CurAmmo].Count = 0) do inc(CurAmmo)

   205         end;

   206 

   207 with Ammo[CurSlot, CurAmmo] do

   208      begin

   209      s:= Ammoz[AmmoType].Name;

   210      if Count <> AMMO_INFINITE then

   211         s:= s + ' (' + IntToStr(Count) + ')';

   212      if (Propz and ammoprop_Timerable) <> 0 then

   213         s:= s + ', ' + inttostr(Timer div 1000) + ' sec';

   214      AddCaption(s, Team.Color, capgrpAmmoinfo);

   215      if (Propz and ammoprop_NeedTarget) <> 0

   216         then begin

   217         Gear.State:= Gear.State or      gstHHChooseTarget;

   218         isCursorVisible:= true

   219         end else begin

   220         Gear.State:= Gear.State and not gstHHChooseTarget;

   221         AdjustMPoint;

   222         isCursorVisible:= false

   223         end

   224      end

   225      end

   226 end;

   227 

   228 procedure PackAmmo(Ammo: PHHAmmo; Slot: integer);

   229 var ami: integer;

   230     b: boolean;

   231 begin

   232     repeat

   233       b:= false;

   234       ami:= 0;

   235       while (not b) and (ami < cMaxSlotAmmo) do

   236           if (Ammo[slot, ami].Count = 0)

   237              and (Ammo[slot, ami + 1].Count > 0) then b:= true

   238                                                  else inc(ami);

   239       if b then // есть пустое место

   240          begin

   241          Ammo[slot, ami]:= Ammo[slot, ami + 1]

   242          end

   243     until not b;

   244 end;

   245 

   246 procedure OnUsedAmmo(Ammo: PHHAmmo);

   247 var s, a: Longword;

   248 begin

   249 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

   250      begin

   251      if CurAmmoGear = nil then begin s:= CurSlot; a:= CurAmmo end

   252                           else begin s:= AltSlot; a:= AltAmmo end;

   253      with Ammo[s, a] do

   254           if Count <> AMMO_INFINITE then

   255              begin

   256              dec(Count);

   257              if Count = 0 then PackAmmo(Ammo, CurSlot)

   258              end

   259      end

   260 end;

   261 

   262 initialization

   263 

   264 finalization

   265 

   266 FreeTeamsList

   267 

   268 end.