1 (*

     2 * Hedgewars, a free turn based strategy game

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

     4 *

     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

     8 *

     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.

    13 *

    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

    17 *)

    18 

    19 ////////////////////////////////////////////////////////////////////////////////

    20 procedure chQuit(var s: shortstring);

    21 const prevGState: TGameState = gsConfirm;

    22 begin

    23 s:= s; // avoid compiler hint

    24 if GameState <> gsConfirm then

    25         begin

    26         prevGState:= GameState;

    27         GameState:= gsConfirm

    28         end else

    29         GameState:= prevGState

    30 end;

    31 

    32 procedure chConfirm(var s: shortstring);

    33 begin

    34 s:= s; // avoid compiler hint

    35 if GameState = gsConfirm then

    36     begin

    37     SendIPC('Q');

    38     GameState:= gsExit

    39     end

    40 else

    41     ParseCommand('chat team', true);

    42 end;

    43 

    44 procedure chCheckProto(var s: shortstring);

    45 var i, c: LongInt;

    46 begin

    47 if isDeveloperMode then

    48 begin

    49 val(s, i, c);

    50 if (c <> 0) or (i = 0) then exit;

    51 TryDo(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old', true);

    52 TryDo(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new', true)

    53 end

    54 end;

    55 

    56 procedure chTeamLocal(var s: shortstring);

    57 begin

    58 s:= s; // avoid compiler hint

    59 if not isDeveloperMode then exit;

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

    61 CurrentTeam^.ExtDriven:= true

    62 end;

    63 

    64 procedure chGrave(var s: shortstring);

    65 begin

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

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

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

    69 CurrentTeam^.GraveName:= s

    70 end;

    71 

    72 procedure chFort(var s: shortstring);

    73 begin

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

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

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

    77 CurrentTeam^.FortName:= s

    78 end;

    79 

    80 procedure chFlag(var s: shortstring);

    81 begin

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

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

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

    85 CurrentTeam^.flag:= s

    86 end;

    87 

    88 procedure chScript(var s: shortstring);

    89 begin

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

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

    92 ScriptLoad(s)

    93 end;

    94 

    95 procedure chSetHat(var s: shortstring);

    96 begin

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

    98 with CurrentTeam^ do

    99     begin

   100     if not CurrentHedgehog^.King then

   101     if (s = '') or 

   102         (((GameFlags and gfKing) <> 0) and (s = 'crown')) or

   103         ((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then

   104         CurrentHedgehog^.Hat:= 'NoHat'

   105     else

   106         CurrentHedgehog^.Hat:= s

   107     end;

   108 end;

   109 

   110 procedure chCurU_p(var s: shortstring);

   111 begin

   112 s:= s; // avoid compiler hint

   113 CursorMovementY:= -1;

   114 end;

   115 

   116 procedure chCurU_m(var s: shortstring);

   117 begin

   118 s:= s; // avoid compiler hint

   119 CursorMovementY:= 0;

   120 end;

   121 

   122 procedure chCurD_p(var s: shortstring);

   123 begin

   124 s:= s; // avoid compiler hint

   125 CursorMovementY:= 1;

   126 end;

   127 

   128 procedure chCurD_m(var s: shortstring);

   129 begin

   130 s:= s; // avoid compiler hint

   131 CursorMovementY:= 0;

   132 end;

   133 

   134 procedure chCurL_p(var s: shortstring);

   135 begin

   136 s:= s; // avoid compiler hint

   137 CursorMovementX:= -1;

   138 end;

   139 

   140 procedure chCurL_m(var s: shortstring);

   141 begin

   142 s:= s; // avoid compiler hint

   143 CursorMovementX:= 0;

   144 end;

   145 

   146 procedure chCurR_p(var s: shortstring);

   147 begin

   148 s:= s; // avoid compiler hint

   149 CursorMovementX:= 1;

   150 end;

   151 

   152 procedure chCurR_m(var s: shortstring);

   153 begin

   154 s:= s; // avoid compiler hint

   155 CursorMovementX:= 0;

   156 end;

   157 

   158 procedure chLeft_p(var s: shortstring);

   159 begin

   160 s:= s; // avoid compiler hint

   161 if CheckNoTeamOrHH or isPaused then exit;

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

   163 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   164 bShowFinger:= false;

   165 with CurrentHedgehog^.Gear^ do

   166     Message:= Message or gmLeft

   167 end;

   168 

   169 procedure chLeft_m(var s: shortstring);

   170 begin

   171 s:= s; // avoid compiler hint

   172 if CheckNoTeamOrHH then exit;

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

   174 with CurrentHedgehog^.Gear^ do

   175     Message:= Message and not gmLeft

   176 end;

   177 

   178 procedure chRight_p(var s: shortstring);

   179 begin

   180 s:= s; // avoid compiler hint

   181 if CheckNoTeamOrHH or isPaused then exit;

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

   183 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   184 bShowFinger:= false;

   185 with CurrentHedgehog^.Gear^ do

   186     Message:= Message or gmRight

   187 end;

   188 

   189 procedure chRight_m(var s: shortstring);

   190 begin

   191 s:= s; // avoid compiler hint

   192 if CheckNoTeamOrHH then exit;

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

   194 with CurrentHedgehog^.Gear^ do

   195     Message:= Message and not gmRight

   196 end;

   197 

   198 procedure chUp_p(var s: shortstring);

   199 begin

   200 s:= s; // avoid compiler hint

   201 if CheckNoTeamOrHH or isPaused then exit;

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

   203 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   204 bShowFinger:= false;

   205 with CurrentHedgehog^.Gear^ do

   206     Message:= Message or gmUp

   207 end;

   208 

   209 procedure chUp_m(var s: shortstring);

   210 begin

   211 s:= s; // avoid compiler hint

   212 if CheckNoTeamOrHH then exit;

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

   214 with CurrentHedgehog^.Gear^ do

   215     Message:= Message and not gmUp

   216 end;

   217 

   218 procedure chDown_p(var s: shortstring);

   219 begin

   220 s:= s; // avoid compiler hint

   221 if CheckNoTeamOrHH or isPaused then exit;

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

   223 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   224 bShowFinger:= false;

   225 with CurrentHedgehog^.Gear^ do

   226     Message:= Message or gmDown

   227 end;

   228 

   229 procedure chDown_m(var s: shortstring);

   230 begin

   231 s:= s; // avoid compiler hint

   232 if CheckNoTeamOrHH then exit;

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

   234 with CurrentHedgehog^.Gear^ do

   235     Message:= Message and not gmDown

   236 end;

   237 

   238 procedure chPrecise_p(var s: shortstring);

   239 begin

   240 s:= s; // avoid compiler hint

   241 if CheckNoTeamOrHH or isPaused then exit;

   242 if not CurrentTeam^.ExtDriven then SendIPC('Z');

   243 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   244 bShowFinger:= false;

   245 with CurrentHedgehog^.Gear^ do

   246     Message:= Message or gmPrecise

   247 end;

   248 

   249 procedure chPrecise_m(var s: shortstring);

   250 begin

   251 s:= s; // avoid compiler hint

   252 if CheckNoTeamOrHH then exit;

   253 if not CurrentTeam^.ExtDriven then SendIPC('z');

   254 with CurrentHedgehog^.Gear^ do

   255     Message:= Message and not gmPrecise

   256 end;

   257 

   258 procedure chLJump(var s: shortstring);

   259 begin

   260 s:= s; // avoid compiler hint

   261 if CheckNoTeamOrHH or isPaused then exit;

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

   263 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   264 bShowFinger:= false;

   265 with CurrentHedgehog^.Gear^ do

   266     Message:= Message or gmLJump

   267 end;

   268 

   269 procedure chHJump(var s: shortstring);

   270 begin

   271 s:= s; // avoid compiler hint

   272 if CheckNoTeamOrHH or isPaused then exit;

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

   274 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   275 bShowFinger:= false;

   276 with CurrentHedgehog^.Gear^ do

   277     Message:= Message or gmHJump

   278 end;

   279 

   280 procedure chAttack_p(var s: shortstring);

   281 begin

   282 s:= s; // avoid compiler hint

   283 if CheckNoTeamOrHH or isPaused then exit;

   284 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   285 bShowFinger:= false;

   286 with CurrentHedgehog^.Gear^ do

   287     begin

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

   289     if ((State and gstHHDriven) <> 0) then

   290         begin

   291         FollowGear:= CurrentHedgehog^.Gear;

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

   293         Message:= Message or gmAttack

   294         end

   295     end

   296 end;

   297 

   298 procedure chAttack_m(var s: shortstring);

   299 begin

   300 s:= s; // avoid compiler hint

   301 if CheckNoTeamOrHH then exit;

   302 with CurrentHedgehog^.Gear^ do

   303     begin

   304     if not CurrentTeam^.ExtDriven and

   305         ((Message and gmAttack) <> 0) then SendIPC('a');

   306     Message:= Message and not gmAttack

   307     end

   308 end;

   309 

   310 procedure chSwitch(var s: shortstring);

   311 begin

   312 s:= s; // avoid compiler hint

   313 if CheckNoTeamOrHH or isPaused then exit;

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

   315 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   316 bShowFinger:= false;

   317 with CurrentHedgehog^.Gear^ do

   318     Message:= Message or gmSwitch

   319 end;

   320 

   321 procedure chNextTurn(var s: shortstring);

   322 begin

   323     s:= s; // avoid compiler hint

   324     TryDo(AllInactive, '/nextturn called when not all gears are inactive', true);

   325 

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

   327 {$IFDEF DEBUGFILE}

   328     AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));

   329 {$ENDIF}

   330     perfExt_NewTurnBeginning();

   331 end;

   332 

   333 procedure chTimer(var s: shortstring);

   334 begin

   335 if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or CheckNoTeamOrHH then exit;

   336 

   337 if not CurrentTeam^.ExtDriven then SendIPC(s);

   338 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   339 bShowFinger:= false;

   340 with CurrentHedgehog^.Gear^ do

   341     begin

   342     Message:= Message or gmTimer;

   343     MsgParam:= byte(s[1]) - ord('0')

   344     end

   345 end;

   346 

   347 procedure chSlot(var s: shortstring);

   348 var slot: LongWord;

   349 begin

   350 if (s[0] <> #1) or CheckNoTeamOrHH then exit;

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

   352 if slot > cMaxSlotIndex then exit;

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

   354 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   355 bShowFinger:= false;

   356 with CurrentHedgehog^.Gear^ do

   357     begin

   358     Message:= Message or gmSlot;

   359     MsgParam:= slot

   360     end

   361 end;

   362 

   363 procedure chSetWeapon(var s: shortstring);

   364 begin

   365     if (s[0] <> #1) or CheckNoTeamOrHH then exit;

   366 

   367     if TAmmoType(s[1]) > High(TAmmoType) then exit;

   368 

   369     if not CurrentTeam^.ExtDriven then SendIPC('w' + s);

   370 

   371     with CurrentHedgehog^.Gear^ do

   372     begin

   373         Message:= Message or gmWeapon;

   374         MsgParam:= byte(s[1]);

   375     end;

   376 end;

   377 

   378 procedure chTaunt(var s: shortstring);

   379 begin

   380 if (s[0] <> #1) or CheckNoTeamOrHH then exit;

   381 

   382 if TWave(s[1]) > High(TWave) then exit;

   383 

   384 if not CurrentTeam^.ExtDriven then SendIPC('t' + s);

   385 

   386 with CurrentHedgehog^.Gear^ do

   387     begin

   388     Message:= Message or gmAnimate;

   389     MsgParam:= byte(s[1])

   390     end

   391 end;

   392 

   393 procedure doPut(putX, putY: LongInt; fromAI: boolean);

   394 begin

   395 if CheckNoTeamOrHH or isPaused then exit;

   396 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   397 bShowFinger:= false;

   398 if not CurrentTeam^.ExtDriven and bShowAmmoMenu then

   399     begin

   400     bSelected:= true;

   401     exit

   402     end;

   403 

   404 with CurrentHedgehog^.Gear^,

   405     CurrentHedgehog^ do

   406     if (State and gstHHChooseTarget) <> 0 then

   407         begin

   408         isCursorVisible:= false;

   409         if not CurrentTeam^.ExtDriven then

   410             begin

   411             if fromAI then

   412                 begin

   413                 TargetPoint.X:= putX;

   414                 TargetPoint.Y:= putY

   415                 end else

   416                 begin

   417                 TargetPoint.X:= CursorPoint.X - WorldDx;

   418                 TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;

   419                 end;

   420             SendIPCXY('p', TargetPoint.X, TargetPoint.Y);

   421             end

   422         else

   423             begin

   424             TargetPoint.X:= putX;

   425             TargetPoint.Y:= putY

   426             end;

   427         {$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF}

   428         State:= State and not gstHHChooseTarget;

   429         if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackingPut) <> 0 then

   430             Message:= Message or gmAttack;

   431         end

   432     else

   433         if CurrentTeam^.ExtDriven then

   434             OutError('got /put while not being in choose target mode', false)

   435 end;

   436 

   437 procedure chPut(var s: shortstring);

   438 begin

   439     s:= s; // avoid compiler hint

   440     doPut(0, 0, false);

   441 end;

   442 

   443 procedure chCapture(var s: shortstring);

   444 begin

   445 s:= s; // avoid compiler hint

   446 flagMakeCapture:= true

   447 end;

   448 

   449 procedure chSetMap(var s: shortstring);

   450 begin

   451 if isDeveloperMode then

   452 begin

   453 Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s;

   454 InitStepsFlags:= InitStepsFlags or cifMap

   455 end

   456 end;

   457 

   458 procedure chSetTheme(var s: shortstring);

   459 begin

   460 if isDeveloperMode then

   461 begin

   462 Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s;

   463 InitStepsFlags:= InitStepsFlags or cifTheme

   464 end

   465 end;

   466 

   467 procedure chSetSeed(var s: shortstring);

   468 begin

   469 if isDeveloperMode then

   470 begin

   471 SetRandomSeed(s);

   472 cSeed:= s;

   473 InitStepsFlags:= InitStepsFlags or cifRandomize

   474 end

   475 end;

   476 

   477 procedure chAmmoMenu(var s: shortstring);

   478 begin

   479 s:= s; // avoid compiler hint

   480 if CheckNoTeamOrHH then

   481     bShowAmmoMenu:= true

   482 else

   483     begin

   484     with CurrentTeam^ do

   485         with Hedgehogs[CurrHedgehog] do

   486             begin

   487             bSelected:= false;

   488 

   489             if bShowAmmoMenu then bShowAmmoMenu:= false

   490             else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or 

   491                     ((MultiShootAttacks > 0) and ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoRoundEnd) = 0)) or

   492                     ((Gear^.State and gstHHDriven) = 0) then else bShowAmmoMenu:= true

   493             end;

   494     if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1

   495     end

   496 end;

   497 

   498 procedure chVol_p(var s: shortstring);

   499 begin

   500 s:= s; // avoid compiler hint

   501 inc(cVolumeDelta, 3)

   502 end;

   503 

   504 procedure chVol_m(var s: shortstring);

   505 begin

   506 s:= s; // avoid compiler hint

   507 dec(cVolumeDelta, 3)

   508 end;

   509 

   510 procedure chFindhh(var s: shortstring);

   511 begin

   512 s:= s; // avoid compiler hint

   513 if CheckNoTeamOrHH or isPaused then exit;

   514 bShowFinger:= true;

   515 FollowGear:= CurrentHedgehog^.Gear

   516 end;

   517 

   518 procedure chPause(var s: shortstring);

   519 begin

   520 s:= s; // avoid compiler hint

   521 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   522 if gameType <> gmtNet then

   523     isPaused:= not isPaused;

   524 SDL_ShowCursor(ord(isPaused))

   525 end;

   526 

   527 procedure chRotateMask(var s: shortstring);

   528 begin

   529 s:= s; // avoid compiler hint

   530 if ((GameFlags and gfInvulnerable) = 0) then cTagsMask:= cTagsMasks[cTagsMask] else cTagsMask:= cTagsMasksNoHealth[cTagsMask];

   531 end;

   532 

   533 procedure chSpeedup_p(var s: shortstring);

   534 begin

   535 s:= s; // avoid compiler hint

   536 isSpeed:= true

   537 end;

   538 

   539 procedure chSpeedup_m(var s: shortstring);

   540 begin

   541 s:= s; // avoid compiler hint

   542 isSpeed:= false

   543 end;

   544 

   545 procedure chZoomIn(var s: shortstring);

   546 begin

   547     s:= s; // avoid compiler hint

   548     if ZoomValue < cMinZoomLevel then

   549         ZoomValue:= ZoomValue + cZoomDelta;

   550 end;

   551 

   552 procedure chZoomOut(var s: shortstring);

   553 begin

   554     s:= s; // avoid compiler hint

   555     if ZoomValue > cMaxZoomLevel then

   556         ZoomValue:= ZoomValue - cZoomDelta;

   557 end;

   558 

   559 procedure chZoomReset(var s: shortstring);

   560 begin

   561     s:= s; // avoid compiler hint

   562     ZoomValue:= cDefaultZoomLevel;

   563 end;

   564 

   565