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

    20 var bRes: boolean;

    21 begin

    22 bRes:= (CurrentTeam = nil) or (CurrentHedgehog^.Gear = nil);

    23 {$IFDEF DEBUGFILE}

    24 if bRes then

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

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

    27 {$ENDIF}

    28 CheckNoTeamOrHH:= bRes;

    29 end;

    30 ////////////////////////////////////////////////////////////////////////////////

    31 procedure chQuit(var s: shortstring);

    32 const prevGState: TGameState = gsConfirm;

    33 begin

    34 s:= s; // avoid compiler hint

    35 if GameState <> gsConfirm then

    36         begin

    37         prevGState:= GameState;

    38         GameState:= gsConfirm

    39         end else

    40         GameState:= prevGState

    41 end;

    42 

    43 procedure chConfirm(var s: shortstring);

    44 begin

    45 s:= s; // avoid compiler hint

    46 if GameState = gsConfirm then

    47     begin

    48     SendIPC('Q');

    49     GameState:= gsExit

    50     end

    51 else

    52     begin

    53     GameState:= gsChat;

    54     KeyPressChat(27);

    55     KeyPressChat(47);

    56     KeyPressChat(116);

    57     KeyPressChat(101);

    58     KeyPressChat(97);

    59     KeyPressChat(109);

    60     KeyPressChat(32)

    61     end

    62 end;

    63 

    64 procedure chCheckProto(var s: shortstring);

    65 var i, c: LongInt;

    66 begin

    67 if isDeveloperMode then

    68 begin

    69 val(s, i, c);

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

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

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

    73 end

    74 end;

    75 

    76 procedure chAddTeam(var s: shortstring);

    77 var Color: Longword;

    78     ts, cs: shortstring;

    79 begin

    80 cs:= '';

    81 ts:= '';

    82 if isDeveloperMode then

    83 begin

    84 SplitBySpace(s, cs);

    85 SplitBySpace(cs, ts);

    86 val(cs, Color);

    87 TryDo(Color <> 0, 'Error: black team color', true);

    88 

    89 // color is always little endian so the mask must be constant also in big endian archs

    90 Color:= Color or $FF000000;

    91     

    92 AddTeam(Color);

    93 CurrentTeam^.TeamName:= ts;

    94 CurrentTeam^.PlayerHash:= s;

    95 if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true;

    96 

    97 CurrentTeam^.voicepack:= AskForVoicepack('Default')

    98 end

    99 end;

   100 

   101 procedure chTeamLocal(var s: shortstring);

   102 begin

   103 s:= s; // avoid compiler hint

   104 if not isDeveloperMode then exit;

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

   106 CurrentTeam^.ExtDriven:= true

   107 end;

   108 

   109 procedure chGrave(var s: shortstring);

   110 begin

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

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

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

   114 CurrentTeam^.GraveName:= s

   115 end;

   116 

   117 procedure chFort(var s: shortstring);

   118 begin

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

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

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

   122 CurrentTeam^.FortName:= s

   123 end;

   124 

   125 procedure chVoicepack(var s: shortstring);

   126 begin

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

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

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

   130 CurrentTeam^.voicepack:= AskForVoicepack(s)

   131 end;

   132 

   133 procedure chFlag(var s: shortstring);

   134 begin

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

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

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

   138 CurrentTeam^.flag:= s

   139 end;

   140 

   141 procedure chScript(var s: shortstring);

   142 begin

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

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

   145 ScriptLoad(s)

   146 end;

   147 

   148 procedure chAddHH(var id: shortstring);

   149 var s: shortstring;

   150     Gear: PGear;

   151 begin

   152 s:= '';

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

   154 with CurrentTeam^ do

   155     begin

   156     SplitBySpace(id, s);

   157     CurrentHedgehog:= @Hedgehogs[HedgehogsNumber];

   158     val(id, CurrentHedgehog^.BotLevel);

   159     Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0);

   160     SplitBySpace(s, id);

   161     val(s, Gear^.Health);

   162     TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true);

   163     PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam;

   164     if (GameFlags and gfSharedAmmo) <> 0 then CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex

   165     else if (GameFlags and gfPerHogAmmo) <> 0 then

   166         begin

   167         AddAmmoStore;

   168         CurrentHedgehog^.AmmoStore:= StoreCnt - 1

   169         end

   170     else CurrentHedgehog^.AmmoStore:= TeamsCount - 1;

   171     CurrentHedgehog^.Gear:= Gear;

   172     CurrentHedgehog^.Name:= id;

   173     CurrentHedgehog^.InitialHealth:= Gear^.Health;

   174     CurrHedgehog:= HedgehogsNumber;

   175     inc(HedgehogsNumber)

   176     end

   177 end;

   178 

   179 procedure chSetHat(var s: shortstring);

   180 begin

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

   182 with CurrentTeam^ do

   183     begin

   184     if not CurrentHedgehog^.King then

   185     if (s = '') or 

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

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

   188         CurrentHedgehog^.Hat:= 'NoHat'

   189     else

   190         CurrentHedgehog^.Hat:= s

   191     end;

   192 end;

   193 

   194 procedure chSetHHCoords(var x: shortstring);

   195 var y: shortstring;

   196     t: Longint;

   197 begin

   198 y:= '';

   199 if (not isDeveloperMode) or (CurrentHedgehog = nil) or (CurrentHedgehog^.Gear = nil) then exit;

   200 SplitBySpace(x, y);

   201 val(x, t);

   202 CurrentHedgehog^.Gear^.X:= int2hwFloat(t);

   203 val(y, t);

   204 CurrentHedgehog^.Gear^.Y:= int2hwFloat(t)

   205 end;

   206 

   207 procedure chSetAmmoLoadout(var descr: shortstring);

   208 begin

   209 SetAmmoLoadout(descr)

   210 end;

   211 

   212 procedure chSetAmmoDelay(var descr: shortstring);

   213 begin

   214 SetAmmoDelay(descr)

   215 end;

   216 

   217 procedure chSetAmmoProbability(var descr: shortstring);

   218 begin

   219 SetAmmoProbability(descr)

   220 end;

   221 

   222 procedure chSetAmmoReinforcement(var descr: shortstring);

   223 begin

   224 SetAmmoReinforcement(descr)

   225 end;

   226 

   227 procedure chAddAmmoStore(var descr: shortstring);

   228 begin

   229 descr:= ''; // avoid compiler hint

   230 AddAmmoStore

   231 end;

   232 

   233 procedure chBind(var id: shortstring);

   234 var s: shortstring;

   235     b: LongInt;

   236 begin

   237 s:= '';

   238 if CurrentTeam = nil then exit;

   239 SplitBySpace(id, s);

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

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

   242 b:= KeyNameToCode(id);

   243 if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"', false)

   244         else CurrentTeam^.Binds[b]:= s

   245 end;

   246 

   247 procedure chCurU_p(var s: shortstring);

   248 begin

   249 s:= s; // avoid compiler hint

   250 CursorMovementY:= -1;

   251 end;

   252 

   253 procedure chCurU_m(var s: shortstring);

   254 begin

   255 s:= s; // avoid compiler hint

   256 CursorMovementY:= 0;

   257 end;

   258 

   259 procedure chCurD_p(var s: shortstring);

   260 begin

   261 s:= s; // avoid compiler hint

   262 CursorMovementY:= 1;

   263 end;

   264 

   265 procedure chCurD_m(var s: shortstring);

   266 begin

   267 s:= s; // avoid compiler hint

   268 CursorMovementY:= 0;

   269 end;

   270 

   271 procedure chCurL_p(var s: shortstring);

   272 begin

   273 s:= s; // avoid compiler hint

   274 CursorMovementX:= -1;

   275 end;

   276 

   277 procedure chCurL_m(var s: shortstring);

   278 begin

   279 s:= s; // avoid compiler hint

   280 CursorMovementX:= 0;

   281 end;

   282 

   283 procedure chCurR_p(var s: shortstring);

   284 begin

   285 s:= s; // avoid compiler hint

   286 CursorMovementX:= 1;

   287 end;

   288 

   289 procedure chCurR_m(var s: shortstring);

   290 begin

   291 s:= s; // avoid compiler hint

   292 CursorMovementX:= 0;

   293 end;

   294 

   295 procedure chLeft_p(var s: shortstring);

   296 begin

   297 s:= s; // avoid compiler hint

   298 if CheckNoTeamOrHH or isPaused then exit;

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

   300 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   301 bShowFinger:= false;

   302 with CurrentHedgehog^.Gear^ do

   303     Message:= Message or gmLeft

   304 end;

   305 

   306 procedure chLeft_m(var s: shortstring);

   307 begin

   308 s:= s; // avoid compiler hint

   309 if CheckNoTeamOrHH then exit;

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

   311 with CurrentHedgehog^.Gear^ do

   312     Message:= Message and not gmLeft

   313 end;

   314 

   315 procedure chRight_p(var s: shortstring);

   316 begin

   317 s:= s; // avoid compiler hint

   318 if CheckNoTeamOrHH or isPaused then exit;

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

   320 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   321 bShowFinger:= false;

   322 with CurrentHedgehog^.Gear^ do

   323     Message:= Message or gmRight

   324 end;

   325 

   326 procedure chRight_m(var s: shortstring);

   327 begin

   328 s:= s; // avoid compiler hint

   329 if CheckNoTeamOrHH then exit;

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

   331 with CurrentHedgehog^.Gear^ do

   332     Message:= Message and not gmRight

   333 end;

   334 

   335 procedure chUp_p(var s: shortstring);

   336 begin

   337 s:= s; // avoid compiler hint

   338 if CheckNoTeamOrHH or isPaused then exit;

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

   340 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   341 bShowFinger:= false;

   342 with CurrentHedgehog^.Gear^ do

   343     Message:= Message or gmUp

   344 end;

   345 

   346 procedure chUp_m(var s: shortstring);

   347 begin

   348 s:= s; // avoid compiler hint

   349 if CheckNoTeamOrHH then exit;

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

   351 with CurrentHedgehog^.Gear^ do

   352     Message:= Message and not gmUp

   353 end;

   354 

   355 procedure chDown_p(var s: shortstring);

   356 begin

   357 s:= s; // avoid compiler hint

   358 if CheckNoTeamOrHH or isPaused then exit;

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

   360 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   361 bShowFinger:= false;

   362 with CurrentHedgehog^.Gear^ do

   363     Message:= Message or gmDown

   364 end;

   365 

   366 procedure chDown_m(var s: shortstring);

   367 begin

   368 s:= s; // avoid compiler hint

   369 if CheckNoTeamOrHH then exit;

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

   371 with CurrentHedgehog^.Gear^ do

   372     Message:= Message and not gmDown

   373 end;

   374 

   375 procedure chPrecise_p(var s: shortstring);

   376 begin

   377 s:= s; // avoid compiler hint

   378 if CheckNoTeamOrHH or isPaused then exit;

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

   380 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   381 bShowFinger:= false;

   382 with CurrentHedgehog^.Gear^ do

   383     Message:= Message or gmPrecise

   384 end;

   385 

   386 procedure chPrecise_m(var s: shortstring);

   387 begin

   388 s:= s; // avoid compiler hint

   389 if CheckNoTeamOrHH then exit;

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

   391 with CurrentHedgehog^.Gear^ do

   392     Message:= Message and not gmPrecise

   393 end;

   394 

   395 procedure chLJump(var s: shortstring);

   396 begin

   397 s:= s; // avoid compiler hint

   398 if CheckNoTeamOrHH or isPaused then exit;

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

   400 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   401 bShowFinger:= false;

   402 with CurrentHedgehog^.Gear^ do

   403     Message:= Message or gmLJump

   404 end;

   405 

   406 procedure chHJump(var s: shortstring);

   407 begin

   408 s:= s; // avoid compiler hint

   409 if CheckNoTeamOrHH or isPaused then exit;

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

   411 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   412 bShowFinger:= false;

   413 with CurrentHedgehog^.Gear^ do

   414     Message:= Message or gmHJump

   415 end;

   416 

   417 procedure chAttack_p(var s: shortstring);

   418 begin

   419 s:= s; // avoid compiler hint

   420 if CheckNoTeamOrHH or isPaused then exit;

   421 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   422 bShowFinger:= false;

   423 with CurrentHedgehog^.Gear^ do

   424     begin

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

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

   427         begin

   428         FollowGear:= CurrentHedgehog^.Gear;

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

   430         Message:= Message or gmAttack

   431         end

   432     end

   433 end;

   434 

   435 procedure chAttack_m(var s: shortstring);

   436 begin

   437 s:= s; // avoid compiler hint

   438 if CheckNoTeamOrHH then exit;

   439 with CurrentHedgehog^.Gear^ do

   440     begin

   441     if not CurrentTeam^.ExtDriven and

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

   443     Message:= Message and not gmAttack

   444     end

   445 end;

   446 

   447 procedure chSwitch(var s: shortstring);

   448 begin

   449 s:= s; // avoid compiler hint

   450 if CheckNoTeamOrHH or isPaused then exit;

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

   452 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   453 bShowFinger:= false;

   454 with CurrentHedgehog^.Gear^ do

   455     Message:= Message or gmSwitch

   456 end;

   457 

   458 procedure chNextTurn(var s: shortstring);

   459 begin

   460     s:= s; // avoid compiler hint

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

   462 

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

   464 {$IFDEF DEBUGFILE}

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

   466 {$ENDIF}

   467 end;

   468 

   469 procedure chSay(var s: shortstring);

   470 begin

   471 SendIPC('s' + s);

   472 

   473 if copy(s, 1, 4) = '/me ' then

   474     s:= #2'* ' + UserNick + ' ' + copy(s, 5, Length(s) - 4)

   475 else

   476     s:= #1 + UserNick + ': ' + s;

   477 

   478 AddChatString(s)

   479 end;

   480 

   481 procedure chTeamSay(var s: shortstring);

   482 begin

   483 SendIPC('b' + s);

   484 

   485 s:= #4 + '[Team] ' + UserNick + ': ' + s;

   486 

   487 AddChatString(s)

   488 end;

   489 

   490 procedure chTimer(var s: shortstring);

   491 begin

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

   493 

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

   495 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   496 bShowFinger:= false;

   497 with CurrentHedgehog^.Gear^ do

   498     begin

   499     Message:= Message or gmTimer;

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

   501     end

   502 end;

   503 

   504 procedure chSlot(var s: shortstring);

   505 var slot: LongWord;

   506 begin

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

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

   509 if slot > cMaxSlotIndex then exit;

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

   511 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   512 bShowFinger:= false;

   513 with CurrentHedgehog^.Gear^ do

   514     begin

   515     Message:= Message or gmSlot;

   516     MsgParam:= slot

   517     end

   518 end;

   519 

   520 procedure chSetWeapon(var s: shortstring);

   521 begin

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

   523 

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

   525 

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

   527 

   528     with CurrentHedgehog^.Gear^ do

   529     begin

   530         Message:= Message or gmWeapon;

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

   532     end;

   533 end;

   534 

   535 procedure chTaunt(var s: shortstring);

   536 begin

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

   538 

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

   540 

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

   542 

   543 with CurrentHedgehog^.Gear^ do

   544     begin

   545     Message:= Message or gmAnimate;

   546     MsgParam:= byte(s[1])

   547     end

   548 end;

   549 

   550 procedure chHogSay(var s: shortstring);

   551 var Gear: PVisualGear;

   552     text: shortstring;

   553 begin

   554 text:= copy(s, 2, Length(s)-1);

   555 if CheckNoTeamOrHH

   556 or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then

   557     begin

   558     chSay(text);

   559     exit

   560     end;

   561 

   562 if not CurrentTeam^.ExtDriven then SendIPC('h' + s);

   563 

   564 if byte(s[1]) < 4 then

   565     begin

   566     Gear:= AddVisualGear(0, 0, vgtSpeechBubble);

   567     if Gear <> nil then

   568     begin

   569     Gear^.Hedgehog:= CurrentHedgehog;

   570     Gear^.Text:= text;

   571     Gear^.FrameTicks:= byte(s[1])

   572     end

   573     end

   574 else

   575     begin

   576     SpeechType:= byte(s[1])-3;

   577     SpeechText:= text

   578     end;

   579 

   580 end;

   581 

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

   583 begin

   584 if CheckNoTeamOrHH or isPaused then exit;

   585 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   586 bShowFinger:= false;

   587 if not CurrentTeam^.ExtDriven and bShowAmmoMenu then

   588     begin

   589     bSelected:= true;

   590     exit

   591     end;

   592 

   593 with CurrentHedgehog^.Gear^,

   594     CurrentHedgehog^ do

   595     if (State and gstHHChooseTarget) <> 0 then

   596         begin

   597         isCursorVisible:= false;

   598         if not CurrentTeam^.ExtDriven then

   599             begin

   600             if fromAI then

   601                 begin

   602                 TargetPoint.X:= putX;

   603                 TargetPoint.Y:= putY

   604                 end else

   605                 begin

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

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

   608                 end;

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

   610             end

   611         else

   612             begin

   613             TargetPoint.X:= putX;

   614             TargetPoint.Y:= putY

   615             end;

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

   617         State:= State and not gstHHChooseTarget;

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

   619             Message:= Message or gmAttack;

   620         end

   621     else

   622         if CurrentTeam^.ExtDriven then

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

   624 end;

   625 

   626 procedure chPut(var s: shortstring);

   627 begin

   628     s:= s; // avoid compiler hint

   629     doPut(0, 0, false);

   630 end;

   631 

   632 procedure chCapture(var s: shortstring);

   633 begin

   634 s:= s; // avoid compiler hint

   635 flagMakeCapture:= true

   636 end;

   637 

   638 procedure chSkip(var s: shortstring);

   639 begin

   640 s:= s; // avoid compiler hint

   641 if not CurrentTeam^.ExtDriven then SendIPC(',');

   642 uStats.Skipped;

   643 skipFlag:= true

   644 end;

   645 

   646 procedure chSetMap(var s: shortstring);

   647 begin

   648 if isDeveloperMode then

   649 begin

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

   651 InitStepsFlags:= InitStepsFlags or cifMap

   652 end

   653 end;

   654 

   655 procedure chSetTheme(var s: shortstring);

   656 begin

   657 if isDeveloperMode then

   658 begin

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

   660 InitStepsFlags:= InitStepsFlags or cifTheme

   661 end

   662 end;

   663 

   664 procedure chSetSeed(var s: shortstring);

   665 begin

   666 if isDeveloperMode then

   667 begin

   668 SetRandomSeed(s);

   669 cSeed:= s;

   670 InitStepsFlags:= InitStepsFlags or cifRandomize

   671 end

   672 end;

   673 

   674 procedure chAmmoMenu(var s: shortstring);

   675 begin

   676 s:= s; // avoid compiler hint

   677 if CheckNoTeamOrHH then

   678     bShowAmmoMenu:= true

   679 else

   680     begin

   681     with CurrentTeam^ do

   682         with Hedgehogs[CurrHedgehog] do

   683             begin

   684             bSelected:= false;

   685 

   686             if bShowAmmoMenu then bShowAmmoMenu:= false

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

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

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

   690             end;

   691     if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1

   692     end

   693 end;

   694 

   695 procedure chFullScr(var s: shortstring);

   696 var flags: Longword = 0;

   697     ico: PSDL_Surface;

   698 {$IFDEF DEBUGFILE}

   699     buf: array[byte] of char;

   700 {$ENDIF}

   701 begin

   702     s:= s; // avoid compiler hint

   703     if Length(s) = 0 then cFullScreen:= not cFullScreen

   704     else cFullScreen:= s = '1';

   705 

   706 {$IFDEF DEBUGFILE}

   707     buf[0]:= char(0); // avoid compiler hint

   708     AddFileLog('Prepare to change video parameters...');

   709 {$ENDIF}

   710 

   711     flags:= SDL_OPENGL;// or SDL_RESIZABLE;

   712 

   713     if cFullScreen then

   714         flags:= flags or SDL_FULLSCREEN;

   715 

   716 {$IFDEF SDL_IMAGE_NEWER}

   717     WriteToConsole('Init SDL_image... ');

   718     SDLTry(IMG_Init(IMG_INIT_PNG) <> 0, true);

   719     WriteLnToConsole(msgOK);

   720 {$ENDIF}

   721     // load engine icon

   722 {$IFDEF DARWIN}

   723     ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps);

   724 {$ELSE}

   725     ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps);

   726 {$ENDIF}

   727     if ico <> nil then

   728     begin

   729         SDL_WM_SetIcon(ico, 0);

   730         SDL_FreeSurface(ico)

   731     end;

   732     

   733     // set window caption

   734     SDL_WM_SetCaption('Hedgewars', nil);

   735     

   736     if SDLPrimSurface <> nil then

   737     begin

   738 {$IFDEF DEBUGFILE}

   739         AddFileLog('Freeing old primary surface...');

   740 {$ENDIF}

   741         SDL_FreeSurface(SDLPrimSurface);

   742         SDLPrimSurface:= nil;

   743     end;

   744     

   745 {$IFDEF SDL13}

   746     if SDLwindow = nil then

   747     begin

   748         SDLwindow:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight,

   749                         SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN    

   750                         {$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF});     

   751         SDL_CreateRenderer(SDLwindow, -1, 0);

   752     end;

   753     

   754     SDL_SetRenderDrawColor(0, 0, 0, 255);    

   755     SDL_RenderFill(nil);     

   756     SDL_RenderPresent();

   757 {$ELSE}

   758     SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);

   759     SDLTry(SDLPrimSurface <> nil, true);

   760     PixelFormat:= SDLPrimSurface^.format;

   761 {$ENDIF}

   762 

   763 {$IFDEF DEBUGFILE}

   764     AddFileLog('Setting up OpenGL...');

   765     AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf))));

   766 {$ENDIF}

   767     SetupOpenGL();

   768 end;

   769 

   770 procedure chVol_p(var s: shortstring);

   771 begin

   772 s:= s; // avoid compiler hint

   773 inc(cVolumeDelta, 3)

   774 end;

   775 

   776 procedure chVol_m(var s: shortstring);

   777 begin

   778 s:= s; // avoid compiler hint

   779 dec(cVolumeDelta, 3)

   780 end;

   781 

   782 procedure chFindhh(var s: shortstring);

   783 begin

   784 s:= s; // avoid compiler hint

   785 if CheckNoTeamOrHH or isPaused then exit;

   786 bShowFinger:= true;

   787 FollowGear:= CurrentHedgehog^.Gear

   788 end;

   789 

   790 procedure chPause(var s: shortstring);

   791 begin

   792 s:= s; // avoid compiler hint

   793 if ReadyTimeLeft > 1 then ReadyTimeLeft:= 1;

   794 if gameType <> gmtNet then

   795     isPaused:= not isPaused;

   796 SDL_ShowCursor(ord(isPaused))

   797 end;

   798 

   799 procedure chRotateMask(var s: shortstring);

   800 begin

   801 s:= s; // avoid compiler hint

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

   803 end;

   804 

   805 procedure chSpeedup_p(var s: shortstring);

   806 begin

   807 s:= s; // avoid compiler hint

   808 isSpeed:= true

   809 end;

   810 

   811 procedure chSpeedup_m(var s: shortstring);

   812 begin

   813 s:= s; // avoid compiler hint

   814 isSpeed:= false

   815 end;

   816 

   817 procedure chZoomIn(var s: shortstring);

   818 begin

   819     s:= s; // avoid compiler hint

   820     if ZoomValue < cMinZoomLevel then

   821         ZoomValue:= ZoomValue + cZoomDelta;

   822 end;

   823 

   824 procedure chZoomOut(var s: shortstring);

   825 begin

   826     s:= s; // avoid compiler hint

   827     if ZoomValue > cMaxZoomLevel then

   828         ZoomValue:= ZoomValue - cZoomDelta;

   829 end;

   830 

   831 procedure chZoomReset(var s: shortstring);

   832 begin

   833     s:= s; // avoid compiler hint

   834     ZoomValue:= cDefaultZoomLevel;

   835 end;

   836 

   837 procedure chChat(var s: shortstring);

   838 begin

   839     s:= s; // avoid compiler hint

   840     GameState:= gsChat;

   841     KeyPressChat(27)

   842 end;

   843 

   844 procedure chHistory(var s: shortstring);

   845 begin

   846     s:= s; // avoid compiler hint

   847     uChat.showAll:= not uChat.showAll

   848 end;