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 function CheckNoTeamOrHH: boolean;

    35 begin

    36 Result:= (CurrentTeam=nil) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear = nil);

    37 {$IFDEF DEBUGFILE}

    38 if Result then

    39    if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil')

    40                         else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil')

    41 {$ENDIF}

    42 end;

    43 ////////////////////////////////////////////////////////////////////////////////

    44 procedure chQuit(var s: shortstring);

    45 begin

    46 GameState:= gsExit

    47 end;

    48 

    49 procedure chAddTeam(var s: shortstring);

    50 begin

    51 if isDeveloperMode then AddTeam;

    52 if GameType = gmtDemo then CurrentTeam.ExtDriven:= true

    53 end;

    54 

    55 procedure chTeamLocal(var s: shortstring);

    56 begin

    57 if not isDeveloperMode then exit;

    58 if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true);

    59 CurrentTeam.ExtDriven:= true

    60 end;

    61 

    62 procedure chName(var id: shortstring);

    63 var s: shortstring;

    64 begin

    65 if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/name"', true);

    66 SplitBySpace(id, s);

    67 if s[1]='"' then Delete(s, 1, 1);

    68 if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);

    69 if id = 'team' then CurrentTeam.TeamName:= s

    70 else if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then

    71    CurrentTeam.Hedgehogs[byte(id[3])-48].Name:= s

    72 else OutError(errmsgUnknownVariable + ' "' + id + '"')

    73 end;

    74 

    75 procedure chGrave(var s: shortstring);

    76 begin

    77 if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);

    78 if s[1]='"' then Delete(s, 1, 1);

    79 if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);

    80 CurrentTeam.GraveName:= s

    81 end;

    82 

    83 procedure chFort(var s: shortstring);

    84 begin

    85 if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);

    86 if s[1]='"' then Delete(s, 1, 1);

    87 if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);

    88 CurrentTeam.FortName:= s

    89 end;

    90 

    91 procedure chColor(var id: shortstring);

    92 var c: integer;

    93 begin

    94 if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/color"', true);

    95 val(id, CurrentTeam.Color, c);

    96 AdjustColor(CurrentTeam.Color)

    97 end;

    98 

    99 procedure chAdd(var id: shortstring);

   100 var s: shortstring;

   101     c: integer;

   102     Gear: PGear;

   103     b: byte;

   104 begin

   105 if (not isDeveloperMode)or(CurrentTeam=nil) then exit;

   106 SplitBySpace(id, s);

   107 if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then

   108    begin

   109    b:= byte(id[3])-48;

   110    val(s, CurrentTeam.Hedgehogs[b].BotLevel, c);

   111    Gear:= AddGear(0, 0, gtHedgehog, 0);

   112    Gear.Hedgehog:= @CurrentTeam.Hedgehogs[b];

   113    PHedgehog(Gear.Hedgehog).Team:= CurrentTeam;

   114    CurrentTeam.Hedgehogs[b].Gear:= Gear

   115    end

   116 else OutError(errmsgUnknownVariable + ' "' + id + '"', true)

   117 end;

   118 

   119 procedure chBind(var id: shortstring);

   120 var s: shortstring;

   121     b: integer;

   122 begin

   123 if CurrentTeam = nil then exit;

   124 SplitBySpace(id, s);

   125 if s[1]='"' then Delete(s, 1, 1);

   126 if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);

   127 b:= KeyNameToCode(id);

   128 if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"')

   129          else CurrentTeam.Aliases[b]:= s

   130 end;

   131 

   132 procedure chLeft_p(var s: shortstring);

   133 begin

   134 if CheckNoTeamOrHH then exit;

   135 if not CurrentTeam.ExtDriven then SendIPC('L');

   136 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   137     Message:= Message or gm_Left

   138 end;

   139 

   140 procedure chLeft_m(var s: shortstring);

   141 begin

   142 if CheckNoTeamOrHH then exit;

   143 if not CurrentTeam.ExtDriven then SendIPC('l');

   144 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   145      Message:= Message and not gm_Left

   146 end;

   147 

   148 procedure chRight_p(var s: shortstring);

   149 begin

   150 if CheckNoTeamOrHH then exit;

   151 if not CurrentTeam.ExtDriven then SendIPC('R');

   152 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   153     Message:= Message or gm_Right

   154 end;

   155 

   156 procedure chRight_m(var s: shortstring);

   157 begin

   158 if CheckNoTeamOrHH then exit;

   159 if not CurrentTeam.ExtDriven then SendIPC('r');

   160 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   161      Message:= Message and not gm_Right

   162 end;

   163 

   164 procedure chUp_p(var s: shortstring);

   165 begin

   166 if CheckNoTeamOrHH then exit;

   167 if not CurrentTeam.ExtDriven then SendIPC('U');

   168 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   169     Message:= Message or gm_Up

   170 end;

   171 

   172 procedure chUp_m(var s: shortstring);

   173 begin

   174 if CheckNoTeamOrHH then exit;

   175 if not CurrentTeam.ExtDriven then SendIPC('u');

   176 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   177      Message:= Message and not gm_Up

   178 end;

   179 

   180 procedure chDown_p(var s: shortstring);

   181 begin

   182 if CheckNoTeamOrHH then exit;

   183 if not CurrentTeam.ExtDriven then SendIPC('D');

   184 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   185     Message:= Message or gm_Down

   186 end;

   187 

   188 procedure chDown_m(var s: shortstring);

   189 begin

   190 if CheckNoTeamOrHH then exit;

   191 if not CurrentTeam.ExtDriven then SendIPC('d');

   192 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   193      Message:= Message and not gm_Down

   194 end;

   195 

   196 procedure chLJump(var s: shortstring);

   197 begin

   198 if CheckNoTeamOrHH then exit;

   199 if not CurrentTeam.ExtDriven then SendIPC('j');

   200 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   201     Message:= Message or gm_LJump

   202 end;

   203 

   204 procedure chHJump(var s: shortstring);

   205 begin

   206 if CheckNoTeamOrHH then exit;

   207 if not CurrentTeam.ExtDriven then SendIPC('J');

   208 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   209     Message:= Message or gm_HJump

   210 end;

   211 

   212 procedure chAttack_p(var s: shortstring);

   213 begin

   214 if CheckNoTeamOrHH then exit;

   215 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   216      begin

   217      {$IFDEF DEBUGFILE}AddFileLog('/+attack: Gear.State = '+inttostr(State));{$ENDIF}

   218      if ((State and gstHHDriven)<>0)and((State and (gstAttacked or gstHHChooseTarget or gstMoving)) = 0) then

   219         begin

   220         FollowGear:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear;

   221         if not CurrentTeam.ExtDriven then SendIPC('A');

   222         Message:= Message or gm_Attack

   223         end

   224      end

   225 end;

   226 

   227 procedure chAttack_m(var s: shortstring);

   228 var xx, yy: real;

   229 begin

   230 if CheckNoTeamOrHH then exit;

   231 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,

   232      CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

   233      begin

   234      {$IFDEF DEBUGFILE}AddFileLog('/-attack: Gear.State = '+inttostr(State)+' CurAmmoGear = '+inttostr(longword(CurAmmoGear)));{$ENDIF}

   235      if CurAmmoGear <> nil then

   236         begin

   237         Message:= Message and not gm_Attack;

   238         if not CurrentTeam.ExtDriven then SendIPC('a')

   239         end;

   240      if (((State and (gstHHDriven or gstAttacking)) = (gstHHDriven or gstAttacking))and

   241         ((State and (gstAttacked or gstMoving or gstHHChooseTarget)) = 0)and

   242         (((State and gstFalling  ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0))and

   243         (((State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0)))and

   244         (CurAmmoGear = nil) then

   245         begin

   246         if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) <> 0 then

   247            begin

   248            StopSound(sndThrowPowerUp);

   249            PlaySound(sndThrowRelease);

   250            end;

   251         xx:= Sign(dX)*Sin(Angle*pi/cMaxAngle);

   252         yy:= -Cos(Angle*pi/cMaxAngle);

   253              case Ammo[CurSlot, CurAmmo].AmmoType of

   254                       amBazooka: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Grenade, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);

   255                       amGrenade: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Bomb,    0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, Ammo[CurSlot, CurAmmo].Timer);

   256                           amUFO: FollowGear:= AddGear(round(X), round(Y), gtUFO,          0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);

   257                       amShotgun: begin

   258                                  PlaySound(sndShotgunReload);

   259                                  FollowGear:= AddGear(round(X + xx*20), round(Y + yy*20), gtShotgunShot,  0, xx * 0.5, 0.5 * yy);

   260                                  end;

   261                          amSkip: TurnTimeLeft:= 0;

   262                    amPickHammer: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y) + cHHHalfHeight, gtPickHammer, 0);

   263                          amRope: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y), gtRope, 0, xx, yy);

   264                   end;

   265         Power:= 0;

   266         if CurAmmoGear <> nil then

   267            begin

   268            CurAmmoGear.Message:= Gear.Message;

   269            exit

   270            end else

   271            begin

   272            Message:= Message and not gm_Attack;

   273            if not CurrentTeam.ExtDriven then SendIPC('a')

   274            end;

   275         AfterAttack

   276         end

   277      end

   278 end;

   279 

   280 procedure chSwitch(var s: shortstring);

   281 begin

   282 if CheckNoTeamOrHH then exit;

   283 if not CurrentTeam.ExtDriven then SendIPC('S');

   284 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   285      Message:= Message or gm_Switch

   286 end;

   287 

   288 procedure chNextTurn(var s: shortstring);

   289 begin

   290 if AllInactive then

   291    begin

   292    if not CurrentTeam.ExtDriven then SendIPC('N');

   293    {$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF}

   294    SwitchHedgehog;

   295    end

   296 end;

   297 

   298 procedure chSay(var s: shortstring);

   299 begin

   300 WriteLnToConsole('> ' + s);

   301 SendIPC('s'+s)

   302 end;

   303 

   304 procedure chTimer(var s: shortstring);

   305 begin

   306 if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or (CurrentTeam = nil) then exit;

   307 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

   308      if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Timerable) <> 0 then

   309         begin

   310         Ammo[CurSlot, CurAmmo].Timer:= 1000 * (byte(s[1]) - 48);

   311         with CurrentTeam^ do

   312              ApplyAmmoChanges(@Hedgehogs[CurrHedgehog]);

   313         if not CurrentTeam.ExtDriven then SendIPC(s);

   314         end

   315 end;

   316 

   317 procedure chSlot(var s: shortstring);

   318 var slot: LongWord;

   319     caSlot, caAmmo: PLongword;

   320 begin

   321 if (s[0] <> #1) or (CurrentTeam = nil) then exit;

   322 slot:= byte(s[1]) - 49;

   323 if slot > cMaxSlot then exit;

   324 if not CurrentTeam.ExtDriven then SendIPC(char(byte(s[1]) + 79));

   325 with CurrentTeam^ do

   326      begin

   327      with Hedgehogs[CurrHedgehog] do

   328           begin

   329           if ((Gear.State and (gstAttacking or gstAttacked)) <> 0) or (AttacksNum > 0)

   330              or ((Gear.State and gstHHDriven) = 0) then exit; // во время стрельбы исключает смену оружия

   331           if CurAmmoGear = nil then begin caSlot:= @CurSlot; caAmmo:= @CurAmmo end

   332                                else begin caSlot:= @AltSlot; caAmmo:= @AltAmmo end;

   333           if caSlot^ = slot then

   334              begin

   335              inc(caAmmo^);

   336              if (caAmmo^ > cMaxSlotAmmo) or (Ammo[slot, caAmmo^].Count = 0) then caAmmo^:= 0

   337              end else

   338              if Ammo[slot, 0].Count > 0 then

   339                 begin

   340                 caSlot^:= slot;

   341                 caAmmo^:= 0;

   342                 end;

   343           TargetPoint.X:= NoPointX;

   344           end;

   345      ApplyAmmoChanges(@Hedgehogs[CurrHedgehog])

   346      end

   347 end;

   348 

   349 procedure chPut(var s: shortstring);

   350 begin

   351 if CheckNoTeamOrHH then exit;

   352 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do

   353      if (State and gstHHChooseTarget) <> 0 then

   354         begin

   355         isCursorVisible:= false;

   356         if not CurrentTeam.ExtDriven then

   357            begin

   358            SDL_GetMouseState(@TargetPoint.X, @TargetPoint.Y);

   359            dec(TargetPoint.X, WorldDx);

   360            dec(TargetPoint.Y, WorldDy);

   361            s[0]:= #9;

   362            s[1]:= 'p';

   363            PInteger(@s[2])^:= TargetPoint.X;

   364            PInteger(@s[6])^:= TargetPoint.Y;

   365            SendIPC(s)

   366            end;

   367         AdjustMPoint;

   368         State:= State and not gstHHChooseTarget;

   369         end else if CurrentTeam.ExtDriven then OutError('got /put while not being in choose target mode', true)

   370 end;

   371 

   372 procedure chCapture(var s: shortstring);

   373 begin

   374 flagMakeCapture:= true

   375 end;

   376