{$MODE OBJFPC}
{$MODESWITCH AUTODEREF}
{$MODESWITCH POINTERTOPROCVAR}
// TODO need to fully redactor this unit
unit DControl;

interface

uses
  {$IFDEF mswindows}dynlibs, windows, mmsystem,{$ENDIF}
  {$IFDEF ANDROID}log,{$ENDIF}
  dstrnum,
  dobjects,
  DEngBase,
  DWinApi,
  dvector2i;

const
  KD_USER       = 0;
  KD_KEYBOARD   = 1;
  KD_MOUSE      = 2;
  KD_JOYSTICK   = 3;

type
TKey = packed record
  device: Byte; // 0 - user, 1 - keyboard, 2 - mouse, 3 - joystick
  id: Byte;
end;

TKeyDown = procedure (const Key: TKey);

PKeyBinding = ^TKeyBinding;
TKeyBinding = object(TObject)
private
  FPressed: Boolean;
public
  constructor Init;
  // Consume event Ev
  //   Return value -- True if event was consumed
  function Consume(Ev: PWindowEvent): Boolean; virtual;
  // Resets pressed status
  procedure Reset;
  // Is the key pressed right now
  property Pressed: Boolean read FPressed;
end;

TKeyBinding2 = object(TKeyBinding)
public const
  NOKEY = 0;
private
  FKey1, FKey2: LongInt;
public
  constructor Init(Key1: LongInt = NOKEY;
                   Key2: LongInt = NOKEY);
  function Consume(Ev: PWindowEvent): Boolean; virtual;
end;

TKeyBindingEscape = object(TKeyBinding)
public
  constructor Init;
  function Consume(Ev: PWindowEvent): Boolean; virtual;
end;

TJoyState = object
private
{$IFDEF WINDOWS}
  FJoyInfoEx: JOYINFOEX;
{$ENDIF}
public
  procedure Init; inline;
  procedure Done; inline;
  function Pressed(Button: LongInt): Boolean; inline;
  function XPos: LongInt; inline;
  function YPos: LongInt; inline;
  function ZPos: LongInt; inline;
  function RPos: LongInt; inline;
  function UPos: LongInt; inline;
  function VPos: LongInt; inline;
  // -1, 0 or 1
  function XDiscrete: LongInt; inline;
  function YDiscrete: LongInt; inline;
  function ZDiscrete: LongInt; inline;
  function RDiscrete: LongInt; inline;
  function UDiscrete: LongInt; inline;
  function VDiscrete: LongInt; inline;
end;

PControl = ^TControl;
TControl = object
private
  FWinApi: PWinApi;
  FKeys: array[Byte] of Boolean;
  FKeyDown: TKeyDown;
  FVibrationDelay, FVibrationEnd: LongInt;

{$IFDEF WINDOWS}
private type
{$PUSH}
{$PACKRECORDS C}
  PXINPUT_VIBRATION = ^XINPUT_VIBRATION;
  XINPUT_VIBRATION = record
    wLeftMotorSpeed: WORD;
    wRightMotorSpeed: WORD;
  end;
{$POP}
private
  FXInputLib: TLibHandle;
  XInputSetState: function(dwUserIndex: DWORD; pVibration: PXINPUT_VIBRATION): DWORD; stdcall;
{$ENDIF}

public
  constructor Init(WinApi: PWinApi);
  destructor Done; virtual;
  procedure OnInit;
  function OnWindowEvent(Event: PWindowEvent): Boolean;
  procedure Update;
  // Keyboard
  function Pressed(Key: Byte): Boolean; overload;
  // Keyboard and mouse supported
  function Pressed(const Key: TKey): Boolean; overload;
  //function GetMouse: TVec2i;
  //function GetKeyPressed(Key: Byte): Boolean;
  //function GetMousePressed(Button: TMouseButton): Boolean;

  // Joystick
  //   Returns False if JoyId is invalid and state is not returned
  function GetJoyState(JoyId: LongInt; out State: TJoyState): Boolean;
  // Power: from 0 (no vibration) to 255 (highest)
  // Delay: in milliseconds (0 - infinite)
  procedure Vibrate(JoyId, Power, Delay: LongInt);

  procedure Subscribe(KeyDown: TKeyDown); overload;

  //property Mouse: TVec2i read GetMouse;
  //property Keys[Key: Byte]: Boolean read GetKeyPressed;
  //property MouseButtons[Button: TMouseButton]: Boolean read GetMouseButton;
