(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2014 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 uInputHandler;
interface
uses SDLh, uTypes;

procedure initModule;
procedure freeModule;

function  KeyNameToCode(name: shortstring): LongInt; inline;
function  KeyNameToCode(name: shortstring; Modifier: shortstring): LongInt;
//procedure MaskModifier(var code: LongInt; modifier: LongWord);
procedure MaskModifier(Modifier: shortstring; var code: LongInt);
procedure ProcessMouse(event: TSDL_MouseButtonEvent; ButtonDown: boolean);
procedure ProcessKey(event: TSDL_KeyboardEvent); inline;
procedure ProcessKey(code: LongInt; KeyDown: boolean);

procedure ResetKbd;
procedure FreezeEnterKey;
procedure InitKbdKeyTable;

procedure SetBinds(var binds: TBinds);
procedure SetDefaultBinds;
procedure chDefaultBind(var id: shortstring);
procedure loadBinds(cmd, s: shortstring);
procedure addBind(var binds: TBinds; var id: shortstring);

procedure ControllerInit;
procedure ControllerAxisEvent(joy, axis: Byte; value: Integer);
procedure ControllerHatEvent(joy, hat, value: Byte);
procedure ControllerButtonEvent(joy, button: Byte; pressed: Boolean);

implementation
uses uConsole, uCommands, uVariables, uConsts, uUtils, uDebug, uPhysFSLayer;

const
    LSHIFT = $0200;
    RSHIFT = $0400;
    LALT   = $0800;
    RALT   = $1000;
    LCTRL  = $2000;
    RCTRL  = $4000;

var tkbd: array[0..cKbdMaxIndex] of boolean;
    KeyNames: array [0..cKeyMaxIndex] of string[15];
    CurrentBinds: TBinds;
    ControllerNumControllers: Integer;
    ControllerEnabled: Integer;
    ControllerNumAxes: array[0..5] of Integer;
    //ControllerNumBalls: array[0..5] of Integer;
    ControllerNumHats: array[0..5] of Integer;
    ControllerNumButtons: array[0..5] of Integer;
    //ControllerAxes: array[0..5] of array[0..19] of Integer;
    //ControllerBalls: array[0..5] of array[0..19] of array[0..1] of Integer;
    //ControllerHats: array[0..5] of array[0..19] of Byte;
    //ControllerButtons: array[0..5] of array[0..19] of Byte;

function  KeyNameToCode(name: shortstring): LongInt; inline;
begin
    KeyNameToCode:= KeyNameToCode(name, '');
end;

function KeyNameToCode(name: shortstring; Modifier: shortstring): LongInt;
var code: LongInt;
begin
    name:= LowerCase(name);
    code:= cKeyMaxIndex;
    while (code > 0) and (KeyNames[code] <> name) do dec(code);

    MaskModifier(Modifier, code);
    KeyNameToCode:= code;
end;
(*
procedure MaskModifier(var code: LongInt; Modifier: LongWord);
begin
    if(Modifier and KMOD_LSHIFT) <> 0 then code:= code or LSHIFT;
    if(Modifier and KMOD_RSHIFT) <> 0 then code:= code or LSHIFT;
    if(Modifier and KMOD_LALT) <> 0 then code:= code or LALT;
    if(Modifier and KMOD_RALT) <> 0 then code:= code or LALT;
    if(Modifier and KMOD_LCTRL) <> 0 then code:= code or LCTRL;
    if(Modifier and KMOD_RCTRL) <> 0 then code:= code or LCTRL;
end;
*)
procedure MaskModifier(Modifier: shortstring; var code: LongInt);
var mod_ : shortstring = '';
    ModifierCount, i: LongInt;
begin
if Modifier = '' then exit;
ModifierCount:= 0;

for i:= 1 to Length(Modifier) do
    if(Modifier[i] = ':') then inc(ModifierCount);

SplitByChar(Modifier, mod_, ':');//remove the first mod: part
Modifier:= mod_;
for i:= 0 to ModifierCount do
    begin
    mod_:= '';
    SplitByChar(Modifier, mod_, ':');
    if (Modifier = 'lshift')                    then code:= code or LSHIFT;
    if (Modifier = 'rshift')                    then code:= code or RSHIFT;
    if (Modifier = 'lalt')                      then code:= code or LALT;
    if (Modifier = 'ralt')                      then code:= code or RALT;
    if (Modifier = 'lctrl') or (mod_ = 'lmeta') then code:= code or LCTRL;
    if (Modifier = 'rctrl') or (mod_ = 'rmeta') then code:= code or RCTRL;
    Modifier:= mod_;
    end;
end;

procedure ProcessKey(code: LongInt; KeyDown: boolean);
var
    Trusted: boolean;
    s      : string;
begin
if not(tkbd[code] xor KeyDown) then exit;
tkbd[code]:= KeyDown;

Trusted:= (CurrentTeam <> nil)
          and (not CurrentTeam^.ExtDriven)
          and (CurrentHedgehog^.BotLevel = 0);
// REVIEW OR FIXME
// ctrl/cmd + q to close engine and frontend - this seems like a bad idea, since we let people set arbitrary binds, and don't warn them of this.
// There's no confirmation at all
// ctrl/cmd + q to close engine and frontend
if(KeyDown and (code = SDLK_q)) then
    begin
{$IFDEF DARWIN}
    if tkbd[KeyNameToCode('left_meta')] or tkbd[KeyNameToCode('right_meta')] then
{$ELSE}
    if tkbd[KeyNameToCode('left_ctrl')] or tkbd[KeyNameToCode('right_ctrl')] then
{$ENDIF}
        ParseCommand('halt', true);
    end;

// ctrl/cmd + w to close engine
if(KeyDown and (code = SDLK_w)) then
    begin
{$IFDEF DARWIN}
    // on OS X it this is expected behaviour
    if tkbd[KeyNameToCode('left_meta')] or tkbd[KeyNameToCode('right_meta')] then
{$ELSE}
    // on other systems use this shortcut only if the keys are not bound to any command
    if tkbd[KeyNameToCode('left_ctrl')] or tkbd[KeyNameToCode('right_ctrl')] then
        if ((CurrentBinds[KeyNameToCode('left_ctrl')] = '') or
            (CurrentBinds[KeyNameToCode('right_ctrl')] = '')) and
            (CurrentBinds[SDLK_w] = '') then
{$ENDIF}
        ParseCommand('forcequit', true);
    end;

if CurrentBinds[code][0] <> #0 then
    begin
    if (code > 3) and KeyDown and (not ((CurrentBinds[code] = 'put')) or (CurrentBinds[code] = 'ammomenu') or (CurrentBinds[code] = '+cur_u') or (CurrentBinds[code] = '+cur_d') or (CurrentBinds[code] = '+cur_l') or (CurrentBinds[code] = '+cur_r')) and (CurrentTeam <> nil) and (not CurrentTeam^.ExtDriven) then bShowAmmoMenu:= false;
    if KeyDown then
        begin
        if CurrentBinds[code] = 'switch' then
            LocalMessage:= LocalMessage or gmSwitch
        else if CurrentBinds[code] = '+precise' then
            LocalMessage:= LocalMessage or gmPrecise;

        ParseCommand(CurrentBinds[code], Trusted);
        if (CurrentTeam <> nil) and (not CurrentTeam^.ExtDriven) and (ReadyTimeLeft > 1) then
            ParseCommand('gencmd R', true)
        end
    else if (CurrentBinds[code][1] = '+') then
        begin
        if CurrentBinds[code] = '+precise' then
            LocalMessage:= LocalMessage and (not gmPrecise);
        s:= CurrentBinds[code];
        s[1]:= '-';
        ParseCommand(s, Trusted);
        if (CurrentTeam <> nil) and (not CurrentTeam^.ExtDriven) and (ReadyTimeLeft > 1) then
            ParseCommand('gencmd R', true)
        end
    else
        begin
        if CurrentBinds[code] = 'switch' then
            LocalMessage:= LocalMessage and (not gmSwitch)
        end
    end
end;

procedure ProcessKey(event: TSDL_KeyboardEvent); inline;
var code: LongInt;
begin
    code:= event.keysym.sym;
    //MaskModifier(code, event.keysym.modifier);
    ProcessKey(code, event.type_ = SDL_KEYDOWN);
end;

procedure ProcessMouse(event: TSDL_MouseButtonEvent; ButtonDown: boolean);
begin
case event.button of
    SDL_BUTTON_LEFT:
        ProcessKey(KeyNameToCode('mousel'), ButtonDown);
    SDL_BUTTON_MIDDLE:
        ProcessKey(KeyNameToCode('mousem'), ButtonDown);
    SDL_BUTTON_RIGHT:
        ProcessKey(KeyNameToCode('mouser'), ButtonDown);
    SDL_BUTTON_WHEELDOWN:
        ProcessKey(KeyNameToCode('wheeldown'), ButtonDown);
    SDL_BUTTON_WHEELUP:
        ProcessKey(KeyNameToCode('wheelup'), ButtonDown);
    end;
end;

procedure ResetKbd;
var t: LongInt;
begin
for t:= 0 to cKbdMaxIndex do
    if tkbd[t] then
        ProcessKey(t, False);
end;

procedure InitKbdKeyTable;
var i, j, k, t: LongInt;
    s: string[15];
begin
//TODO in sdl13 this overrides some values (A and B) change indices to some other values at the back perhaps?
KeyNames[1]:= 'mousel';
KeyNames[2]:= 'mousem';
KeyNames[3]:= 'mouser';
KeyNames[4]:= 'wheelup';
KeyNames[5]:= 'wheeldown';

for i:= 6 to cKeyMaxIndex do
    begin
    s:= shortstring(sdl_getkeyname(i));
    //WriteLnToConsole('uInputHandler - ' + IntToStr(i) + ': ' + s + ' ' + IntToStr(cKeyMaxIndex));
    if s = 'unknown key' then KeyNames[i]:= ''
    else
        begin
        for t:= 1 to Length(s) do
            if s[t] = ' ' then
                s[t]:= '_';
        KeyNames[i]:= LowerCase(s)
        end;
    end;


// get the size of keyboard array
SDL_GetKeyState(@k);

// Controller(s)
for j:= 0 to Pred(ControllerNumControllers) do
    begin
    for i:= 0 to Pred(ControllerNumAxes[j]) do
        begin
        keynames[k + 0]:= 'j' + IntToStr(j) + 'a' + IntToStr(i) + 'u';
        keynames[k + 1]:= 'j' + IntToStr(j) + 'a' + IntToStr(i) + 'd';
        inc(k, 2);
        end;
    for i:= 0 to Pred(ControllerNumHats[j]) do
        begin
        keynames[k + 0]:= 'j' + IntToStr(j) + 'h' + IntToStr(i) + 'u';
        keynames[k + 1]:= 'j' + IntToStr(j) + 'h' + IntToStr(i) + 'r';
        keynames[k + 2]:= 'j' + IntToStr(j) + 'h' + IntToStr(i) + 'd';
        keynames[k + 3]:= 'j' + IntToStr(j) + 'h' + IntToStr(i) + 'l';
        inc(k, 4);
        end;
    for i:= 0 to Pred(ControllerNumButtons[j]) do
        begin
        keynames[k]:= 'j' + IntToStr(j) + 'b' + IntToStr(i);
        inc(k, 1);
        end;
    end;

DefaultBinds[KeyNameToCode('escape')]:= 'quit';
DefaultBinds[KeyNameToCode(_S'`')]:= 'history';
DefaultBinds[KeyNameToCode('delete')]:= 'rotmask';

//numpad
//DefaultBinds[265]:= '+volup';
//DefaultBinds[256]:= '+voldown';

DefaultBinds[KeyNameToCode(_S'0')]:= '+volup';
DefaultBinds[KeyNameToCode(_S'9')]:= '+voldown';
DefaultBinds[KeyNameToCode(_S'8')]:= 'mute';
DefaultBinds[KeyNameToCode(_S'c')]:= 'capture';
DefaultBinds[KeyNameToCode(_S'r')]:= 'record';
DefaultBinds[KeyNameToCode(_S'h')]:= 'findhh';
DefaultBinds[KeyNameToCode(_S'p')]:= 'pause';
DefaultBinds[KeyNameToCode(_S's')]:= '+speedup';
DefaultBinds[KeyNameToCode(_S't')]:= 'chat';
DefaultBinds[KeyNameToCode(_S'y')]:= 'confirm';

DefaultBinds[KeyNameToCode('mousem')]:= 'zoomreset';
DefaultBinds[KeyNameToCode('wheelup')]:= 'zoomin';
DefaultBinds[KeyNameToCode('wheeldown')]:= 'zoomout';

DefaultBinds[KeyNameToCode('f12')]:= 'fullscr';


DefaultBinds[KeyNameToCode('mousel')]:= '/put';
DefaultBinds[KeyNameToCode('mouser')]:= 'ammomenu';
DefaultBinds[KeyNameToCode('backspace')]:= 'hjump';
DefaultBinds[KeyNameToCode('tab')]:= 'switch';
DefaultBinds[KeyNameToCode('return')]:= 'ljump';
DefaultBinds[KeyNameToCode('space')]:= '+attack';
DefaultBinds[KeyNameToCode('up')]:= '+up';
DefaultBinds[KeyNameToCode('down')]:= '+down';
DefaultBinds[KeyNameToCode('left')]:= '+left';
DefaultBinds[KeyNameToCode('right')]:= '+right';
DefaultBinds[KeyNameToCode('left_shift')]:= '+precise';


DefaultBinds[KeyNameToCode('j0a0u')]:= '+left';
DefaultBinds[KeyNameToCode('j0a0d')]:= '+right';
DefaultBinds[KeyNameToCode('j0a1u')]:= '+up';
DefaultBinds[KeyNameToCode('j0a1d')]:= '+down';
for i:= 1 to 10 do DefaultBinds[KeyNameToCode('f'+IntToStr(i))]:= 'slot '+char(i+48);
for i:= 1 to 5  do DefaultBinds[KeyNameToCode(IntToStr(i))]:= 'timer '+IntToStr(i);

loadBinds('dbind', cPathz[ptData] + '/settings.ini');
end;

procedure SetBinds(var binds: TBinds);
{$IFNDEF MOBILE}
var
    t: LongInt;
{$ENDIF}
begin
{$IFDEF MOBILE}
    binds:= binds; // avoid hint
    CurrentBinds:= DefaultBinds;
{$ELSE}
    for t:= 0 to cKbdMaxIndex do
        if (CurrentBinds[t] <> binds[t]) and tkbd[t] then
            ProcessKey(t, False);

    CurrentBinds:= binds;
{$ENDIF}
end;

procedure SetDefaultBinds;
begin
    CurrentBinds:= DefaultBinds;
end;

procedure FreezeEnterKey;
begin
    tkbd[3]:= True;
    tkbd[13]:= True;
    tkbd[27]:= True;
    tkbd[271]:= True;
end;

var Controller: array [0..5] of PSDL_Joystick;

procedure ControllerInit;
var j: Integer;
begin
ControllerEnabled:= 0;
{$IFDEF IPHONE}
exit; // joystick subsystem disabled on iPhone
{$ENDIF}

SDL_InitSubSystem(SDL_INIT_JOYSTICK);
ControllerNumControllers:= SDL_NumJoysticks();

if ControllerNumControllers > 6 then
    ControllerNumControllers:= 6;

WriteLnToConsole('Number of game controllers: ' + IntToStr(ControllerNumControllers));

if ControllerNumControllers > 0 then
    begin
    for j:= 0 to pred(ControllerNumControllers) do
        begin
        WriteLnToConsole('Using game controller: ' + shortstring(SDL_JoystickName(j)));
        Controller[j]:= SDL_JoystickOpen(j);
        if Controller[j] = nil then
            WriteLnToConsole('* Failed to open game controller!')
        else
            begin
            ControllerNumAxes[j]:= SDL_JoystickNumAxes(Controller[j]);
            //ControllerNumBalls[j]:= SDL_JoystickNumBalls(Controller[j]);
            ControllerNumHats[j]:= SDL_JoystickNumHats(Controller[j]);
            ControllerNumButtons[j]:= SDL_JoystickNumButtons(Controller[j]);
            WriteLnToConsole('* Number of axes: ' + IntToStr(ControllerNumAxes[j]));
            //WriteLnToConsole('* Number of balls: ' + IntToStr(ControllerNumBalls[j]));
            WriteLnToConsole('* Number of hats: ' + IntToStr(ControllerNumHats[j]));
            WriteLnToConsole('* Number of buttons: ' + IntToStr(ControllerNumButtons[j]));
            ControllerEnabled:= 1;

            if ControllerNumAxes[j] > 20 then
                ControllerNumAxes[j]:= 20;
            //if ControllerNumBalls[j] > 20 then ControllerNumBalls[j]:= 20;

            if ControllerNumHats[j] > 20 then
                ControllerNumHats[j]:= 20;

            if ControllerNumButtons[j] > 20 then
                ControllerNumButtons[j]:= 20;

            (*// reset all buttons/axes
            for i:= 0 to pred(ControllerNumAxes[j]) do
                ControllerAxes[j][i]:= 0;
            for i:= 0 to pred(ControllerNumBalls[j]) do
                begin
                ControllerBalls[j][i][0]:= 0;
                ControllerBalls[j][i][1]:= 0;
                end;
            for i:= 0 to pred(ControllerNumHats[j]) do
                ControllerHats[j][i]:= SDL_HAT_CENTERED;
            for i:= 0 to pred(ControllerNumButtons[j]) do
                ControllerButtons[j][i]:= 0;*)
            end;
        end;
    // enable event generation/controller updating
    SDL_JoystickEventState(1);
    end
else
    WriteLnToConsole('Not using any game controller');
end;

procedure ControllerAxisEvent(joy, axis: Byte; value: Integer);
var
    k: LongInt;
begin
    SDL_GetKeyState(@k);
    k:= k + joy * (ControllerNumAxes[joy]*2 + ControllerNumHats[joy]*4 + ControllerNumButtons[joy]*2);
    ProcessKey(k +  axis*2, value > 20000);
    ProcessKey(k + (axis*2)+1, value < -20000);
end;

procedure ControllerHatEvent(joy, hat, value: Byte);
var
    k: LongInt;
begin
    SDL_GetKeyState(@k);
    k:= k + joy * (ControllerNumAxes[joy]*2 + ControllerNumHats[joy]*4 + ControllerNumButtons[joy]*2);
    ProcessKey(k +  ControllerNumAxes[joy]*2 + hat*4 + 0, (value and SDL_HAT_UP)   <> 0);
    ProcessKey(k +  ControllerNumAxes[joy]*2 + hat*4 + 1, (value and SDL_HAT_RIGHT)<> 0);
    ProcessKey(k +  ControllerNumAxes[joy]*2 + hat*4 + 2, (value and SDL_HAT_DOWN) <> 0);
    ProcessKey(k +  ControllerNumAxes[joy]*2 + hat*4 + 3, (value and SDL_HAT_LEFT) <> 0);
end;

procedure ControllerButtonEvent(joy, button: Byte; pressed: Boolean);
var
    k: LongInt;
begin
    SDL_GetKeyState(@k);
    k:= k + joy * (ControllerNumAxes[joy]*2 + ControllerNumHats[joy]*4 + ControllerNumButtons[joy]*2);
    ProcessKey(k +  ControllerNumAxes[joy]*2 + ControllerNumHats[joy]*4 + button, pressed);
end;

procedure loadBinds(cmd, s: shortstring);
var i: LongInt;
    f: PFSFile;
    p, l: shortstring;
    b: byte;
begin
    AddFileLog('[BINDS] Loading binds from: ' + s);

    l:= '';
    if pfsExists(s) then
        begin
        f:= pfsOpenRead(s);
        while (not pfsEOF(f)) and (l <> '[Binds]') do
            pfsReadLn(f, l);

        while (not pfsEOF(f)) and (l <> '') do
            begin
            pfsReadLn(f, l);

            p:= '';
            i:= 1;
            while (i <= length(l)) and (l[i] <> '=') do
                begin
                if l[i] = '%' then
                    begin
                    l[i]:= '$';
                    val(copy(l, i, 3), b);
                    p:= p + char(b);
                    inc(i, 3)
                    end
                else
                    begin
                    p:= p + l[i];
                    inc(i)
                    end;
                end;

            if i < length(l) then
                begin
                l:= copy(l, i + 1, length(l) - i);
                if l <> 'default' then
                    begin
                    if (length(l) = 2) and (l[1] = '\') then
                        l:= l[1]
                    else if (l[1] = '"') and (l[length(l)] = '"') then
                        l:= copy(l, 2, length(l) - 2);

                    p:= cmd + ' ' + l + ' ' + p;
                    ParseCommand(p, true)
                    end
                end
            end;

        pfsClose(f)
        end
        else
            AddFileLog('[BINDS] file not found');
end;


procedure addBind(var binds: TBinds; var id: shortstring);
var KeyName, Modifier, tmp: shortstring;
    i, b: LongInt;
begin
KeyName:= '';
Modifier:= '';

if(Pos('mod:', id) <> 0)then
    begin
    tmp:= '';
    SplitBySpace(id, tmp);
    Modifier:= id;
    id:= tmp;
    end;

SplitBySpace(id, KeyName);
if KeyName[1]='"' then
    Delete(KeyName, 1, 1);
if KeyName[byte(KeyName[0])]='"' then
    Delete(KeyName, byte(KeyName[0]), 1);
b:= KeyNameToCode(id, Modifier);
if b = 0 then
    OutError(errmsgUnknownVariable + ' "' + id + '"', false)
else
    begin
    // add bind: first check if this cmd is already bound, and remove old bind
    i:= cKbdMaxIndex;
    repeat
        dec(i)
    until (i < 0) or (binds[i] = KeyName);
    if (i >= 0) then
        binds[i]:= '';

    binds[b]:= KeyName;
    end
end;

// Bind that isn't a team bind, but overrides defaultbinds.
procedure chDefaultBind(var id: shortstring);
begin
    addBind(DefaultBinds, id)
end;

procedure initModule;
begin
    RegisterVariable('dbind', @chDefaultBind, true );
end;

procedure freeModule;
var j: LongInt;
begin
    // close gamepad controllers
    if ControllerEnabled > 0 then
        for j:= 0 to pred(ControllerNumControllers) do
            SDL_JoystickClose(Controller[j]);
end;

end.