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