end;

const
  LeftButton: TKey = (device: 2; id: 0);

function Key(Id: Byte): TKey;

implementation

uses
  DEng;

constructor TKeyBinding.Init;
begin
  FPressed := False;
end;

function TKeyBinding.Consume(Ev: PWindowEvent): Boolean;
begin
  Result := False;
end;

procedure TKeyBinding.Reset;
begin
  FPressed := False;
end;

constructor TKeyBinding2.Init(Key1: LongInt = NOKEY;
                 Key2: LongInt = NOKEY);
begin
  inherited Init;
  FKey1 := Key1;
  FKey2 := Key2;
end;

function TKeyBinding2.Consume(Ev: PWindowEvent): Boolean;
begin
  if FKey1 <> NOKEY then begin
    if Ev.IsKeyDown(FKey1) then begin
      FPressed := True;
      Exit(True);
    end else if Ev.IsKeyUp(FKey1) then begin
      FPressed := False;
      Exit(True);
    end;
  end;
  if FKey2 <> NOKEY then begin
    if Ev.IsKeyDown(FKey2) then begin
      FPressed := True;
      Exit(True);
    end else if Ev.IsKeyUp(FKey2) then begin
      FPressed := False;
      Exit(True);
    end;
  end;
  Exit(False);
end;

constructor TKeyBindingEscape.Init;
begin
  inherited;
end;

function TKeyBindingEscape.Consume(Ev: PWindowEvent): Boolean;
begin
  if Ev.IsKeyDown(KEY_ESC) then begin
    FPressed := True;
    Result := True;
  end else if Ev.IsKeyUp(KEY_ESC) then begin
    FPressed := False;
    Result := True;
  end else
    Result := False;
end;

procedure TJoyState.Init;
begin
end;

procedure TJoyState.Done;
begin
end;

function TJoyState.Pressed(Button: LongInt): Boolean;
begin
{$IFDEF WINDOWS}
  Result := (FJoyInfoEx.wButtons and (1 shl Button)) <> 0;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TJoyState.XPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.wXPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.YPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.wYPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.ZPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.wZPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.RPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.dwRPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.UPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.dwUPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.VPos: LongInt;
begin
{$IFDEF WINDOWS}
  Result := FJoyInfoEx.dwVPos;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TJoyState.XDiscrete: LongInt;
begin
  if XPos < 32000 then begin
    Result := -1;
  end else if XPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

function TJoyState.YDiscrete: LongInt;
begin
  if YPos < 32000 then begin
    Result := -1;
  end else if YPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

function TJoyState.ZDiscrete: LongInt;
begin
  if ZPos < 32000 then begin
    Result := -1;
  end else if ZPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

function TJoyState.RDiscrete: LongInt;
begin
  if RPos < 32000 then begin
    Result := -1;
  end else if RPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

function TJoyState.UDiscrete: LongInt;
begin
  if UPos < 32000 then begin
    Result := -1;
  end else if UPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

function TJoyState.VDiscrete: LongInt;
begin
  if VPos < 32000 then begin
    Result := -1;
  end else if VPos > 33000 then begin
    Result := 1;
  end else
    Result := 0;
end;

constructor TControl.Init(WinApi: PWinApi);
{$IFDEF WINDOWS}
const
  XInput1_4 = 'Xinput1_4.dll';
  XInput9_1_0 = 'Xinput9_1_0.dll';
{$ENDIF}
begin
  FWinApi := WinApi;

