This has bugged me for a while. Since we are missing the source SVGs for this theme, removed the leaves crudely in GIMP. Also added some basic roots. Someone more artistic is encouraged to try and improve it.
(*
* 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');
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');
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');
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');
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;
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.