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 ;
7 SINGLETON: xinput-game-input-backend
9 xinput-game-input-backend game-input-backend set-global
12 : >axis ( short -- float )
14 : >trigger ( byte -- float )
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 ;
21 : fill-buttons ( button-bitmap -- button-array )
22 10 0.0 <array> dup rot >fixnum
23 { XINPUT_GAMEPAD_START
25 XINPUT_GAMEPAD_LEFT_THUMB
26 XINPUT_GAMEPAD_RIGHT_THUMB
27 XINPUT_GAMEPAD_LEFT_SHOULDER
28 XINPUT_GAMEPAD_RIGHT_SHOULDER
33 [ [ bitand ] dip swap 0 = [ 2drop ] [ [ 1.0 ] 2dip swap set-nth ] if ]
34 map-index-compose 2cleave ;
36 : >pov ( byte -- symbol )
56 : fill-controller-state ( XINPUT_STATE -- controller-state )
57 Gamepad>> controller-state new dup rot
59 [ wButtons>> HEX: f 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<< ]
70 M: xinput-game-input-backend (open-game-input)
73 create-device-change-window
78 M: xinput-game-input-backend (close-game-input)
79 remove-wm-devicechange
82 close-device-change-window
86 M: xinput-game-input-backend (reset-game-input)
89 +dinput+ +keyboard-device+ +keyboard-state+
90 +controller-devices+ +controller-guids+
91 +device-change-window+ +device-change-handle+
95 M: xinput-game-input-backend get-controllers
98 M: xinput-game-input-backend product-string
100 [ drop "Controller (Xbox 360 Wireless Receiver for Windows)" ]
101 [ handle>> device-info tszProductName>> utf16n alien>string ]
104 M: xinput-game-input-backend product-id
106 [ drop GUID: {02a1045e-0000-0000-0000-504944564944} ]
107 [ handle>> device-info guidProduct>> ]
110 M: xinput-game-input-backend instance-id
112 [ drop GUID: {c6075b30-fbca-11de-8001-444553540000} ]
113 [ handle>> device-guid ]
116 M: xinput-game-input-backend read-controller
117 XINPUT_STATE <struct> [ XInputGetState ] keep
118 swap drop fill-controller-state ;
120 M: xinput-game-input-backend calibrate-controller drop ;
122 M: xinput-game-input-backend vibrate-controller
123 [ >vibration ] bi@ XINPUT_VIBRATION <struct-boa> XInputSetState drop ;
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 ;
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 ;
134 M: xinput-game-input-backend reset-mouse
135 +mouse-device+ get [ f MOUSE-BUFFER-SIZE read-device-buffer ]
136 [ 2drop ] [ ] with-acquisition