(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

 *)

{$INCLUDE "options.inc"}

unit uCommandHandlers;

interface

procedure initModule;

procedure freeModule;

implementation

uses uCommands, uTypes, uVariables, uIO, uDebug, uConsts, uScript, uUtils, SDLh, uWorld, uRandom, uCaptions

    , uVisualGearsList, uGearsHedgehog

     {$IFDEF USE_VIDEO_RECORDING}, uVideoRec {$ENDIF};

var cTagsMasks : array[0..15] of byte = (7, 0, 0, 0, 0, 4, 5, 6, 15, 8, 8, 8, 8, 12, 13, 14);

    cTagsMasksNoHealth: array[0..15] of byte = (3, 0, 1, 2, 0, 0, 0, 0, 11, 8, 9, 10, 8, 8, 8, 8);

// helper function for volume

procedure updateVolumeDelta(precise: boolean);

begin

if cVolumeUpKey and (not cVolumeDownKey) then

    if precise then

        cVolumeDelta:= 1

    else

        cVolumeDelta:= 3

else if cVolumeDownKey and (not cVolumeUpKey) then

    if precise then

        cVolumeDelta:= -1

    else

        cVolumeDelta:= -3

else

    cVolumeDelta:= 0;

end;

procedure chGenCmd(var s: shortstring);

begin

case s[1] of

    'R': if ReadyTimeLeft > 0 then

        begin

        ReadyTimeLeft:= 0;

        if not isExternalSource then

            SendIPC('c'+s);

        end

    end

end;

procedure chQuit(var s: shortstring);

begin

    s:= s; // avoid compiler hint

    if (GameState = gsGame) then

    begin

        isInChatMode:= false;

        GameState:= gsConfirm;

    end

    else begin

        if GameState = gsConfirm then

            GameState:= gsGame;

    end;

    updateCursorVisibility;

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(_S'Q');

        GameState:= gsExit

        end

end;

procedure chHalt (var s: shortstring);

begin

    s:= s; // avoid compiler hint

    SendIPC(_S'H');

    GameState:= gsExit

end;

procedure chCheckProto(var s: shortstring);

var i: LongInt;

begin

    if isDeveloperMode then

        begin

        i:= StrToInt(s);

        checkFails(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old (got '+intToStr(i)+', expecting '+intToStr(cNetProtoVersion)+')', true);

        checkFails(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 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, true)

end;

procedure chScriptParam(var s: shortstring);

begin

    ScriptSetString('ScriptParam', s);

    ScriptCall('onParameters');

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

if CursorMovementY < 0 then

    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

if CursorMovementY > 0 then

    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

if CursorMovementX < 0 then

    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

if CursorMovementX > 0 then

    CursorMovementX:= 0;

end;

procedure chLeft_p(var s: shortstring);

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

if not isExternalSource 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);

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

if not isExternalSource then

    SendIPC(_S'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 then

    exit;

if not isExternalSource 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);

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

if not isExternalSource then

    SendIPC(_S'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 then

    exit;

if not isExternalSource 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);

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

if not isExternalSource then

    SendIPC(_S'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 then

    exit;

if not isExternalSource 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);

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

if not isExternalSource then

    SendIPC(_S'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

updateVolumeDelta(true);

if CheckNoTeamOrHH then

    exit;

if not isExternalSource 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);

begin

s:= s; // avoid compiler hint

updateVolumeDelta(false);

if CheckNoTeamOrHH then

    exit;

if not isExternalSource then

    SendIPC(_S'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 then

    exit;

if not isExternalSource then

    SendIPC(_S'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 then

    exit;

if not isExternalSource 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);

var inbtwnTrgtAttks: Boolean;

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

bShowFinger:= false;

with CurrentHedgehog^.Gear^ do

    begin

    AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));

    if ((State and gstHHDriven) <> 0) then

        begin

        inbtwnTrgtAttks:= ((GameFlags and gfInfAttack) <> 0) and ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NeedTarget) <> 0);

        if (not inbtwnTrgtAttks) then

            FollowGear:= CurrentHedgehog^.Gear;

        if not isExternalSource then

            SendIPC(_S'A');

        Message:= Message or (gmAttack and InputMask);

        ScriptCall('onAttack'); // so if I fire airstrike, it doesn't count as attack? fine, fine

        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 isExternalSource and

        ((Message and gmAttack) <> 0) then

            SendIPC(_S'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 then

    exit;

if not isExternalSource 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

    if checkFails(AllInactive, '/nextturn called when not all gears are inactive', true) then exit;

    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 isExternalSource then

        begin

        s[0]:= #5;

        s[1]:= 'N';

        SDLNet_Write32(CheckSum, @s[2]);

        SendIPC(s)

        end

    else

        checkFails(CurrentTeam^.hasGone or (CheckSum = lastTurnChecksum), 'Desync detected', true);

    AddFileLog('Next turn: time '+inttostr(GameTicks));

end;

procedure chTimer(var s: shortstring);

begin

if CheckNoTeamOrHH then

    exit;

if checkFails((s[0] = #1) and (s[1] >= '1') and (s[1] <= '5'), 'Malformed /timer', true) then exit;

if not isExternalSource 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;

// Increment timer or bounciness

procedure chTimerU(var s: shortstring);

var t: LongWord;

    tb: Byte;

begin

s:= s; // avoid compiler hint

if CheckNoTeamOrHH then

    exit;

// We grab the current timer first so we can increment it

if (CurrentHedgehog^.Gear^.Message and gmPrecise) = 0 then

    t:= HHGetTimerMsg(CurrentHedgehog^.Gear)

else

    // Use bounciness if Precise is pressed

    t:= HHGetBouncinessMsg(CurrentHedgehog^.Gear);

if t <> MSGPARAM_INVALID then

    begin

    // Calculate new timer

    Inc(t);

    if t > 5 then

        t:= 1;

    tb:= t mod 255;

    // Delegate the actual change to /timer

    ParseCommand('timer ' + Char(tb + Ord('0')), true);

    end;

end;

procedure chSlot(var s: shortstring);

var slot: LongWord;

    ss: shortstring;

begin

if (s[0] <> #1) or CheckNoTeamOrHH then

    exit;

slot:= byte(s[1]) - 49;

if slot > cMaxSlotIndex then

    exit;

if not isExternalSource 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);

    end

end;