{$IFDEF WINDOWS}
  XInputSetState := nil;
  FXInputLib := SafeLoadLibrary(XInput1_4);
  if FXInputLib = NilHandle then begin
    LogTagged('D', 'Failed to load ' + XInput1_4 + ': ' + GetLoadErrorStr);
    FXInputLib := SafeLoadLibrary(XInput9_1_0);
    if FXInputLib = NilHandle then
      LogTagged('D', 'Failed to load ' + XInput9_1_0 + ': ' + GetLoadErrorStr);
  end;
  if FXInputLib <> NilHandle then begin
    XInputSetState := GetProcedureAddress(FXInputLib, 'XInputSetState');
    if XInputSetState = nil then
      LogTagged('D', 'Failed to get XInputSetState; vibration is not supported');
  end;
{$ENDIF}
end;

destructor TControl.Done;
begin
  if FXInputLib <> NilHandle then
    UnloadLibrary(FXInputLib);
end;

procedure TControl.OnInit;
begin
  FWinApi.Window.Subscribe(@OnWindowEvent);
  FVibrationDelay := 0;
  FVibrationEnd := Eng.Time;
end;

function TControl.OnWindowEvent(Event: PWindowEvent): Boolean;
begin
  Result := False; // do not affect on other window event handlers
  if Event.IsKeyDown then begin
      FKeys[Event.Key] := True;
      // TODO remove this legacy later
      // make event
      //if @FKeyDown <> nil then
      //  FKeyDown(Key(Event.Key));
  end else if Event.IsKeyUp then begin
      FKeys[Event.Key] := False;
      // make event
  end else if Event.IsLeftClickDown then begin
      FKeys[KEY_LBUTTON] := True;
  end else if Event.IsLeftClickUp then begin
      FKeys[KEY_LBUTTON] := False;
  end else if Event.IsRightClickDown then begin
      FKeys[KEY_RBUTTON] := True;
  end else if Event.IsRightClickDown then begin
      FKeys[KEY_RBUTTON] := False;
  end else if Event.IsMiddleClickDown then begin
      FKeys[KEY_MBUTTON] := True;
  end else if Event.IsMiddleClickUp then begin
      FKeys[KEY_MBUTTON] := False;
  end;
end;

procedure TControl.Update;
begin
  if FVibrationDelay <> 0 then begin
    if FVibrationEnd < Eng.Time then begin
      Vibrate(0, 0, 0);
    end;
  end;
end;

function TControl.Pressed(Key: Byte): Boolean;
begin
  Result := FKeys[Key];
end;

function TControl.Pressed(const Key: TKey): Boolean;
begin
  case Key.device of
    KD_KEYBOARD: Result := FKeys[Key.id];
  else
    Result := False;
  end;
end;

function TControl.GetJoyState(JoyId: LongInt; out State: TJoyState): Boolean;
begin
  State.FJoyInfoEx.dwSize := SizeOf(State.FJoyInfoEx);
  State.FJoyInfoEx.dwFlags := JOY_RETURNALL;
  Result := joyGetPosEx(JoyId, @State.FJoyInfoEx) = JOYERR_NOERROR;
end;

procedure TControl.Vibrate(JoyId, Power, Delay: LongInt);
{$IFDEF WINDOWS}
var
  Vibration: XINPUT_VIBRATION;
{$ENDIF}
begin
{$IFDEF WINDOWS}
  if XInputSetState <> nil then begin
    if Power < 0 then
      Power := 0;
    if Power > 255 then
      Power := 255;
    Vibration.wLeftMotorSpeed := Power * (65535 div 255);
    Vibration.wRightMotorSpeed := Vibration.wLeftMotorSpeed;
    XInputSetState(JoyId, @Vibration);
  end;
{$ENDIF}
  FVibrationDelay := Delay;
  if Eng.Time + Delay > FVibrationEnd then
    FVibrationEnd := Eng.Time + Delay;
end;

procedure TControl.Subscribe(KeyDown: TKeyDown); overload;
begin
  DEng.LogTagged('D', 'USING DEPRECATED TControl.Subscribe');
  FKeyDown := KeyDown;
end;

function Key(Id: Byte): TKey;
begin
  Result.Device := 1;
  Result.Id := Id;
end;

end.
