1 (*
2  * Hedgewars, a free turn based strategy game
3  * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17  *)
18 
19 {$INCLUDE "options.inc"}
20 
21 unit uCommandHandlers;
22 
23 interface
24 
25 procedure initModule;
26 procedure freeModule;
27 
28 implementation
29 uses uCommands, uTypes, uVariables, uIO, uDebug, uConsts, uScript, uUtils, SDLh, uWorld, uRandom, uCaptions
30     , uVisualGearsList, uGearsHedgehog
31      {$IFDEF USE_VIDEO_RECORDING}, uVideoRec {$ENDIF};
32 
33 var cTagsMasks : array[0..15] of byte = (7, 0, 0, 0, 0, 4, 5, 6, 15, 8, 8, 8, 8, 12, 13, 14);
34     cTagsMasksNoHealth: array[0..15] of byte = (3, 0, 1, 2, 0, 0, 0, 0, 11, 8, 9, 10, 8, 8, 8, 8);
35 
36 procedure chGenCmd(var s: shortstring);
37 begin
38 case s[1] of
39     'R': if ReadyTimeLeft > 0 then
40         begin
41         ReadyTimeLeft:= 0;
42         if not isExternalSource then
43             SendIPC('c'+s);
44         end
45     end
46 end;
47 
48 procedure chQuit(var s: shortstring);
49 begin
50     s:= s; // avoid compiler hint
51     if (GameState = gsGame) then
52     begin
53         isInChatMode:= false;
54         GameState:= gsConfirm;
55     end
56     else begin
57         if GameState = gsConfirm then
58             GameState:= gsGame;
59     end;
60 
61     updateCursorVisibility;
62 end;
63 
64 procedure chForceQuit(var s: shortstring);
65 begin
66     s:= s; // avoid compiler hint
67     GameState:= gsConfirm;
68     ParseCommand('confirm', true);
69 end;
70 
71 procedure chConfirm(var s: shortstring);
72 begin
73     s:= s; // avoid compiler hint
74     if GameState = gsConfirm then
75         begin
76         if (luaCmdUsed) then
77             SendIPC(_S'm');
78         SendIPC(_S'Q');
79         GameState:= gsExit
80         end
81 end;
82 
83 procedure chHalt (var s: shortstring);
84 begin
85     s:= s; // avoid compiler hint
86     if (luaCmdUsed) then
87         SendIPC(_S'm');
88     SendIPC(_S'H');
89     GameState:= gsExit
90 end;
91 
92 procedure chCheckProto(var s: shortstring);
93 var i: LongInt;
94 begin
95     if isDeveloperMode then
96         begin
97         i:= StrToInt(s);
98         checkFails(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old (got '+intToStr(i)+', expecting '+intToStr(cNetProtoVersion)+')', true);
99         checkFails(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new (got '+intToStr(i)+', expecting '+intToStr(cNetProtoVersion)+')', true);
100         end
101 end;
102 
103 procedure chTeamLocal(var s: shortstring);
104 begin
105 s:= s; // avoid compiler hint
106 if not isDeveloperMode then
107     exit;
108 if CurrentTeam = nil then
109     OutError(errmsgIncorrectUse + ' "/rdriven"', true);
110 CurrentTeam^.ExtDriven:= true
111 end;
112 
113 procedure chScript(var s: shortstring);
114 begin
115 if s[1]='"' then
116     Delete(s, 1, 1);
117 if s[byte(s[0])]='"' then
118     Delete(s, byte(s[0]), 1);
119 cScriptName:= s;
120 ScriptLoad(s, true)
121 end;
122 
123 procedure chScriptParam(var s: shortstring);
124 begin
125     ScriptSetString('ScriptParam', s);
126     ScriptCall('onParameters');
127 end;
128 
129 procedure chCurU_p(var s: shortstring);
130 begin
131 s:= s; // avoid compiler hint
132 updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, -1, CursorMovementY);
133 end;
134 
135 procedure chCurU_m(var s: shortstring);
136 begin
137 s:= s; // avoid compiler hint
138 if CursorMovementY < 0 then
139     updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 0, CursorMovementY);
140 end;
141 
142 procedure chCurD_p(var s: shortstring);
143 begin
144 s:= s; // avoid compiler hint
145 updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 1, CursorMovementY);
146 end;
147 
148 procedure chCurD_m(var s: shortstring);
149 begin
150 s:= s; // avoid compiler hint
151 if CursorMovementY > 0 then
152     updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 0, CursorMovementY);
153 end;
154 
155 procedure chCurL_p(var s: shortstring);
156 begin
157 s:= s; // avoid compiler hint
158 updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, -1, CursorMovementX);
159 end;
160 
161 procedure chCurL_m(var s: shortstring);
162 begin
163 s:= s; // avoid compiler hint
164 if CursorMovementX < 0 then
165     updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 0, CursorMovementX);
166 end;
167 
168 procedure chCurR_p(var s: shortstring);
169 begin
170 s:= s; // avoid compiler hint
171 updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 1, CursorMovementX);
172 end;
173 
174 procedure chCurR_m(var s: shortstring);
175 begin
176 s:= s; // avoid compiler hint
177 if CursorMovementX > 0 then
178     updateCursorMovementDelta((LocalMessage and gmPrecise) <> 0, 0, CursorMovementX);
179 end;
180 
181 procedure chLeft_p(var s: shortstring);
182 begin
183 s:= s; // avoid compiler hint
184 if CheckNoTeamOrHH then
185     exit;
186 if not isExternalSource then
187     SendIPC(_S'L');
188 bShowFinger:= false;
189 with CurrentHedgehog^.Gear^ do
190     Message:= Message or (gmLeft and InputMask);
191     ScriptCall('onLeft');
192 end;
193 
194 procedure chLeft_m(var s: shortstring);
195 begin
196 s:= s; // avoid compiler hint
197 if CheckNoTeamOrHH then
198     exit;
199 if not isExternalSource then
200     SendIPC(_S'l');
201 with CurrentHedgehog^.Gear^ do
202     Message:= Message and (not (gmLeft and InputMask));
203     ScriptCall('onLeftUp');
204 end;
205 
206 procedure chRight_p(var s: shortstring);
207 begin
208 s:= s; // avoid compiler hint
209 if CheckNoTeamOrHH then
210     exit;
211 if not isExternalSource then
212     SendIPC(_S'R');
213 bShowFinger:= false;
214 with CurrentHedgehog^.Gear^ do
215     Message:= Message or (gmRight and InputMask);
216     ScriptCall('onRight');
217 end;
218 
219 procedure chRight_m(var s: shortstring);
220 begin
221 s:= s; // avoid compiler hint
222 if CheckNoTeamOrHH then
223     exit;
224 if not isExternalSource then
225     SendIPC(_S'r');
226 with CurrentHedgehog^.Gear^ do
227     Message:= Message and (not (gmRight and InputMask));
228     ScriptCall('onRightUp');
229 end;
230 
231 procedure chUp_p(var s: shortstring);
232 begin
233 s:= s; // avoid compiler hint
234 if CheckNoTeamOrHH then
235     exit;
236 if not isExternalSource then
237     SendIPC(_S'U');
238 bShowFinger:= false;
239 with CurrentHedgehog^.Gear^ do
240     Message:= Message or (gmUp and InputMask);
241     ScriptCall('onUp');
242 end;
243 
244 procedure chUp_m(var s: shortstring);
245 begin
246 s:= s; // avoid compiler hint
247 if CheckNoTeamOrHH then
248     exit;
249 if not isExternalSource then
250     SendIPC(_S'u');
251 with CurrentHedgehog^.Gear^ do
252     Message:= Message and (not (gmUp and InputMask));
253     ScriptCall('onUpUp');
254 end;
255 
256 procedure chDown_p(var s: shortstring);
257 begin
258 s:= s; // avoid compiler hint
259 if CheckNoTeamOrHH then
260     exit;
261 if not isExternalSource then
262     SendIPC(_S'D');
263 bShowFinger:= false;
264 with CurrentHedgehog^.Gear^ do
265     Message:= Message or (gmDown and InputMask);
266     ScriptCall('onDown');
267 end;
268 
269 procedure chDown_m(var s: shortstring);
270 begin
271 s:= s; // avoid compiler hint
272 if CheckNoTeamOrHH then
273     exit;
274 if not isExternalSource then
275     SendIPC(_S'd');
276 with CurrentHedgehog^.Gear^ do
277     Message:= Message and (not (gmDown and InputMask));
278     ScriptCall('onDownUp');
279 end;
280 
281 procedure chPrecise_p(var s: shortstring);
282 begin
283 s:= s; // avoid compiler hint
284 if CheckNoTeamOrHH then
285     exit;
286 if not isExternalSource then
287     SendIPC(_S'Z');
288 bShowFinger:= false;
289 with CurrentHedgehog^.Gear^ do
290     Message:= Message or (gmPrecise and InputMask);
291     ScriptCall('onPrecise');
292 end;
293 
294 procedure chPrecise_m(var s: shortstring);
295 begin
296 s:= s; // avoid compiler hint
297 if CheckNoTeamOrHH then
298     exit;
299 if not isExternalSource then
300     SendIPC(_S'z');
301 with CurrentHedgehog^.Gear^ do
302     Message:= Message and (not (gmPrecise and InputMask));
303     ScriptCall('onPreciseUp');
304 end;
305 
306 procedure chLJump(var s: shortstring);
307 begin
308 s:= s; // avoid compiler hint
309 if CheckNoTeamOrHH then
310     exit;
311 if not isExternalSource then
312     SendIPC(_S'j');
313 bShowFinger:= false;
314 with CurrentHedgehog^.Gear^ do
315     Message:= Message or (gmLJump and InputMask);
316     ScriptCall('onLJump');
317 end;
318 
319 procedure chHJump(var s: shortstring);
320 begin
321 s:= s; // avoid compiler hint
322 if CheckNoTeamOrHH then
323     exit;
324 if not isExternalSource then
325     SendIPC(_S'J');
326 bShowFinger:= false;
327 with CurrentHedgehog^.Gear^ do
328     Message:= Message or (gmHJump and InputMask);
329     ScriptCall('onHJump');
330 end;
331 
332 procedure chAttack_p(var s: shortstring);
333 var inbtwnTrgtAttks: Boolean;
334 begin
335 s:= s; // avoid compiler hint
336 if CheckNoTeamOrHH then
337     exit;
338 bShowFinger:= false;
339 with CurrentHedgehog^.Gear^ do
340     begin
341     AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));
342     if ((State and gstHHDriven) <> 0) then
343         begin
344         inbtwnTrgtAttks:= ((GameFlags and gfInfAttack) <> 0) and ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NeedTarget) <> 0);
345         if (not inbtwnTrgtAttks) then
346             FollowGear:= CurrentHedgehog^.Gear;
347         if not isExternalSource then
348             SendIPC(_S'A');
349         Message:= Message or (gmAttack and InputMask);
350         ScriptCall('onAttack'); // so if I fire airstrike, it doesn't count as attack? fine, fine
351         end
352     end
353 end;
354 
355 procedure chAttack_m(var s: shortstring);
356 begin
357 s:= s; // avoid compiler hint
358 if CheckNoTeamOrHH then
359     exit;
360 with CurrentHedgehog^.Gear^ do
361     begin
362     if not isExternalSource and
363         ((Message and gmAttack) <> 0) then
364             SendIPC(_S'a');
365     Message:= Message and (not (gmAttack and InputMask));
366     ScriptCall('onAttackUp');
367     end
368 end;
369 
370 procedure chSwitch(var s: shortstring);
371 begin
372 s:= s; // avoid compiler hint
373 if CheckNoTeamOrHH then
374     exit;
375 if not isExternalSource then
376     SendIPC(_S'S');
377 bShowFinger:= false;
378 with CurrentHedgehog^.Gear^ do
379     Message:= Message or (gmSwitch and InputMask);
380     ScriptCall('onSwitch');
381 end;
382 
383 procedure chNextTurn(var s: shortstring);
384 var gi: PGear;
385 begin
386     s:= s; // avoid compiler hint
387 
388     if checkFails(AllInactive, '/nextturn called when not all gears are inactive', true) then exit;
389 
390     CheckSum:= CheckSum xor GameTicks;
391     gi := GearsList;
392     while gi <> nil do
393         begin
394         with gi^ do CheckSum:= CheckSum xor X.round xor X.frac xor dX.round xor dX.frac xor Y.round xor Y.frac xor dY.round xor dY.frac;
395         AddRandomness(CheckSum);
396         gi := gi^.NextGear
397         end;
398 
399     if not isExternalSource then
400         begin
401         s[0]:= #5;
402         s[1]:= 'N';
403         SDLNet_Write32(CheckSum, @s[2]);
404         SendIPC(s)
405         end
406     else
407         checkFails(CurrentTeam^.hasGone or (CheckSum = lastTurnChecksum), 'Desync detected', true);
408 
409     AddFileLog('Next turn: time '+inttostr(GameTicks));
410 end;
411 
412 procedure chTimer(var s: shortstring);
413 begin
414 if CheckNoTeamOrHH then
415     exit;
416 
417 if checkFails((s[0] = #1) and (s[1] >= '1') and (s[1] <= '5'), 'Malformed /timer', true) then exit;
418 
419 if not isExternalSource then
420     SendIPC(s);
421 bShowFinger:= false;
422 with CurrentHedgehog^.Gear^ do
423     begin
424     Message:= Message or (gmTimer and InputMask);
425     MsgParam:= byte(s[1]) - ord('0');
426     ScriptCall('onTimer', MsgParam);
427     end
428 end;
429 
430 // Increment timer or bounciness
431 procedure chTimerU(var s: shortstring);
432 var t: LongWord;
433     tb: Byte;
434 begin
435 s:= s; // avoid compiler hint
436 if CheckNoTeamOrHH then
437     exit;
438 // We grab the current timer first so we can increment it
439 if (CurrentHedgehog^.Gear^.Message and gmPrecise) = 0 then
440     t:= HHGetTimerMsg(CurrentHedgehog^.Gear)
441 else
442     // Use bounciness if Precise is pressed
443     t:= HHGetBouncinessMsg(CurrentHedgehog^.Gear);
444 if t <> MSGPARAM_INVALID then
445     begin
446     // Calculate new timer
447     Inc(t);
448     if t > 5 then
449         t:= 1;
450     tb:= t mod 255;
451     // Delegate the actual change to /timer
452     ParseCommand('timer ' + Char(tb + Ord('0')), true);
453     end;
454 end;
455 
456 procedure chSlot(var s: shortstring);
457 var slot: LongWord;
458     ss: shortstring;
459 begin
460 if (s[0] <> #1) or CheckNoTeamOrHH then
461     exit;
462 slot:= byte(s[1]) - 49;
463 if slot > cMaxSlotIndex then
464     exit;
465 if not isExternalSource then
466     begin
467     ss[0]:= #1;
468     ss[1]:= char(byte(s[1]) + 79);
469     SendIPC(ss);
470     end;
471 bShowFinger:= false;
472 with CurrentHedgehog^.Gear^ do
473     begin
474     Message:= Message or (gmSlot and InputMask);
475     MsgParam:= slot;
476     ScriptCall('onSlot', MsgParam);
477     end
478 end;
479 
480 procedure chSetWeapon(var s: shortstring);
481 begin
482     if CheckNoTeamOrHH then
483         exit;
484 
485     (* Use "~" (ASCII character 126) as synonym for NUL byte (=amNothing).
486     This is done to allow to add "setweap ~" in QTfrontend/binds.cpp because
487     the NUL byte would terminate the strings in C++ otherwise. *)
488     if (s[1] = '~') then
489         s[1]:= #0;
490     if checkFails((s[0] = #1) and (s[1] <= char(High(TAmmoType))), 'Malformed /setweap', true) then exit;
491 
492     if not isExternalSource then
493         SendIPC('w' + s);
494 
495     with CurrentHedgehog^.Gear^ do
496         begin
497         Message:= Message or (gmWeapon and InputMask);
498         MsgParam:= byte(s[1]);
499         ScriptCall('onSetWeapon', MsgParam);
500         end;
501 end;
502 
503 procedure chTaunt(var s: shortstring);
504 begin
505 if (s[0] <> #1) or CheckNoTeamOrHH then
506     exit;
507 
508 if TWave(s[1]) > High(TWave) then
509     exit;
510 
511 if not isExternalSource then
512     SendIPC('t' + s);
513 
514 PlayTaunt(byte(s[1]))
515 end;
516 
517 procedure chPut(var s: shortstring);
518 begin
519     s:= s; // avoid compiler hint
520     doPut(0, 0, false);
521 end;
522 
523 procedure chCapture(var s: shortstring);
524 begin
525 s:= s; // avoid compiler hint
526 flagMakeCapture:= true;
527 flagDumpLand:= (LocalMessage and gmPrecise  <> 0);
528 end;
529 
530 procedure chRecord(var s: shortstring);
531 begin
532 s:= s; // avoid compiler hint
533 {$IFDEF USE_VIDEO_RECORDING}
534 if flagPrerecording then
535     StopPreRecording()
536 else
537     BeginPreRecording();
538 {$ENDIF}
539 end;
540 
541 procedure chSetMap(var s: shortstring);
542 begin
543 if isDeveloperMode then
544     begin
545     if s = '' then
546         cPathz[ptMapCurrent]:= s
547     else
548         cPathz[ptMapCurrent]:= cPathz[ptMaps] + '/' + s;
549     InitStepsFlags:= InitStepsFlags or cifMap
550     end;
551 cMapName:= s;
552 ScriptLoad('Maps/' + s + '/map.lua', false)
553 end;
554 
555 procedure chSetTheme(var s: shortstring);
556 begin
557 if isDeveloperMode then
558     begin
559     cPathz[ptCurrTheme]:= cPathz[ptThemes] + '/' + s;
560     Theme:= s;
561     InitStepsFlags:= InitStepsFlags or cifTheme
562     end
563 end;
564 
565 procedure chSetSeed(var s: shortstring);
566 begin
567 if isDeveloperMode then
568     begin
569     SetRandomSeed(s, true);
570     cSeed:= s;
571     InitStepsFlags:= InitStepsFlags or cifRandomize
572     end
573 end;
574 
575 procedure chAmmoMenu(var s: shortstring);
576 begin
577 s:= s; // avoid compiler hint
578 if CheckNoTeamOrHH then
579     bShowAmmoMenu:= (not bShowAmmoMenu)
580 else
581     begin
582     with CurrentTeam^ do
583         with Hedgehogs[CurrHedgehog] do
584             begin
585             bSelected:= false;
586 
587             if bShowAmmoMenu then
588                 bShowAmmoMenu:= false
589             else if not(CurrentTeam^.Extdriven) and ((Gear = nil) or ((Gear^.State and (gstAttacking or gstAttacked)) <> 0)
590             or ((Gear^.State and gstHHDriven) = 0)) then
591                 begin
592                 end
593             else
594                 bShowAmmoMenu:= true
595             end;
596     end
597 end;
598 
599 procedure chVolUp_p(var s: shortstring);
600 begin
601 s:= s; // avoid compiler hint
602 cVolumeUpKey:= true;
603 updateVolumeDelta((LocalMessage and gmPrecise) <> 0);
604 end;
605 
606 procedure chVolUp_m(var s: shortstring);
607 begin
608 s:= s; // avoid compiler hint
609 cVolumeUpKey:= false;
610 updateVolumeDelta((LocalMessage and gmPrecise) <> 0);
611 end;
612 
613 procedure chVolDown_p(var s: shortstring);
614 begin
615 s:= s; // avoid compiler hint
616 cVolumeDownKey:= true;
617 updateVolumeDelta((LocalMessage and gmPrecise) <> 0);
618 end;
619 
620 procedure chVolDown_m(var s: shortstring);
621 begin
622 s:= s; // avoid compiler hint
623 cVolumeDownKey:= false;
624 updateVolumeDelta((LocalMessage and gmPrecise) <> 0);
625 end;
626 
627 procedure chMute(var s: shortstring);
628 begin
629 s:= s; // avoid compiler hint
630 cMuteToggle:= true;
631 end;
632 
633 procedure chFindhh(var s: shortstring);
634 begin
635 s:= s; // avoid compiler hint
636 if CheckNoTeamOrHH then
637     exit;
638 
639 if autoCameraOn then
640     begin
641     FollowGear:= nil;
642     AddCaption(trmsg[sidAutoCameraOff], capcolSetting, capgrpVolume);
643     autoCameraOn:= false
644     end
645 else
646     begin
647     AddCaption(trmsg[sidAutoCameraOn], capcolSetting, capgrpVolume);
648     bShowFinger:= true;
649     if not CurrentHedgehog^.Unplaced then
650         FollowGear:= CurrentHedgehog^.Gear;
651     autoCameraOn:= true
652     end
653 end;
654 
655 procedure chPause(var s: shortstring);
656 begin
657 if (gameType <> gmtNet) or (s = 'server') then
658     isPaused:= not isPaused
659     else
660     if (CurrentTeam^.ExtDriven) or (CurrentHedgehog^.BotLevel > 0) then
661         isAFK:= not isAFK
662     else
663         isAFK:= false; // for real ninjas
664 
665 updateCursorVisibility;
666 end;
667 
668 procedure chRotateMask(var s: shortstring);
669 begin
670 s:= s; // avoid compiler hint
671 // this is just for me, 'cause I thought it'd be fun.  using the old precise + switch to keep it out of people's way
672 if LocalMessage and (gmPrecise or gmSwitch) = (gmPrecise or gmSwitch) then
673     begin
674     if UIDisplay <> uiNone then
675          UIDisplay:= uiNone
676     else UIDisplay:= uiAll
677     end
678 else
679     begin
680     if UIDisplay <> uiNoTeams then
681          UIDisplay:= uiNoTeams
682     else UIDisplay:= uiAll
683     end
684 end;
685 
686 procedure chRotateTags(var s: shortstring);
687 begin
688 s:= s; // avoid compiler hint
689 // Rotate Tags key + Switch: Toggle translucency only
690 if LocalMessage and gmSwitch = gmSwitch then
691     if ((cTagsMask and htTransparent) = 0) then
692         begin
693         cTagsMask:= cTagsMask or htTransparent;
694         cPrevTagsMask:= cPrevTagsMask or htTransparent
695         end
696     else
697         begin
698         cTagsMask:= cTagsMask and (not htTransparent);
699         cPrevTagsMask:= cPrevTagsMask and (not htTransparent)
700         end
701 // Rotate Tags key + Precise: Cycle through hog tags (keeping translucency)
702 else if LocalMessage and gmPrecise = gmPrecise then
703     begin
704     cPrevTagsMask:= cTagsMask;
705     if ((GameFlags and gfInvulnerable) = 0) then
706         cTagsMask:= cTagsMasks[cTagsMask]
707     else
708         cTagsMask:= cTagsMasksNoHealth[cTagsMask]
709     end
710 // Rotate Tags key only: Toggle all hog tags on and off
711 else
712     if ((cTagsMask and (htTeamName or htName or htHealth)) = 0) then
713         begin
714         cTagsMask:= cPrevTagsMask;
715         if ((GameFlags and gfInvulnerable) <> 0) then
716             cTagsMask:= cTagsMask and (not htHealth);
717         end
718     else
719         begin
720         cPrevTagsMask:= cTagsMask;
721         cTagsMask:= cTagsMask and (not (htTeamName or htName or htHealth))
722         end;
723 end;
724 
725 procedure chSpeedup_p(var s: shortstring);
726 begin
727 s:= s; // avoid compiler hint
728 SpeedStart:= RealTicks;
729 isSpeed:= true
730 end;
731 
732 procedure chSpeedup_m(var s: shortstring);
733 begin
734 s:= s; // avoid compiler hint
735 isSpeed:= false
736 end;
737 
738 procedure chZoomIn(var s: shortstring);
739 begin
740     s:= s; // avoid compiler hint
741     if (LocalMessage and gmPrecise <> 0) then
742         ZoomValue:= ZoomValue + cZoomDeltaSmall
743     else
744         ZoomValue:= ZoomValue + cZoomDelta;
745     if ZoomValue > cMinZoomLevel then
746         ZoomValue:= cMinZoomLevel;
747 end;
748 
749 procedure chZoomOut(var s: shortstring);
750 begin
751     s:= s; // avoid compiler hint
752     if (LocalMessage and gmPrecise <> 0) then
753         ZoomValue:= ZoomValue - cZoomDeltaSmall
754     else
755         ZoomValue:= ZoomValue - cZoomDelta;
756     if ZoomValue < cMaxZoomLevel then
757         ZoomValue:= cMaxZoomLevel;
758 end;
759 
760 procedure chZoomReset(var s: shortstring);
761 begin
762     s:= s; // avoid compiler hint
763     if (LocalMessage and gmPrecise <> 0) then
764         ZoomValue:= cDefaultZoomLevel
765     else
766         ZoomValue:= UserZoom;
767 end;
768 
769 procedure chMapGen(var s: shortstring);
770 begin
771 cMapGen:= TMapGen(StrToInt(s))
772 end;
773 
774 procedure chTemplateFilter(var s: shortstring);
775 begin
776 cTemplateFilter:= StrToInt(s)
777 end;
778 
779 procedure chFeatureSize(var s: shortstring);
780 begin
781 cFeatureSize:= StrToInt(s)
782 end;
783 
784 procedure chInactDelay(var s: shortstring);
785 begin
786 cInactDelay:= StrToInt(s)
787 end;
788 
789 procedure chReadyDelay(var s: shortstring);
790 begin
791 cReadyDelay:= StrToInt(s)
792 end;
793 
794 procedure chCaseFactor(var s: shortstring);
795 begin
796 cCaseFactor:= StrToInt(s)
797 end;
798 
799 procedure chHealthCaseProb(var s: shortstring);
800 begin
801 cHealthCaseProb:= StrToInt(s)
802 end;
803 
804 procedure chHealthCaseAmount(var s: shortstring);
805 begin
806 cHealthCaseAmount:= StrToInt(s)
807 end;
808 
809 procedure chSuddenDTurns(var s: shortstring);
810 begin
811 cSuddenDTurns:= StrToInt(s)
812 end;
813 
814 procedure chWaterRise(var s: shortstring);
815 begin
816 cWaterRise:= StrToInt(s)
817 end;
818 
819 procedure chHealthDecrease(var s: shortstring);
820 begin
821 cHealthDecrease:= StrToInt(s)
822 end;
823 
824 procedure chInitHealth(var s: shortstring);
825 begin
826 cInitHealth:= StrToInt(s)
827 end;
828 
829 procedure chDamagePercent(var s: shortstring);
830 begin
831 cDamagePercent:= StrToInt(s)
832 end;
833 
834 procedure chRopePercent(var s: shortstring);
835 begin
836 cRopePercent:= StrToInt(s)
837 end;
838 
839 procedure chGetAwayTime(var s: shortstring);
840 begin
841 cGetAwayTime:= StrToInt(s)
842 end;
843 
844 procedure chMineDudPercent(var s: shortstring);
845 begin
846 cMineDudPercent:= StrToInt(s)
847 end;
848 
849 procedure chLandMines(var s: shortstring);
850 begin
851 cLandMines:= StrToInt(s)
852 end;
853 
854 procedure chAirMines(var s: shortstring);
855 begin
856 cAirMines:= StrToInt(s)
857 end;
858 
859 procedure chExplosives(var s: shortstring);
860 begin
861 cExplosives:= StrToInt(s)
862 end;
863 
864 procedure chGameFlags(var s: shortstring);
865 begin
866 GameFlags:= StrToInt(s);
867 if GameFlags and gfSharedAmmo <> 0 then GameFlags:= GameFlags and (not gfPerHogAmmo)
868 end;
869 
870 procedure chHedgehogTurnTime(var s: shortstring);
871 begin
872 cHedgehogTurnTime:= StrToInt(s)
873 end;
874 
875 procedure chMinesTime(var s: shortstring);
876 begin
877 cMinesTime:= StrToInt(s)
878 end;
879 
880 procedure chFastUntilLag(var s: shortstring);
881 begin
882     fastUntilLag:= StrToInt(s) <> 0;
883 
884     if not fastUntilLag then
885     begin
886         // update health bars and the wind indicator
887         AddVisualGear(0, 0, vgtTeamHealthSorter);
888         AddVisualGear(0, 0, vgtSmoothWindBar)
889     end
890 end;
891 
892 procedure chCampVar(var s:shortstring);
893 begin
894   CampaignVariable := s;
895 end;
896 
897 procedure chMissVar(var s:shortstring);
898 begin
899   MissionVariable := s;
900 end;
901 
902 procedure chWorldEdge(var s: shortstring);
903 begin
904 WorldEdge:= TWorldEdge(StrToInt(s))
905 end;
906 
907 procedure chAdvancedMapGenMode(var s:shortstring);
908 begin
909   s:= s; // avoid compiler hint
910   cAdvancedMapGenMode:= true;
911 end;
912 
913 procedure chShowMission_p(var s: shortstring);
914 begin
915   s:= s; // avoid compiler hint
916   isShowMission:= true;
917 end;
918 
919 procedure chShowMission_m(var s: shortstring);
920 begin
921   s:= s; // avoid compiler hint
922   isShowMission:= false;
923   if (not isForceMission) then
924     HideMission();
925 end;
926 
927 procedure chGearInfo(var s: shortstring);
928 begin
929   s:= s; // avoid compiler hint
930   isShowGearInfo:= not isShowGearInfo;
931 end;
932 
933 procedure initModule;
934 begin
935 //////// Begin top sorted by freq analysis not including chatmsg
936     RegisterVariable('+right'  , @chRight_p      , false, true);
937     RegisterVariable('-right'  , @chRight_m      , false, true);
938     RegisterVariable('+up'     , @chUp_p         , false, true);
939     RegisterVariable('-up'     , @chUp_m         , false, true);
940     RegisterVariable('+left'   , @chLeft_p       , false, true);
941     RegisterVariable('-left'   , @chLeft_m       , false, true);
942     RegisterVariable('+attack' , @chAttack_p     , false);
943     RegisterVariable('+down'   , @chDown_p       , false, true);
944     RegisterVariable('-down'   , @chDown_m       , false, true);
945     RegisterVariable('hjump'   , @chHJump        , false, true);
946     RegisterVariable('ljump'   , @chLJump        , false, true);
947     RegisterVariable('nextturn', @chNextTurn     , false);
948     RegisterVariable('-attack' , @chAttack_m     , false);
949     RegisterVariable('slot'    , @chSlot         , false);
950     RegisterVariable('setweap' , @chSetWeapon    , false, true);
951 //////// End top by freq analysis
952     RegisterVariable('gencmd'  , @chGenCmd       , false);
953     RegisterVariable('script'  , @chScript       , false);
954     RegisterVariable('scriptparam', @chScriptParam, false);
955     RegisterVariable('proto'   , @chCheckProto   , true );
956     RegisterVariable('spectate', @chFastUntilLag   , false);
957     RegisterVariable('capture' , @chCapture      , true );
958     RegisterVariable('rotmask' , @chRotateMask   , true );
959     RegisterVariable('rottags' , @chRotateTags   , true );
960     RegisterVariable('rdriven' , @chTeamLocal    , false);
961     RegisterVariable('map'     , @chSetMap       , false);
962     RegisterVariable('theme'   , @chSetTheme     , false);
963     RegisterVariable('seed'    , @chSetSeed      , false);
964     RegisterVariable('template_filter', @chTemplateFilter, false);
965     RegisterVariable('mapgen'  , @chMapGen        , false);
966     RegisterVariable('maze_size',@chTemplateFilter, false);
967     RegisterVariable('feature_size',@chFeatureSize, false);
968     RegisterVariable('delay'   , @chInactDelay    , false);
969     RegisterVariable('ready'   , @chReadyDelay    , false);
970     RegisterVariable('casefreq', @chCaseFactor    , false);
971     RegisterVariable('healthprob', @chHealthCaseProb, false);
972     RegisterVariable('hcaseamount', @chHealthCaseAmount, false);
973     RegisterVariable('sd_turns', @chSuddenDTurns  , false);
974     RegisterVariable('waterrise', @chWaterRise    , false);
975     RegisterVariable('healthdec', @chHealthDecrease, false);
976     RegisterVariable('inithealth',@chInitHealth, false);
977     RegisterVariable('damagepct',@chDamagePercent , false);
978     RegisterVariable('ropepct' , @chRopePercent   , false);
979     RegisterVariable('getawaytime' , @chGetAwayTime , false);
980     RegisterVariable('minedudpct',@chMineDudPercent, false);
981     RegisterVariable('minesnum', @chLandMines     , false);
982     RegisterVariable('airmines', @chAirMines      , false);
983     RegisterVariable('explosives',@chExplosives    , false);
984     RegisterVariable('gmflags' , @chGameFlags      , false);
985     RegisterVariable('turntime', @chHedgehogTurnTime, false);
986     RegisterVariable('minestime',@chMinesTime     , false);
987     RegisterVariable('quit'    , @chQuit         , true );
988     RegisterVariable('forcequit', @chForceQuit   , true );
989     RegisterVariable('confirm' , @chConfirm      , true );
990     RegisterVariable('halt',     @chHalt         , true );
991     RegisterVariable('+speedup', @chSpeedup_p    , true );
992     RegisterVariable('-speedup', @chSpeedup_m    , true );
993     RegisterVariable('zoomin'  , @chZoomIn       , true );
994     RegisterVariable('zoomout' , @chZoomOut      , true );
995     RegisterVariable('zoomreset',@chZoomReset    , true );
996     RegisterVariable('ammomenu', @chAmmoMenu     , true);
997     RegisterVariable('+precise', @chPrecise_p    , false, true);
998     RegisterVariable('-precise', @chPrecise_m    , false, true);
999     RegisterVariable('switch'  , @chSwitch       , false);
1000     RegisterVariable('timer'   , @chTimer        , false, true);
1001     RegisterVariable('taunt'   , @chTaunt        , false);
1002     RegisterVariable('put'     , @chPut          , false);
1003     RegisterVariable('+volup'  , @chVolUp_p      , true );
1004     RegisterVariable('-volup'  , @chVolUp_m      , true );
1005     RegisterVariable('+voldown', @chVolDown_p    , true );
1006     RegisterVariable('-voldown', @chVolDown_m    , true );
1007     RegisterVariable('mute'    , @chMute         , true );
1008     RegisterVariable('findhh'  , @chFindhh       , true );
1009     RegisterVariable('pause'   , @chPause        , true );
1010     RegisterVariable('+cur_u'  , @chCurU_p       , true );
1011     RegisterVariable('-cur_u'  , @chCurU_m       , true );
1012     RegisterVariable('+cur_d'  , @chCurD_p       , true );
1013     RegisterVariable('-cur_d'  , @chCurD_m       , true );
1014     RegisterVariable('+cur_l'  , @chCurL_p       , true );
1015     RegisterVariable('-cur_l'  , @chCurL_m       , true );
1016     RegisterVariable('+cur_r'  , @chCurR_p       , true );
1017     RegisterVariable('-cur_r'  , @chCurR_m       , true );
1018     RegisterVariable('campvar' , @chCampVar      , true );
1019     RegisterVariable('missvar' , @chMissVar      , true );
1020     RegisterVariable('record'  , @chRecord       , true );
1021     RegisterVariable('worldedge',@chWorldEdge    , false);
1022     RegisterVariable('advmapgen',@chAdvancedMapGenMode, false);
1023     RegisterVariable('+mission', @chShowMission_p, true);
1024     RegisterVariable('-mission', @chShowMission_m, true);
1025     RegisterVariable('gearinfo', @chGearInfo     , true );
1026     RegisterVariable('timer_u' , @chTimerU       , true );
1027 end;
1028 
1029 procedure freeModule;
1030 begin
1031 end;
1032 
1033 end.
1034