basis/game/input/xinput/xinput.factor

   1 USING: game.input math math.order kernel macros fry sequences quotations
   2 arrays windows.directx.xinput combinators accessors windows.types
   3 game.input.dinput sequences.private namespaces classes.struct
   4 windows.errors windows.com.syntax io.encodings.utf16n alien.strings ;
   5 IN: game.input.xinput
   6
   7 SINGLETON: xinput-game-input-backend
   8
   9 xinput-game-input-backend game-input-backend set-global
  10
  11 <PRIVATE
  12 : >axis ( short -- float )
  13     32768 /f ; inline
  14 : >trigger ( byte -- float )
  15     255 /f ; inline
  16 : >vibration ( float -- short )
  17     65535 * >fixnum 0 65535 clamp ; inline
  18 MACRO: map-index-compose ( seq quot -- seq )
  19     '[ '[ _ execute _ ] _ compose ] map-index 1quotation ;
  20
  21 : fill-buttons ( button-bitmap -- button-array )
  22     10 0.0 <array> dup rot >fixnum
  23     { XINPUT_GAMEPAD_START
  24       XINPUT_GAMEPAD_BACK
  25       XINPUT_GAMEPAD_LEFT_THUMB
  26       XINPUT_GAMEPAD_RIGHT_THUMB
  27       XINPUT_GAMEPAD_LEFT_SHOULDER
  28       XINPUT_GAMEPAD_RIGHT_SHOULDER
  29       XINPUT_GAMEPAD_A
  30       XINPUT_GAMEPAD_B
  31       XINPUT_GAMEPAD_X
  32       XINPUT_GAMEPAD_Y }
  33       [ [ bitand ] dip swap 0 = [ 2drop ] [ [ 1.0 ] 2dip swap set-nth ] if ]
  34       map-index-compose 2cleave ;
  35
  36  : >pov ( byte -- symbol )
  37      {
  38          pov-neutral
  39          pov-up
  40          pov-down
  41          pov-neutral
  42          pov-left
  43          pov-up-left
  44          pov-down-left
  45          pov-neutral
  46          pov-right
  47          pov-up-right
  48          pov-down-right
  49          pov-neutral
  50          pov-neutral
  51          pov-neutral
  52          pov-neutral
  53          pov-neutral
  54      } nth ;
  55
  56 : fill-controller-state ( XINPUT_STATE -- controller-state )
  57     Gamepad>> controller-state new dup rot
  58     {
  59         [ wButtons>> 0xf bitand >pov swap pov<< ]
  60         [ wButtons>> fill-buttons swap buttons<< ]
  61         [ sThumbLX>> >axis swap x<< ]
  62         [ sThumbLY>> >axis swap y<< ]
  63         [ sThumbRX>> >axis swap rx<< ]
  64         [ sThumbRY>> >axis swap ry<< ]
  65         [ bLeftTrigger>> >trigger swap z<< ]
  66         [ bRightTrigger>> >trigger swap rz<< ]
  67     } 2cleave ;
  68 PRIVATE>
  69
  70 M: xinput-game-input-backend (open-game-input)
  71     TRUE XInputEnable
  72     create-dinput
  73     create-device-change-window
  74     find-keyboard
  75     find-mouse
  76     add-wm-devicechange ;
  77
  78 M: xinput-game-input-backend (close-game-input)
  79     remove-wm-devicechange
  80     release-mouse
  81     release-keyboard
  82     close-device-change-window
  83     delete-dinput
  84     FALSE XInputEnable ;
  85
  86 M: xinput-game-input-backend (reset-game-input)
  87     [
  88         {
  89             +dinput+ +keyboard-device+ +keyboard-state+
  90             +controller-devices+ +controller-guids+
  91             +device-change-window+ +device-change-handle+
  92         } [ off ] each
  93     ] with-global ;
  94
  95 M: xinput-game-input-backend get-controllers
  96     { 0 1 2 3 } ;
  97
  98 M: xinput-game-input-backend product-string
  99     dup number?
 100     [ drop "Controller (Xbox 360 Wireless Receiver for Windows)" ]
 101     [ handle>> device-info tszProductName>> utf16n alien>string ]
 102     if ;
 103
 104 M: xinput-game-input-backend product-id
 105     dup number?
 106     [ drop GUID: {02a1045e-0000-0000-0000-504944564944} ]
 107     [ handle>> device-info guidProduct>> ]
 108     if ;
 109
 110 M: xinput-game-input-backend instance-id
 111     dup number?
 112     [ drop GUID: {c6075b30-fbca-11de-8001-444553540000} ]
 113     [ handle>> device-guid ]
 114     if ;
 115
 116 M: xinput-game-input-backend read-controller
 117     XINPUT_STATE <struct> [ XInputGetState ] keep
 118     swap drop fill-controller-state ;
 119
 120 M: xinput-game-input-backend calibrate-controller drop ;
 121
 122 M: xinput-game-input-backend vibrate-controller
 123     [ >vibration ] bi@ XINPUT_VIBRATION <struct-boa> XInputSetState drop ;
 124
 125 M: xinput-game-input-backend read-keyboard
 126     +keyboard-device+ get
 127     [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ]
 128     [ ] [ f ] with-acquisition ;
 129
 130 M: xinput-game-input-backend read-mouse
 131     +mouse-device+ get [ +mouse-buffer+ get MOUSE-BUFFER-SIZE read-device-buffer ]
 132     [ fill-mouse-state ] [ f ] with-acquisition ;
 133
 134 M: xinput-game-input-backend reset-mouse
 135     +mouse-device+ get [ f MOUSE-BUFFER-SIZE read-device-buffer ]
 136     [ 2drop ] [ ] with-acquisition
 137     +mouse-state+ get
 138         0 >>dx
 139         0 >>dy
 140         0 >>scroll-dx
 141         0 >>scroll-dy
 142         drop ;