mouse support for game-input

db4
Joe Groff 2009-05-05 09:45:43 -05:00
parent 17607941b9
commit 5d43551f08
4 changed files with 146 additions and 12 deletions

View File

@ -444,6 +444,18 @@ CONSTANT: DISCL_FOREGROUND HEX: 00000004
CONSTANT: DISCL_BACKGROUND HEX: 00000008
CONSTANT: DISCL_NOWINKEY HEX: 00000010
CONSTANT: DIMOFS_X 0
CONSTANT: DIMOFS_Y 4
CONSTANT: DIMOFS_Z 8
CONSTANT: DIMOFS_BUTTON0 12
CONSTANT: DIMOFS_BUTTON1 13
CONSTANT: DIMOFS_BUTTON2 14
CONSTANT: DIMOFS_BUTTON3 15
CONSTANT: DIMOFS_BUTTON4 16
CONSTANT: DIMOFS_BUTTON5 17
CONSTANT: DIMOFS_BUTTON6 18
CONSTANT: DIMOFS_BUTTON7 19
CONSTANT: DIK_ESCAPE HEX: 01
CONSTANT: DIK_1 HEX: 02
CONSTANT: DIK_2 HEX: 03

View File

@ -8,13 +8,16 @@ byte-arrays game-input.dinput.keys-array game-input
ui.backend.windows windows.errors ;
IN: game-input.dinput
CONSTANT: MOUSE-BUFFER-SIZE 16
SINGLETON: dinput-game-input-backend
dinput-game-input-backend game-input-backend set-global
SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
+controller-devices+ +controller-guids+
+device-change-window+ +device-change-handle+ ;
+device-change-window+ +device-change-handle+
+mouse-device+ +mouse-state+ +mouse-buffer+ ;
: create-dinput ( -- )
f GetModuleHandle DIRECTINPUT_VERSION IDirectInput8W-iid
@ -35,8 +38,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
: set-data-format ( device format-symbol -- )
get IDirectInputDevice8W::SetDataFormat ole32-error ;
: <buffer-size-diprop> ( size -- DIPROPDWORD )
"DIPROPDWORD" <c-object>
"DIPROPDWORD" heap-size over set-DIPROPHEADER-dwSize
"DIPROPHEADER" heap-size over set-DIPROPHEADER-dwHeaderSize
0 over set-DIPROPHEADER-dwObj
DIPH_DEVICE over set-DIPROPHEADER-dwHow
swap over set-DIPROPDWORD-dwData ;
: set-buffer-size ( device size -- )
DIPROP_BUFFERSIZE swap <buffer-size-diprop>
IDirectInputDevice8W::SetProperty ole32-error ;
: configure-keyboard ( keyboard -- )
[ c_dfDIKeyboard_HID set-data-format ] [ set-coop-level ] bi ;
: configure-mouse ( mouse -- )
[ c_dfDIMouse2 set-data-format ]
[ MOUSE-BUFFER-SIZE set-buffer-size ]
[ set-coop-level ] tri ;
: configure-controller ( controller -- )
[ c_dfDIJoystick2 set-data-format ] [ set-coop-level ] bi ;
@ -47,6 +66,15 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
256 <byte-array> <keys-array> keyboard-state boa
+keyboard-state+ set-global ;
: find-mouse ( -- )
GUID_SysMouse device-for-guid
[ configure-mouse ]
[ +mouse-device+ set-global ] bi
0 0 0 0 8 <vector> mouse-state boa
+mouse-device+ set-global ;
MOUSE-BUFFER-SIZE "DIDEVICEOBJECTDATA" <c-array>
+mouse-buffer+ set-global ;
: device-info ( device -- DIDEVICEIMAGEINFOW )
"DIDEVICEINSTANCEW" <c-object>
"DIDEVICEINSTANCEW" heap-size over set-DIDEVICEINSTANCEW-dwSize
@ -190,16 +218,22 @@ TUPLE: window-rect < rect window-loc ;
+keyboard-device+ [ com-release f ] change-global
f +keyboard-state+ set-global ;
: release-mouse ( -- )
+mouse-device+ [ com-release f ] change-global
f +mouse-state+ set-global ;
M: dinput-game-input-backend (open-game-input)
create-dinput
create-device-change-window
find-keyboard
find-mouse
set-up-controllers
add-wm-devicechange ;
M: dinput-game-input-backend (close-game-input)
remove-wm-devicechange
release-controllers
release-mouse
release-keyboard
close-device-change-window
delete-dinput ;
@ -263,6 +297,22 @@ CONSTANT: pov-values
[ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ]
} 2cleave ;
: read-device-buffer ( device buffer count -- buffer count' )
[ "DIDEVICEOBJECTDATA" heap-size ] 2dip <uint>
[ 0 IDirectInputDevice8W::GetDeviceData ole32-error ] 2keep *uint ;
: (fill-mouse-state) ( state DIDEVICEOBJECTDATA -- )
[ DIDEVICEOBJECTDATA-dwData ] [ DIDEVICEOBJECTDATA-dwOfs ] bi {
{ DIMOFS_X [ [ + ] curry change-dx drop ] }
{ DIMOFS_Y [ [ + ] curry change-dy drop ] }
{ DIMOFS_Z [ [ + ] curry change-scroll-dy drop ] }
[ [ c-bool> ] [ DIMOFS_BUTTON0 - ] bi* rot buttons>> set-nth ]
} case ;
: fill-mouse-state ( buffer count -- )
[ +mouse-state+ get ] 2dip swap
[ DIDEVICEOBJECTDATA-nth (fill-mouse-state) ] curry each ;
: get-device-state ( device byte-array -- )
[ dup IDirectInputDevice8W::Poll ole32-error ] dip
[ length ] keep
@ -283,3 +333,11 @@ M: dinput-game-input-backend read-keyboard
+keyboard-device+ get
[ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ]
[ ] [ f ] with-acquisition ;
M: dinput-game-input-backend read-mouse
+mouse-device+ get [ +mouse-buffer+ get MOUSE-BUFFER-SIZE read-device-buffer ]
[ fill-mouse-state ] [ f ] with-acquisition ;
M: dinput-game-input-backend reset-mouse
+mouse-device+ get [ f MOUSE-BUFFER-SIZE read-device-buffer ]
[ 2drop ] [ ] with-acquisition ;

View File

@ -73,6 +73,15 @@ M: keyboard-state clone
HOOK: read-keyboard game-input-backend ( -- keyboard-state )
TUPLE: mouse-state dx dy scroll-dx scroll-dy buttons ;
M: mouse-state clone
call-next-method dup buttons>> clone >>buttons ;
HOOK: read-mouse game-input-backend ( -- mouse-state )
HOOK: reset-mouse game-input-backend ( -- )
{
{ [ os windows? ] [ "game-input.dinput" require ] }
{ [ os macosx? ] [ "game-input.iokit" require ] }

View File

@ -3,7 +3,7 @@ kernel cocoa.enumeration destructors math.parser cocoa.application
sequences locals combinators.short-circuit threads
namespaces assocs vectors arrays combinators
core-foundation.run-loop accessors sequences.private
alien.c-types math parser game-input ;
alien.c-types math parser game-input vectors ;
IN: game-input.iokit
SINGLETON: iokit-game-input-backend
@ -23,9 +23,13 @@ iokit-game-input-backend game-input-backend set-global
CONSTANT: game-devices-matching-seq
{
H{ { "DeviceUsage" 1 } { "DeviceUsagePage" 1 } } ! pointers
H{ { "DeviceUsage" 2 } { "DeviceUsagePage" 1 } } ! mouses
H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks
H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads
H{ { "DeviceUsage" 6 } { "DeviceUsagePage" 1 } } ! keyboards
H{ { "DeviceUsage" 7 } { "DeviceUsagePage" 1 } } ! keypads
H{ { "DeviceUsage" 8 } { "DeviceUsagePage" 1 } } ! multiaxis controllers
}
CONSTANT: buttons-matching-hash
@ -46,6 +50,8 @@ CONSTANT: rz-axis-matching-hash
H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } }
CONSTANT: slider-matching-hash
H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } }
CONSTANT: wheel-matching-hash
H{ { "UsagePage" 1 } { "Usage" HEX: 38 } { "Type" 1 } }
CONSTANT: hat-switch-matching-hash
H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } }
@ -90,10 +96,17 @@ CONSTANT: hat-switch-matching-hash
: transfer-element-property ( element from-key to-key -- )
[ dupd element-property ] dip swap set-element-property ;
: mouse-device? ( device -- ? )
{
[ 1 1 IOHIDDeviceConformsTo ]
[ 1 2 IOHIDDeviceConformsTo ]
} 1|| ;
: controller-device? ( device -- ? )
{
[ 1 4 IOHIDDeviceConformsTo ]
[ 1 5 IOHIDDeviceConformsTo ]
[ 1 8 IOHIDDeviceConformsTo ]
} 1|| ;
: element-usage ( element -- {usage-page,usage} )
@ -118,6 +131,8 @@ CONSTANT: hat-switch-matching-hash
{ 1 HEX: 35 } = ; inline
: slider? ( {usage-page,usage} -- ? )
{ 1 HEX: 36 } = ; inline
: wheel? ( {usage-page,usage} -- ? )
{ 1 HEX: 38 } = ; inline
: hat-switch? ( {usage-page,usage} -- ? )
{ 1 HEX: 39 } = ; inline
@ -132,12 +147,17 @@ CONSTANT: pov-values
IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
: axis-value ( value -- [-1,1] )
kIOHIDValueScaleTypeCalibrated IOHIDValueGetScaledValue ;
: mouse-axis-value ( value -- n )
IOHIDValueGetIntegerValue ;
: pov-value ( value -- pov-direction )
IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ;
: record-button ( hid-value usage state -- )
[ button-value ] [ second 1- ] [ buttons>> ] tri* set-nth ;
: record-controller ( controller-state value -- )
dup IOHIDValueGetElement element-usage {
{ [ dup button? ] [ [ button-value ] [ second 1- ] bi* rot buttons>> set-nth ] }
{ [ dup button? ] [ rot record-button ] }
{ [ dup x-axis? ] [ drop axis-value >>x drop ] }
{ [ dup y-axis? ] [ drop axis-value >>y drop ] }
{ [ dup z-axis? ] [ drop axis-value >>z drop ] }
@ -149,7 +169,7 @@ CONSTANT: pov-values
[ 3drop ]
} cond ;
SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ;
: ?set-nth ( value nth seq -- )
2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ;
@ -161,6 +181,27 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
+keyboard-state+ get ?set-nth
] [ drop ] if ;
: record-mouse ( value -- )
dup IOHIDValueGetElement element-usage {
{ [ dup button? ] [ +mouse-state+ get record-button ] }
{ [ dup x-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dx drop ] }
{ [ dup y-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dy drop ] }
{ [ dup wheel? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dx drop ] }
{ [ dup z-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dy drop ] }
[ 2drop ]
} cond ;
M: iokit-game-input-backend read-mouse
+mouse-state+ get ;
M: iokit-game-input-backend reset-mouse
+mouse-state+ get
0 >>dx
0 >>dy
0 >>scroll-dx
0 >>scroll-dy
drop ;
: default-calibrate-saturation ( element -- )
[ kIOHIDElementMinKey kIOHIDElementCalibrationSaturationMinKey transfer-element-property ]
[ kIOHIDElementMaxKey kIOHIDElementCalibrationSaturationMaxKey transfer-element-property ]
@ -194,12 +235,21 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
[ button-count f <array> ]
} cleave controller-state boa ;
: ?add-mouse-buttons ( device -- )
button-count +mouse-state+ get buttons>>
2dup length >
[ set-length ] [ 2drop ] if ;
: device-matched-callback ( -- alien )
[| context result sender device |
device controller-device? [
device <device-controller-state>
device +controller-states+ get set-at
] when
{
{ [ device controller-device? ] [
device <device-controller-state>
device +controller-states+ get set-at
] }
{ [ device mouse-device? ] [ device ?add-mouse-buttons ] }
[ ]
} cond
] IOHIDDeviceCallback ;
: device-removed-callback ( -- alien )
@ -209,15 +259,20 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
: device-input-callback ( -- alien )
[| context result sender value |
sender controller-device?
[ sender +controller-states+ get at value record-controller ]
[ value record-keyboard ]
if
{
{ [ sender controller-device? ] [
sender +controller-states+ get at value record-controller
] }
{ [ sender mouse-device? ] [ value record-mouse ] }
[ value record-keyboard ]
} cond
] IOHIDValueCallback ;
: initialize-variables ( manager -- )
+hid-manager+ set-global
4 <vector> +controller-states+ set-global
0 0 0 0 2 <vector> mouse-state boa
+mouse-state+ set-global
256 f <array> +keyboard-state+ set-global ;
M: iokit-game-input-backend (open-game-input)