Completely arbitrary tweaking of tunnel values (avoids a nil) - still needs smooth curves (probably a target dx/dy to aim for, and slow alterations) and taking less CPU. Also disable unused function in Highlander
(* * Hedgewars, a free turn based strategy game * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com> * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; version 2 of the License * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA *){$INCLUDE "options.inc"}unit uCommandHandlers;interfaceprocedure initModule;procedure freeModule;implementationuses uCommands, uTypes, uVariables, uIO, uDebug, uConsts, uScript, uUtils, SDLh, uRandom, uCaptions {$IFDEF USE_VIDEO_RECORDING}, uVideoRec {$ENDIF};var prevGState: TGameState = gsConfirm;procedure chGenCmd(var s: shortstring);begincase s[1] of 'R': if ReadyTimeLeft > 1 then begin ReadyTimeLeft:= 1; if not CurrentTeam^.ExtDriven then SendIPC('c'+s); end endend;procedure chQuit(var s: shortstring);begin s:= s; // avoid compiler hint if (GameState = gsGame) or (GameState = gsChat) then begin prevGState:= GameState; GameState:= gsConfirm; SDL_ShowCursor(1) end else if GameState = gsConfirm then begin GameState:= prevGState; SDL_ShowCursor(ord(isPaused)) endend;procedure chForceQuit(var s: shortstring);begin s:= s; // avoid compiler hint GameState:= gsConfirm; ParseCommand('confirm', true);end;procedure chConfirm(var s: shortstring);begin s:= s; // avoid compiler hint if GameState = gsConfirm then begin SendIPC(_S'Q'); GameState:= gsExit end else ParseCommand('chat team', true);end;procedure chHalt (var s: shortstring);begin s:= s; // avoid compiler hint SendIPC(_S'H'); GameState:= gsExitend;procedure chCheckProto(var s: shortstring);var i, c: LongInt;begin if isDeveloperMode then begin val(s, i, c); TryDo(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old (got '+intToStr(i)+', expecting '+intToStr(cNetProtoVersion)+')', true); TryDo(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new (got '+intToStr(i)+', expecting '+intToStr(cNetProtoVersion)+')', true); endend;procedure chTeamLocal(var s: shortstring);begins:= s; // avoid compiler hintif not isDeveloperMode then exit;if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true);CurrentTeam^.ExtDriven:= trueend;procedure chGrave(var s: shortstring);beginif CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);if s[1]='"' then Delete(s, 1, 1);if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);CurrentTeam^.GraveName:= send;procedure chFort(var s: shortstring);beginif CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/fort"', true);if s[1]='"' then Delete(s, 1, 1);if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);CurrentTeam^.FortName:= send;procedure chFlag(var s: shortstring);beginif CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/flag"', true);if s[1]='"' then Delete(s, 1, 1);if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);CurrentTeam^.flag:= send;procedure chScript(var s: shortstring);beginif s[1]='"' then Delete(s, 1, 1);if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);cScriptName:= s;ScriptLoad(s)end;procedure chSetHat(var s: shortstring);beginif (not isDeveloperMode) or (CurrentTeam = nil) then exit;with CurrentTeam^ do begin if not CurrentHedgehog^.King then if (s = '') or (((GameFlags and gfKing) <> 0) and (s = 'crown')) or ((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then CurrentHedgehog^.Hat:= 'NoHat' else CurrentHedgehog^.Hat:= s end;end;procedure chCurU_p(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementY:= -1;end;procedure chCurU_m(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementY:= 0;end;procedure chCurD_p(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementY:= 1;end;procedure chCurD_m(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementY:= 0;end;procedure chCurL_p(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementX:= -1;end;procedure chCurL_m(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementX:= 0;end;procedure chCurR_p(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementX:= 1;end;procedure chCurR_m(var s: shortstring);begins:= s; // avoid compiler hintCursorMovementX:= 0;end;procedure chLeft_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'L');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmLeft and InputMask); ScriptCall('onLeft');end;procedure chLeft_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'l');with CurrentHedgehog^.Gear^ do Message:= Message and (not (gmLeft and InputMask)); ScriptCall('onLeftUp');end;procedure chRight_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'R');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmRight and InputMask); ScriptCall('onRight');end;procedure chRight_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'r');with CurrentHedgehog^.Gear^ do Message:= Message and (not (gmRight and InputMask)); ScriptCall('onRightUp');end;procedure chUp_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'U');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmUp and InputMask); ScriptCall('onUp');end;procedure chUp_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'u');with CurrentHedgehog^.Gear^ do Message:= Message and (not (gmUp and InputMask)); ScriptCall('onUpUp');end;procedure chDown_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'D');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmDown and InputMask); ScriptCall('onDown');end;procedure chDown_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'd');with CurrentHedgehog^.Gear^ do Message:= Message and (not (gmDown and InputMask)); ScriptCall('onDownUp');end;procedure chPrecise_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'Z');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmPrecise and InputMask); ScriptCall('onPrecise');end;procedure chPrecise_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'z');with CurrentHedgehog^.Gear^ do Message:= Message and (not (gmPrecise and InputMask)); ScriptCall('onPreciseUp');end;procedure chLJump(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'j');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmLJump and InputMask); ScriptCall('onLJump');end;procedure chHJump(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'J');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmHJump and InputMask); ScriptCall('onHJump');end;procedure chAttack_p(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;bShowFinger:= false;with CurrentHedgehog^.Gear^ do begin AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State)); if ((State and gstHHDriven) <> 0) then begin FollowGear:= CurrentHedgehog^.Gear; if not CurrentTeam^.ExtDriven then SendIPC(_S'A'); Message:= Message or (gmAttack and InputMask); ScriptCall('onAttack'); end endend;procedure chAttack_m(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then exit;with CurrentHedgehog^.Gear^ do begin if not CurrentTeam^.ExtDriven and ((Message and gmAttack) <> 0) then SendIPC(_S'a'); Message:= Message and (not (gmAttack and InputMask)); ScriptCall('onAttackUp'); endend;procedure chSwitch(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if not CurrentTeam^.ExtDriven then SendIPC(_S'S');bShowFinger:= false;with CurrentHedgehog^.Gear^ do Message:= Message or (gmSwitch and InputMask); ScriptCall('onSwitch');end;procedure chNextTurn(var s: shortstring);var gi: PGear;begin s:= s; // avoid compiler hint TryDo(AllInactive, '/nextturn called when not all gears are inactive', true); CheckSum:= CheckSum xor GameTicks; gi := GearsList; while gi <> nil do begin 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; AddRandomness(CheckSum); gi := gi^.NextGear end; if not CurrentTeam^.ExtDriven then begin s[0]:= #5; s[1]:= 'N'; SDLNet_Write32(CheckSum, @s[2]); SendIPC(s) end else TryDo(CheckSum = lastTurnChecksum, 'Desync detected', true); AddFileLog('Next turn: time '+inttostr(GameTicks));end;procedure chTimer(var s: shortstring);beginif CheckNoTeamOrHH then exit;TryDo((s[0] = #1) and (s[1] >= '1') and (s[1] <= '5'), 'Malformed /timer', true);if not CurrentTeam^.ExtDriven then SendIPC(s);bShowFinger:= false;with CurrentHedgehog^.Gear^ do begin Message:= Message or (gmTimer and InputMask); MsgParam:= byte(s[1]) - ord('0'); ScriptCall('onTimer', MsgParam); endend;procedure chSlot(var s: shortstring);var slot: LongWord; ss: shortstring;beginif (s[0] <> #1) or CheckNoTeamOrHH then exit;slot:= byte(s[1]) - 49;if slot > cMaxSlotIndex then exit;if not CurrentTeam^.ExtDriven then begin ss[0]:= #1; ss[1]:= char(byte(s[1]) + 79); SendIPC(ss); end;bShowFinger:= false;with CurrentHedgehog^.Gear^ do begin Message:= Message or (gmSlot and InputMask); MsgParam:= slot; ScriptCall('onSlot', MsgParam); endend;procedure chSetWeapon(var s: shortstring);begin if CheckNoTeamOrHH then exit; TryDo((s[0] = #1) and (s[1] <= char(High(TAmmoType))), 'Malformed /setweap', true); if not CurrentTeam^.ExtDriven then SendIPC('w' + s); with CurrentHedgehog^.Gear^ do begin Message:= Message or (gmWeapon and InputMask); MsgParam:= byte(s[1]); ScriptCall('onSetWeapon', MsgParam); end;end;procedure chTaunt(var s: shortstring);beginif (s[0] <> #1) or CheckNoTeamOrHH then exit;if TWave(s[1]) > High(TWave) then exit;if not CurrentTeam^.ExtDriven then SendIPC('t' + s);with CurrentHedgehog^.Gear^ do begin Message:= Message or (gmAnimate and InputMask); MsgParam:= byte(s[1]) ; ScriptCall('onTaunt', MsgParam); endend;procedure chPut(var s: shortstring);begin s:= s; // avoid compiler hint doPut(0, 0, false);end;procedure chCapture(var s: shortstring);begins:= s; // avoid compiler hintflagMakeCapture:= trueend;procedure chRecord(var s: shortstring);begins:= s; // avoid compiler hint{$IFDEF USE_VIDEO_RECORDING}if flagPrerecording then StopPreRecording()else BeginPreRecording();{$ENDIF}end;procedure chSetMap(var s: shortstring);beginif isDeveloperMode then begin if s = '' then begin UserPathz[ptMapCurrent]:= s; Pathz[ptMapCurrent]:= s; end else begin UserPathz[ptMapCurrent]:= UserPathz[ptMaps] + '/' + s; Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s; end; InitStepsFlags:= InitStepsFlags or cifMap end;cMapName:= s;ScriptLoad('Maps/' + s + '/map.lua')end;procedure chSetTheme(var s: shortstring);beginif isDeveloperMode then begin UserPathz[ptCurrTheme]:= UserPathz[ptThemes] + '/' + s; Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s; Theme:= s; InitStepsFlags:= InitStepsFlags or cifTheme endend;procedure chSetSeed(var s: shortstring);beginif isDeveloperMode then begin SetRandomSeed(s); cSeed:= s; InitStepsFlags:= InitStepsFlags or cifRandomize end end;procedure chAmmoMenu(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH then bShowAmmoMenu:= trueelse begin with CurrentTeam^ do with Hedgehogs[CurrHedgehog] do begin bSelected:= false; if bShowAmmoMenu then bShowAmmoMenu:= false else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or ((MultiShootAttacks > 0) and ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoRoundEnd) = 0)) or ((Gear^.State and gstHHDriven) = 0) then begin end else bShowAmmoMenu:= true end; endend;procedure chVol_p(var s: shortstring);begins:= s; // avoid compiler hintinc(cVolumeDelta, 3)end;procedure chVol_m(var s: shortstring);begins:= s; // avoid compiler hintdec(cVolumeDelta, 3)end;procedure chFindhh(var s: shortstring);begins:= s; // avoid compiler hintif CheckNoTeamOrHH or isPaused then exit;if autoCameraOn then begin FollowGear:= nil; AddCaption('Auto Camera Off', $CCCCCC, capgrpVolume); autoCameraOn:= false endelse begin AddCaption('Auto Camera On', $CCCCCC, capgrpVolume); bShowFinger:= true; if not CurrentHedgehog^.Unplaced then FollowGear:= CurrentHedgehog^.Gear; autoCameraOn:= true endend;procedure chPause(var s: shortstring);begins:= s; // avoid compiler hintif gameType <> gmtNet then isPaused:= not isPaused;if isPaused then SDL_ShowCursor(1) else SDL_ShowCursor(ord(GameState = gsConfirm))end;procedure chRotateMask(var s: shortstring);begins:= s; // avoid compiler hintif ((GameFlags and gfInvulnerable) = 0) then cTagsMask:= cTagsMasks[cTagsMask]else cTagsMask:= cTagsMasksNoHealth[cTagsMask];end;procedure chSpeedup_p(var s: shortstring);begins:= s; // avoid compiler hintSpeedStart:= RealTicks;isSpeed:= trueend;procedure chSpeedup_m(var s: shortstring);begins:= s; // avoid compiler hintisSpeed:= falseend;procedure chZoomIn(var s: shortstring);begin s:= s; // avoid compiler hint if ZoomValue < cMinZoomLevel then ZoomValue:= ZoomValue + cZoomDelta;end;procedure chZoomOut(var s: shortstring);begin s:= s; // avoid compiler hint if ZoomValue > cMaxZoomLevel then ZoomValue:= ZoomValue - cZoomDelta;end;procedure chZoomReset(var s: shortstring);begin s:= s; // avoid compiler hint ZoomValue:= cDefaultZoomLevel;end;procedure chMapGen(var s: shortstring);begincMapGen:= StrToInt(s)end;procedure chTemplateFilter(var s: shortstring);begincTemplateFilter:= StrToInt(s)end;procedure chInactDelay(var s: shortstring);begincInactDelay:= StrToInt(s)end;procedure chReadyDelay(var s: shortstring);begincReadyDelay:= StrToInt(s)end;procedure chCaseFactor(var s: shortstring);begincCaseFactor:= StrToInt(s)end;procedure chHealthCaseProb(var s: shortstring);begincHealthCaseProb:= StrToInt(s)end;procedure chHealthCaseAmount(var s: shortstring);begincHealthCaseAmount:= StrToInt(s)end;procedure chSuddenDTurns(var s: shortstring);begincSuddenDTurns:= StrToInt(s)end;procedure chWaterRise(var s: shortstring);begincWaterRise:= StrToInt(s)end;procedure chHealthDecrease(var s: shortstring);begincHealthDecrease:= StrToInt(s)end;procedure chDamagePercent(var s: shortstring);begincDamagePercent:= StrToInt(s)end;procedure chRopePercent(var s: shortstring);begincRopePercent:= StrToInt(s)end;procedure chGetAwayTime(var s: shortstring);begincGetAwayTime:= StrToInt(s)end;procedure chMineDudPercent(var s: shortstring);begincMineDudPercent:= StrToInt(s)end;procedure chLandMines(var s: shortstring);begincLandMines:= StrToInt(s)end;procedure chExplosives(var s: shortstring);begincExplosives:= StrToInt(s)end;procedure chGameFlags(var s: shortstring);beginGameFlags:= StrToInt(s);if GameFlags and gfSharedAmmo <> 0 then GameFlags:= GameFlags and (not gfPerHogAmmo)end;procedure chHedgehogTurnTime(var s: shortstring);begincHedgehogTurnTime:= StrToInt(s)end;procedure chMinesTime(var s: shortstring);begincMinesTime:= StrToInt(s)end;procedure chFastUntilLag(var s: shortstring);beginfastUntilLag:= StrToInt(s) <> 0end;procedure chCampVar(var s:shortstring);begin CampaignVariable := s;end;procedure initModule;begin//////// Begin top sorted by freq analysis not including chatmsg RegisterVariable('+right' , @chRight_p , false, true); RegisterVariable('-right' , @chRight_m , false, true); RegisterVariable('+up' , @chUp_p , false, true); RegisterVariable('-up' , @chUp_m , false, true); RegisterVariable('+left' , @chLeft_p , false, true); RegisterVariable('-left' , @chLeft_m , false, true); RegisterVariable('+attack' , @chAttack_p , false); RegisterVariable('+down' , @chDown_p , false, true); RegisterVariable('-down' , @chDown_m , false, true); RegisterVariable('hjump' , @chHJump , false, true); RegisterVariable('ljump' , @chLJump , false, true); RegisterVariable('nextturn', @chNextTurn , false); RegisterVariable('-attack' , @chAttack_m , false); RegisterVariable('slot' , @chSlot , false); RegisterVariable('setweap' , @chSetWeapon , false, true);//////// End top by freq analysis RegisterVariable('gencmd' , @chGenCmd , false); RegisterVariable('flag' , @chFlag , false); RegisterVariable('script' , @chScript , false); RegisterVariable('proto' , @chCheckProto , true ); RegisterVariable('spectate', @chFastUntilLag , false); RegisterVariable('capture' , @chCapture , true ); RegisterVariable('rotmask' , @chRotateMask , true ); RegisterVariable('rdriven' , @chTeamLocal , false); RegisterVariable('map' , @chSetMap , false); RegisterVariable('theme' , @chSetTheme , false); RegisterVariable('seed' , @chSetSeed , false); RegisterVariable('template_filter', @chTemplateFilter, false); RegisterVariable('mapgen' , @chMapGen , false); RegisterVariable('maze_size',@chTemplateFilter, false); RegisterVariable('delay' , @chInactDelay , false); RegisterVariable('ready' , @chReadyDelay , false); RegisterVariable('casefreq', @chCaseFactor , false); RegisterVariable('healthprob', @chHealthCaseProb, false); RegisterVariable('hcaseamount', @chHealthCaseAmount, false); RegisterVariable('sd_turns', @chSuddenDTurns , false); RegisterVariable('waterrise', @chWaterRise , false); RegisterVariable('healthdec', @chHealthDecrease, false); RegisterVariable('damagepct',@chDamagePercent , false); RegisterVariable('ropepct' , @chRopePercent , false); RegisterVariable('getawaytime' , @chGetAwayTime , false); RegisterVariable('minedudpct',@chMineDudPercent, false); RegisterVariable('minesnum', @chLandMines , false); RegisterVariable('explosives',@chExplosives , false); RegisterVariable('gmflags' , @chGameFlags , false); RegisterVariable('turntime', @chHedgehogTurnTime, false); RegisterVariable('minestime',@chMinesTime , false); RegisterVariable('fort' , @chFort , false); RegisterVariable('grave' , @chGrave , false); RegisterVariable('hat' , @chSetHat , false); RegisterVariable('quit' , @chQuit , true ); RegisterVariable('forcequit', @chForceQuit , true ); RegisterVariable('confirm' , @chConfirm , true ); RegisterVariable('halt', @chHalt , true ); RegisterVariable('+speedup', @chSpeedup_p , true ); RegisterVariable('-speedup', @chSpeedup_m , true ); RegisterVariable('zoomin' , @chZoomIn , true ); RegisterVariable('zoomout' , @chZoomOut , true ); RegisterVariable('zoomreset',@chZoomReset , true ); RegisterVariable('ammomenu', @chAmmoMenu , true); RegisterVariable('+precise', @chPrecise_p , false, true); RegisterVariable('-precise', @chPrecise_m , false, true); RegisterVariable('switch' , @chSwitch , false); RegisterVariable('timer' , @chTimer , false, true); RegisterVariable('taunt' , @chTaunt , false); RegisterVariable('put' , @chPut , false); RegisterVariable('+volup' , @chVol_p , true ); RegisterVariable('-volup' , @chVol_m , true ); RegisterVariable('+voldown', @chVol_m , true ); RegisterVariable('-voldown', @chVol_p , true ); RegisterVariable('findhh' , @chFindhh , true ); RegisterVariable('pause' , @chPause , true ); RegisterVariable('+cur_u' , @chCurU_p , true ); RegisterVariable('-cur_u' , @chCurU_m , true ); RegisterVariable('+cur_d' , @chCurD_p , true ); RegisterVariable('-cur_d' , @chCurD_m , true ); RegisterVariable('+cur_l' , @chCurL_p , true ); RegisterVariable('-cur_l' , @chCurL_m , true ); RegisterVariable('+cur_r' , @chCurR_p , true ); RegisterVariable('-cur_r' , @chCurR_m , true ); RegisterVariable('campvar' , @chCampVar , true ); RegisterVariable('record' , @chRecord , true );end;procedure freeModule;beginend;end.