Scheme definitions now use .ini files.
(*
* 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;
interface
procedure initModule;
procedure freeModule;
implementation
uses uCommands, uTypes, uVariables, uIO, uDebug, uConsts, uScript, uUtils, SDLh, uRandom, uCaptions;
procedure chGenCmd(var s: shortstring);
begin
case s[1] of
'R': if ReadyTimeLeft > 1 then
begin
ReadyTimeLeft:= 1;
if not CurrentTeam^.ExtDriven then
SendIPC('c'+s);
end
end
end;
procedure chQuit(var s: shortstring);
const prevGState: TGameState = gsConfirm;
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))
end
end;
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('Q');
GameState:= gsExit
end
else
ParseCommand('chat team', true);
end;
procedure chHalt (var s: shortstring);
begin
s:= s; // avoid compiler hint
SendIPC('H');
GameState:= gsExit
end;
procedure chCheckProto(var s: shortstring);
var i, c: LongInt;
begin
if isDeveloperMode then
begin
val(s, i, c);
if (c <> 0) or (i = 0) then
exit;
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);
end
end;
procedure chTeamLocal(var s: shortstring);
begin
s:= s; // avoid compiler hint
if not isDeveloperMode then
exit;
if CurrentTeam = nil then
OutError(errmsgIncorrectUse + ' "/rdriven"', true);
CurrentTeam^.ExtDriven:= true
end;
procedure chGrave(var s: shortstring);
begin
if 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:= s
end;
procedure chFort(var s: shortstring);
begin
if 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:= s
end;
procedure chFlag(var s: shortstring);
begin
if 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:= s
end;
procedure chScript(var s: shortstring);
begin
if 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);
begin
if (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);
begin
s:= s; // avoid compiler hint
CursorMovementY:= -1;
end;
procedure chCurU_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementY:= 0;
end;
procedure chCurD_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementY:= 1;
end;
procedure chCurD_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementY:= 0;
end;
procedure chCurL_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementX:= -1;
end;
procedure chCurL_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementX:= 0;
end;
procedure chCurR_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementX:= 1;
end;
procedure chCurR_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
CursorMovementX:= 0;
end;
procedure chLeft_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('L');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmLeft and InputMask);
ScriptCall('onLeft');
end;
procedure chLeft_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('l');
with CurrentHedgehog^.Gear^ do
Message:= Message and (not (gmLeft and InputMask));
ScriptCall('onLeftUp');
end;
procedure chRight_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('R');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmRight and InputMask);
ScriptCall('onRight');
end;
procedure chRight_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('r');
with CurrentHedgehog^.Gear^ do
Message:= Message and (not (gmRight and InputMask));
ScriptCall('onRightUp');
end;
procedure chUp_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('U');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmUp and InputMask);
ScriptCall('onUp');
end;
procedure chUp_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('u');
with CurrentHedgehog^.Gear^ do
Message:= Message and (not (gmUp and InputMask));
ScriptCall('onUpUp');
end;
procedure chDown_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('D');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmDown and InputMask);
ScriptCall('onDown');
end;
procedure chDown_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('d');
with CurrentHedgehog^.Gear^ do
Message:= Message and (not (gmDown and InputMask));
ScriptCall('onDownUp');
end;
procedure chPrecise_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('Z');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmPrecise and InputMask);
ScriptCall('onPrecise');
end;
procedure chPrecise_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('z');
with CurrentHedgehog^.Gear^ do
Message:= Message and (not (gmPrecise and InputMask));
ScriptCall('onPreciseUp');
end;
procedure chLJump(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('j');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmLJump and InputMask);
ScriptCall('onLJump');
end;
procedure chHJump(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('J');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmHJump and InputMask);
ScriptCall('onHJump');
end;
procedure chAttack_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
if 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('A');
Message:= Message or (gmAttack and InputMask);
ScriptCall('onAttack');
end
end
end;
procedure chAttack_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
with CurrentHedgehog^.Gear^ do
begin
if not CurrentTeam^.ExtDriven and
((Message and gmAttack) <> 0) then
SendIPC('a');
Message:= Message and (not (gmAttack and InputMask));
ScriptCall('onAttackUp');
end
end;
procedure chSwitch(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC('S');
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
Message:= Message or (gmSwitch and InputMask);
ScriptCall('onSwitch');
end;
procedure chNextTurn(var s: shortstring);
begin
s:= s; // avoid compiler hint
TryDo(AllInactive, '/nextturn called when not all gears are inactive', true);
if not CurrentTeam^.ExtDriven then
SendIPC('N');
AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));
end;
procedure chTimer(var s: shortstring);
begin
if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or CheckNoTeamOrHH then
exit;
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);
end
end;
procedure chSlot(var s: shortstring);
var slot: LongWord;
begin
if (s[0] <> #1) or CheckNoTeamOrHH then
exit;
slot:= byte(s[1]) - 49;
if slot > cMaxSlotIndex then
exit;
if not CurrentTeam^.ExtDriven then
SendIPC(char(byte(s[1]) + 79));
bShowFinger:= false;
with CurrentHedgehog^.Gear^ do
begin
Message:= Message or (gmSlot and InputMask);
MsgParam:= slot;
ScriptCall('onSlot', MsgParam);
end
end;
procedure chSetWeapon(var s: shortstring);
begin
if (s[0] <> #1) or CheckNoTeamOrHH then
exit;
if TAmmoType(s[1]) > High(TAmmoType) then
exit;
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);
begin
if (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);
end
end;
procedure chPut(var s: shortstring);
begin
s:= s; // avoid compiler hint
doPut(0, 0, false);
end;
procedure chCapture(var s: shortstring);
begin
s:= s; // avoid compiler hint
flagMakeCapture:= true
end;
procedure chSetMap(var s: shortstring);
begin
if 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);
begin
if isDeveloperMode then
begin
UserPathz[ptCurrTheme]:= UserPathz[ptThemes] + '/' + s;
Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s;
Theme:= s;
InitStepsFlags:= InitStepsFlags or cifTheme
end
end;
procedure chSetSeed(var s: shortstring);
begin
if isDeveloperMode then
begin
SetRandomSeed(s);
cSeed:= s;
InitStepsFlags:= InitStepsFlags or cifRandomize
end
end;
procedure chAmmoMenu(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH then
bShowAmmoMenu:= true
else
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;
end
end;
procedure chVol_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
inc(cVolumeDelta, 3)
end;
procedure chVol_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
dec(cVolumeDelta, 3)
end;
procedure chFindhh(var s: shortstring);
begin
s:= s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if FollowGear <> nil then
begin
AddCaption('Auto Camera Off', $CCCCCC, capgrpVolume);
autoCameraOn:= false
end
else
begin
AddCaption('Auto Camera On', $CCCCCC, capgrpVolume);
bShowFinger:= true;
if not CurrentHedgehog^.Unplaced then
FollowGear:= CurrentHedgehog^.Gear;
autoCameraOn:= true
end
end;
procedure chPause(var s: shortstring);
begin
s:= s; // avoid compiler hint
if gameType <> gmtNet then
isPaused:= not isPaused;
if isPaused then
SDL_ShowCursor(1)
else
SDL_ShowCursor(ord(GameState = gsConfirm))
end;
procedure chRotateMask(var s: shortstring);
begin
s:= s; // avoid compiler hint
if ((GameFlags and gfInvulnerable) = 0) then
cTagsMask:= cTagsMasks[cTagsMask]
else
cTagsMask:= cTagsMasksNoHealth[cTagsMask];
end;
procedure chSpeedup_p(var s: shortstring);
begin
s:= s; // avoid compiler hint
isSpeed:= true
end;
procedure chSpeedup_m(var s: shortstring);
begin
s:= s; // avoid compiler hint
isSpeed:= false
end;
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 initModule;
begin
//////// Begin top sorted by freq analysis not including chatmsg
RegisterVariable('+right' , vtCommand, @chRight_p , false);
RegisterVariable('-right' , vtCommand, @chRight_m , false);
RegisterVariable('+up' , vtCommand, @chUp_p , false);
RegisterVariable('-up' , vtCommand, @chUp_m , false);
RegisterVariable('+left' , vtCommand, @chLeft_p , false);
RegisterVariable('-left' , vtCommand, @chLeft_m , false);
RegisterVariable('+attack' , vtCommand, @chAttack_p , false);
RegisterVariable('+down' , vtCommand, @chDown_p , false);
RegisterVariable('-down' , vtCommand, @chDown_m , false);
RegisterVariable('hjump' , vtCommand, @chHJump , false);
RegisterVariable('ljump' , vtCommand, @chLJump , false);
RegisterVariable('nextturn', vtCommand, @chNextTurn , false);
RegisterVariable('-attack' , vtCommand, @chAttack_m , false);
RegisterVariable('slot' , vtCommand, @chSlot , false);
RegisterVariable('setweap' , vtCommand, @chSetWeapon , false);
//////// End top by freq analysis
RegisterVariable('gencmd' , vtCommand, @chGenCmd , false);
RegisterVariable('flag' , vtCommand, @chFlag , false);
RegisterVariable('script' , vtCommand, @chScript , false);
RegisterVariable('proto' , vtCommand, @chCheckProto , true );
RegisterVariable('spectate', vtBoolean, @fastUntilLag , false);
RegisterVariable('capture' , vtCommand, @chCapture , true );
RegisterVariable('rotmask' , vtCommand, @chRotateMask , true );
RegisterVariable('rdriven' , vtCommand, @chTeamLocal , false);
RegisterVariable('map' , vtCommand, @chSetMap , false);
RegisterVariable('theme' , vtCommand, @chSetTheme , false);
RegisterVariable('seed' , vtCommand, @chSetSeed , false);
RegisterVariable('template_filter', vtLongInt, @cTemplateFilter, false);
RegisterVariable('mapgen' , vtLongInt, @cMapGen , false);
RegisterVariable('maze_size',vtLongInt, @cTemplateFilter, false);
RegisterVariable('delay' , vtLongInt, @cInactDelay , false);
RegisterVariable('ready' , vtLongInt, @cReadyDelay , false);
RegisterVariable('casefreq', vtLongInt, @cCaseFactor , false);
RegisterVariable('healthprob', vtLongInt, @cHealthCaseProb, false);
RegisterVariable('hcaseamount', vtLongInt, @cHealthCaseAmount, false);
RegisterVariable('sd_turns', vtLongInt, @cSuddenDTurns , false);
RegisterVariable('waterrise', vtLongInt, @cWaterRise , false);
RegisterVariable('healthdec', vtLongInt, @cHealthDecrease, false);
RegisterVariable('damagepct',vtLongInt, @cDamagePercent , false);
RegisterVariable('ropepct' , vtLongInt, @cRopePercent , false);
RegisterVariable('getawaytime' , vtLongInt, @cGetAwayTime , false);
RegisterVariable('minedudpct',vtLongInt,@cMineDudPercent, false);
RegisterVariable('minesnum', vtLongInt, @cLandMines , false);
RegisterVariable('explosives',vtLongInt,@cExplosives , false);
RegisterVariable('gmflags' , vtLongInt, @GameFlags , false);
RegisterVariable('turntime', vtLongInt, @cHedgehogTurnTime, false);
RegisterVariable('minestime',vtLongInt, @cMinesTime , false);
RegisterVariable('fort' , vtCommand, @chFort , false);
RegisterVariable('grave' , vtCommand, @chGrave , false);
RegisterVariable('hat' , vtCommand, @chSetHat , false);
RegisterVariable('quit' , vtCommand, @chQuit , true );
RegisterVariable('forcequit', vtCommand, @chForceQuit , true );
RegisterVariable('confirm' , vtCommand, @chConfirm , true );
RegisterVariable('halt', vtCommand, @chHalt , true );
RegisterVariable('+speedup', vtCommand, @chSpeedup_p , true );
RegisterVariable('-speedup', vtCommand, @chSpeedup_m , true );
RegisterVariable('zoomin' , vtCommand, @chZoomIn , true );
RegisterVariable('zoomout' , vtCommand, @chZoomOut , true );
RegisterVariable('zoomreset',vtCommand, @chZoomReset , true );
RegisterVariable('ammomenu', vtCommand, @chAmmoMenu , true);
RegisterVariable('+precise', vtCommand, @chPrecise_p , false);
RegisterVariable('-precise', vtCommand, @chPrecise_m , false);
RegisterVariable('switch' , vtCommand, @chSwitch , false);
RegisterVariable('timer' , vtCommand, @chTimer , false);
RegisterVariable('taunt' , vtCommand, @chTaunt , false);
RegisterVariable('put' , vtCommand, @chPut , false);
RegisterVariable('+volup' , vtCommand, @chVol_p , true );
RegisterVariable('-volup' , vtCommand, @chVol_m , true );
RegisterVariable('+voldown', vtCommand, @chVol_m , true );
RegisterVariable('-voldown', vtCommand, @chVol_p , true );
RegisterVariable('findhh' , vtCommand, @chFindhh , true );
RegisterVariable('pause' , vtCommand, @chPause , true );
RegisterVariable('+cur_u' , vtCommand, @chCurU_p , true );
RegisterVariable('-cur_u' , vtCommand, @chCurU_m , true );
RegisterVariable('+cur_d' , vtCommand, @chCurD_p , true );
RegisterVariable('-cur_d' , vtCommand, @chCurD_m , true );
RegisterVariable('+cur_l' , vtCommand, @chCurL_p , true );
RegisterVariable('-cur_l' , vtCommand, @chCurL_m , true );
RegisterVariable('+cur_r' , vtCommand, @chCurR_p , true );
RegisterVariable('-cur_r' , vtCommand, @chCurR_m , true );
end;
procedure freeModule;
begin
end;
end.