// Do Direct Input with Delphi
//
// デジタルジョイスティック用モジュール
// アナログジョイスティックも、デジタルの入力をするように考える。
//
// MCMXCVII  SANDMAN  presents!!
unit ddid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  MMSystem  ;

const
  //装置ID
  DI_KEYB=0;
  DI_JOY1=1;
  DI_JOY2=2;

  //ボタン番号
  DI_B1=0;
  DI_B2=1;
  DI_B3=2;
  DI_B4=3;
  DI_B5=4;
  DI_B6=5;
  DI_B7=6;
  DI_B8=7;
  DI_B9=8;
  DI_B10=9;
  DI_B11=10;
  DI_B12=11;
  DI_B13=12;
  DI_B14=13;
  DI_B15=14;
  DI_B16=15;

  DI_UP=16;
  DI_DOWN=17;
  DI_LEFT=18;
  DI_RIGHT=19;

  //キーボードのみ
  DI_UPLEFT=20;
  DI_UPRIGHT=21;
  DI_DOWNLEFT=22;
  DI_DOWNRIGHT=23;

  //


type TDDIDThreshold = record
  CenterX,CenterY,Up,Down,Left,Right:WORD;
end;


type TDDID=class
  private
    FJI:TJoyInfoEx;
    FJC:TJoyCaps;
    FKeyTbl:Array[0..1,0..23]of Integer;  //キーボードのどのキーを、ゲームパッドのどこと同じとみなすか
    FThreShold:Array[0..2]of TDDIDThreshold;  //スティックの値がこれ以上になったら ONとみなす
    FScaned:Integer;
    function getStick:TPoint;
    function getAStick:TPoint;
    function getButton(iButton:UINT):Boolean;
    function getKeyAssign(iSurfix,iButton:UINT):Integer;
    procedure setKeyAssign(iSurfix,iButton:UINT; vkey:Integer);
    function MID(a,b:Integer):WORD;        //aとbの中間をとる
    function MIX(a,b,ra,rb:Integer):WORD;  //aとbを ra:rbの割合でミックス
  public
    constructor Create;
    procedure caribrate(iJoy:Integer);
    function scan(iJoy:UINT):Boolean;
    function isAvailable(iJoy:UINT):Boolean;  //接続されているかどうか
    property stick:TPoint read getStick;
    property Astick:TPoint read getAStick;
    property button[iButton:UINT]:Boolean read getButton;
    property keyAssign[iSurfix,iButton:UINT]:Integer read getKeyAssign write setKeyAssign;
end;


implementation

const
  BUTTONID: Array[0..15]of Integer = (
    JOY_BUTTON1 , JOY_BUTTON2 , JOY_BUTTON3 , JOY_BUTTON4,
    JOY_BUTTON5 , JOY_BUTTON6 , JOY_BUTTON7 , JOY_BUTTON8,
    JOY_BUTTON9 , JOY_BUTTON10, JOY_BUTTON11, JOY_BUTTON12,
    JOY_BUTTON13, JOY_BUTTON14, JOY_BUTTON15, JOY_BUTTON16
  );

constructor TDDID.Create;
var
  i:Integer;
begin
  FJI.dwSize:=sizeof(TJoyInfoEx);
  FJI.dwFlags:=JOY_RETURNALL + JOY_USEDEADZONE;

  FKeyTbl[0,0]:=Ord('Z'); //VK_Z;
  FKeyTbl[0,1]:=Ord('X'); //VK_X;
  FKeyTbl[0,2]:=Ord('C'); //VK_C;
  FKeyTbl[0,3]:=Ord('A'); //VK_A;
  FKeyTbl[0,4]:=Ord('S'); //VK_S;
  FKeyTbl[0,5]:=Ord('D'); //VK_D;
  FKeyTbl[0,6]:=Ord('1'); //VK_1;
  FKeyTbl[0,7]:=Ord('2'); //VK_2;
  FKeyTbl[0,8]:=Ord('3'); //VK_3;
  FKeyTbl[0,9]:=Ord('4'); //VK_4;
  FKeyTbl[0,10]:=Ord('5'); //VK_5;
  FKeyTbl[0,11]:=Ord('6'); //VK_6;
  FKeyTbl[0,12]:=Ord('7'); //VK_7;
  FKeyTbl[0,13]:=Ord('8'); //VK_8;
  FKeyTbl[0,14]:=Ord('9'); //VK_9;
  FKeyTbl[0,15]:=Ord('0'); //VK_0;

  FKeyTbl[1,0]:=VK_SPACE;
  FKeyTbl[1,1]:=VK_ESCAPE;

  for i:=2 to 15 do
    FKeyTbl[1,i]:=0;

  FKeyTbl[0,16]:=VK_UP;
  FKeyTbl[0,17]:=VK_DOWN;
  FKeyTbl[0,18]:=VK_LEFT;
  FKeyTbl[0,19]:=VK_RIGHT;

  FKeyTbl[1,16]:=VK_NUMPAD8;
  FKeyTbl[1,17]:=VK_NUMPAD2;
  FKeyTbl[1,18]:=VK_NUMPAD4;
  FKeyTbl[1,19]:=VK_NUMPAD6;
  FKeyTbl[1,20]:=VK_NUMPAD7;
  FkeyTbl[1,21]:=VK_NUMPAD9;
  FkeyTbl[1,22]:=VK_NUMPAD1;
  FkeyTbl[1,23]:=VK_NUMPAD3;

  for i:=1 to 2 do begin
    if i=1 then
      JoyGetDevCaps(JOYSTICKID1,@FJC,sizeof(FJC))
    else
      JoyGetDevCaps(JOYSTICKID2,@FJC,sizeof(FJC));

    with FThreshold[i],FJC do begin
      CenterX:=MID(wXmax,wXMin);
      CenterY:=MID(wYmax,wYMin);
      Right:=MIX(wXmax,CenterX, 1,3);
      Left :=MIX(wXmin,CenterX, 1,3);
      Up   :=MIX(wYmin,CenterY, 1,3);
      Down :=MIX(wYmax,CenterY, 1,3);
    end;

  end;

  with FThreshold[0] do begin
    CenterX:=$8000;
    CenterY:=$8000;
    Right:=MID($FFFF,CenterX);
    Left :=MID(0    ,CenterX);
    Up   :=MID(0    ,CenterY);
    Down :=MID($FFFF,CenterY);
  end;
