diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor index 20a54dff98..e5e32aac0e 100755 --- a/basis/windows/dinput/dinput.factor +++ b/basis/windows/dinput/dinput.factor @@ -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 diff --git a/extra/game-input/dinput/dinput.factor b/extra/game-input/dinput/dinput.factor index 20815859ab..90141c29e1 100755 --- a/extra/game-input/dinput/dinput.factor +++ b/extra/game-input/dinput/dinput.factor @@ -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 ; +: ( size -- DIPROPDWORD ) + "DIPROPDWORD" + "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 + 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 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 mouse-state boa + +mouse-device+ set-global ; + MOUSE-BUFFER-SIZE "DIDEVICEOBJECTDATA" + +mouse-buffer+ set-global ; + : device-info ( device -- DIDEVICEIMAGEINFOW ) "DIDEVICEINSTANCEW" "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 + [ 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 ; diff --git a/extra/game-input/game-input.factor b/extra/game-input/game-input.factor index 6efe31861a..8281b7bc4c 100755 --- a/extra/game-input/game-input.factor +++ b/extra/game-input/game-input.factor @@ -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 ] } diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor index 2ded263899..0cc8b5d51f 100755 --- a/extra/game-input/iokit/iokit.factor +++ b/extra/game-input/iokit/iokit.factor @@ -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 ] } 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-states+ get set-at - ] when + { + { [ device controller-device? ] [ + device + 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 +controller-states+ set-global + 0 0 0 0 2 mouse-state boa + +mouse-state+ set-global 256 f +keyboard-state+ set-global ; M: iokit-game-input-backend (open-game-input)