Temporary xinput backend for game.input

basis/game/input/xinput/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

basis/game/input/xinput/summary.txt

@@ -0,0 +1 @@
+XInput backend for game.input, borrows keyboard and mouse handling from game.input.dinput

basis/game/input/xinput/tags.txt

@@ -0,0 +1,2 @@
+unportable
+games

basis/game/input/xinput/xinput.factor

@@ -0,0 +1,142 @@
+USING: game.input math math.order kernel macros fry sequences quotations
+arrays windows.directx.xinput combinators accessors windows.types
+game.input.dinput sequences.private namespaces classes.struct
+windows.errors windows.com.syntax io.encodings.utf16n alien.strings ;
+IN: game.input.xinput
+
+SINGLETON: xinput-game-input-backend
+
+xinput-game-input-backend game-input-backend set-global
+
+<PRIVATE
+: >axis ( short -- float )
+    32768 /f ; inline
+: >trigger ( byte -- float )
+    255 /f ; inline
+: >vibration ( float -- short )
+    65535 * >fixnum 0 65535 clamp ; inline
+MACRO: map-index-compose ( seq quot -- seq )
+    '[ '[ _ execute _ ] _ compose ] map-index 1quotation ;
+    
+: fill-buttons ( button-bitmap -- button-array )
+    10 0.0 <array> dup rot >fixnum
+    { XINPUT_GAMEPAD_START
+      XINPUT_GAMEPAD_BACK
+      XINPUT_GAMEPAD_LEFT_THUMB
+      XINPUT_GAMEPAD_RIGHT_THUMB
+      XINPUT_GAMEPAD_LEFT_SHOULDER
+      XINPUT_GAMEPAD_RIGHT_SHOULDER
+      XINPUT_GAMEPAD_A
+      XINPUT_GAMEPAD_B
+      XINPUT_GAMEPAD_X
+      XINPUT_GAMEPAD_Y }
+      [ [ bitand ] dip swap 0 = [ 2drop ] [ 1.0 -rot swap set-nth ] if ]
+      map-index-compose 2cleave ;
+
+ : >pov ( byte -- symbol )
+     {
+         pov-neutral
+         pov-up
+         pov-down
+         pov-neutral
+         pov-left
+         pov-up-left
+         pov-down-left
+         pov-neutral
+         pov-right
+         pov-up-right
+         pov-down-right
+         pov-neutral
+         pov-neutral
+         pov-neutral
+         pov-neutral
+         pov-neutral
+     } nth ;
+
+: fill-controller-state ( XINPUT_STATE -- controller-state )
+    Gamepad>> controller-state new dup rot
+    {
+        [ wButtons>> HEX: f bitand >pov swap (>>pov) ]
+        [ wButtons>> fill-buttons swap (>>buttons) ]
+        [ sThumbLX>> >axis swap (>>x) ]
+        [ sThumbLY>> >axis swap (>>y) ]
+        [ sThumbRX>> >axis swap (>>rx) ]
+        [ sThumbRY>> >axis swap (>>ry) ]
+        [ bLeftTrigger>> >trigger swap (>>z) ]
+        [ bRightTrigger>> >trigger swap (>>rz) ]
+    } 2cleave ;
+PRIVATE>
+
+M: xinput-game-input-backend (open-game-input)
+    TRUE XInputEnable
+    create-dinput
+    create-device-change-window
+    find-keyboard
+    find-mouse
+    add-wm-devicechange ;
+
+M: xinput-game-input-backend (close-game-input)
+    remove-wm-devicechange
+    release-mouse
+    release-keyboard
+    close-device-change-window
+    delete-dinput
+    FALSE XInputEnable ;
+
+M: xinput-game-input-backend (reset-game-input)
+    global [
+        {
+            +dinput+ +keyboard-device+ +keyboard-state+
+            +controller-devices+ +controller-guids+
+            +device-change-window+ +device-change-handle+
+        } [ off ] each
+    ] bind ;
+
+M: xinput-game-input-backend get-controllers
+    { 0 1 2 3 } ;
+
+M: xinput-game-input-backend product-string
+    dup number?
+    [ drop "Controller (Xbox 360 Wireless Receiver for Windows)" ]
+    [ handle>> device-info tszProductName>> utf16n alien>string ]
+    if ;
+
+M: xinput-game-input-backend product-id
+    dup number?
+    [ drop GUID: {02a1045e-0000-0000-0000-504944564944} ]
+    [ handle>> device-info guidProduct>> ]
+    if ;
+
+M: xinput-game-input-backend instance-id
+    dup number?
+    [ drop GUID: {c6075b30-fbca-11de-8001-444553540000} ]
+    [ handle>> device-guid ]
+    if ;
+
+M: xinput-game-input-backend read-controller
+    XINPUT_STATE <struct> [ XInputGetState ] keep
+    swap drop fill-controller-state ;
+
+M: xinput-game-input-backend calibrate-controller drop ;
+
+M: xinput-game-input-backend vibrate-controller
+    [ >vibration ] bi@ XINPUT_VIBRATION <struct-boa> XInputSetState drop ;
+
+M: xinput-game-input-backend read-keyboard
+    +keyboard-device+ get
+    [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ]
+    [ ] [ f ] with-acquisition ;
+
+M: xinput-game-input-backend read-mouse
+    +mouse-device+ get [ +mouse-buffer+ get MOUSE-BUFFER-SIZE read-device-buffer ]
+    [ fill-mouse-state ] [ f ] with-acquisition ;
+
+M: xinput-game-input-backend reset-mouse
+    +mouse-device+ get [ f MOUSE-BUFFER-SIZE read-device-buffer ]
+    [ 2drop ] [ ] with-acquisition
+    +mouse-state+ get
+        0 >>dx
+        0 >>dy
+        0 >>scroll-dx
+        0 >>scroll-dy
+        drop ;