end;

function TDDID.MID(a,b:Integer):WORD;
begin
  result:=(a+b) shr 1;
end;

function TDDID.MIX(a,b,ra,rb:Integer):WORD;
begin
  result:= ((a*ra + b*rb) div (ra+rb));
end;


//スティックを放した状態で呼んで欲しいの
procedure TDDID.caribrate(iJoy:Integer);
var
  id:Integer;
begin
  case iJoy of
    DI_JOY1: id:=JOYSTICKID1;
    DI_JOY2: id:=JOYSTICKID2;
  else
    exit;
  end;

  joyGetPosEx(id,@FJI);
  joyGetDevCaps(id,@FJC,sizeof(FJC));
  with FThreshold[iJoy],FJC,FJI do begin
    CenterX:=wXpos;
    CenterY:=wYPos;
    Right:=MIX(wXmax,CenterX, 1,3);
    Left :=MIX(wXmin,CenterX, 1,3);
    Up   :=MIX(wYmin,CenterY, 1,3);
    Down :=MIX(wYmax,CenterY, 1,3);
  end;
end;

function TDDID.scan(iJoy:UINT):Boolean;
var
  id:UINT;
  i,b,c:UINT;
  function isPressed(iButton:Integer):Boolean;
  begin
    result:=(((GetAsyncKeyState(FKeyTbl[0,iButton]) And $8000)<>0)
            or ((GetAsyncKeyState(FKeyTbl[1,iButton]) And $8000)<>0));
  end;
begin
  result:=True;
  FScaned:=iJoy;

  case iJoy of
    DI_KEYB: id:=DWord(-1);
    DI_JOY1: id:=JOYSTICKID1;
    DI_JOY2: id:=JOYSTICKID2;
    else begin
      result:=False;
      exit;
    end;
  end;

  if id=DWord(-1) then begin
    //ボタンの状態を得る
    b:=0; c:=1;
    for i:=0 to 15 do begin
      if isPressed(i)then
        b:= b or c;
      c:= c Shl 1;
    end;
    FJI.wButtons:=b;
    //スティックの状態を得る
    with FJI do begin
      wXpos:=$8000;
      wYPos:=$8000;
      if isPressed(16) Or isPressed(20) Or isPressed(21) then //上
        Dec(wYpos,$7F00);
      if isPressed(17) Or isPressed(22) Or isPressed(23) then //下
        Inc(wYpos,$7F00);
      if isPressed(18) Or isPressed(20) Or isPressed(22) then //左
        Dec(wXpos,$7F00);
      if isPressed(19) Or isPressed(21) Or isPressed(23) then //右
        Inc(wXpos,$7F00);
    end;
  end else begin
    if joyGetPosEx(id,@FJI)<>JOYERR_NOERROR then begin
      result:=False;
      exit;
    end;
  end;

  with FJI do begin
    if (wXpos = $8000) And (wYpos = $8000) And (wButtons = 0) then
      result:=False;
  end;
end;

function TDDID.getStick:TPoint;
begin
  with FJI,FThreshold[FScaned] do begin
    if wXpos>=Right then
      result.X:=1
    else if wXpos<=Left then
      result.X:=-1
    else
      result.X:=0;

    if wYpos>=Down then
      result.Y:=1
    else if wYpos<=Up then
      result.Y:=-1
    else
      result.Y:=0;
  end;
end;

function TDDID.getAStick:TPoint;
begin
  with FJI,FThreshold[FScaned] do begin
    result.X:=Integer(DWORD(wXpos))-Integer(DWORD(CenterX));
    result.Y:=Integer(DWORD(wYpos))-Integer(DWORD(CenterY));
  end;
end;


function TDDID.getButton(iButton:UINT):Boolean;
begin
  result:=((FJI.wButtons And BUTTONID[iButton])<>0);
end;


function TDDID.getKeyAssign(iSurfix,iButton:UINT):Integer;
begin
  result:=FKeyTbl[iSurfix,iButton];
end;


procedure TDDID.setKeyAssign(iSurfix,iButton:UINT; vkey:Integer);
begin
  FKeyTbl[iSurfix,iButton]:=vkey;
end;

function TDDID.isAvailable(iJoy:UINT):Boolean;  //接続されているかどうか
var
  id:UINT;
begin
  case iJoy of
    DI_KEYB: begin result:=True; Exit; end;
    DI_JOY1: id:=JOYSTICKID1;
    DI_JOY2: id:=JOYSTICKID2;
    else begin
      result:=False;
      exit;
    end;
  end;

  result:=(joyGetPosEx(id,@FJI)=JOYERR_NOERROR)
end;

end.
