diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 7262d77e87..34ef318b95 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -13,9 +13,9 @@ IN: combinators.lib ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : bi+ ( obj quot quot -- quot' quot' ) - [ [ curry ] curry ] bi@ bi ; + [ [ curry ] curry ] bi@ bi ; inline : tri+ ( obj quot quot quot -- quot' quot' quot' ) - [ [ curry ] curry ] tri@ tri ; + [ [ curry ] curry ] tri@ tri ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Generalized versions of core combinators diff --git a/extra/game-input/backend/dinput/dinput.factor b/extra/game-input/backend/dinput/dinput.factor index 594d6ef123..710ba49608 100755 --- a/extra/game-input/backend/dinput/dinput.factor +++ b/extra/game-input/backend/dinput/dinput.factor @@ -2,7 +2,8 @@ USING: windows.dinput windows.dinput.constants game-input symbols alien.c-types windows.ole32 namespaces assocs kernel arrays hashtables windows.kernel32 windows.com windows.dinput shuffle windows.user32 windows.messages sequences combinators -math.geometry.rect ui.windows accessors math windows ; +math.geometry.rect ui.windows accessors math windows +alien.strings io.encodings.utf16 ; IN: game-input.backend.dinput SINGLETON: dinput-game-input-backend @@ -22,20 +23,29 @@ SYMBOLS: +dinput+ +keyboard-device+ +controller-devices+ +dinput+ get swap f [ f IDirectInput8W::CreateDevice ole32-error ] keep *void* ; +: set-coop-level ( device -- device ) + dup +device-change-window+ get DISCL_BACKGROUND DISCL_NONEXCLUSIVE bitor + IDirectInputDevice8W::SetCooperativeLevel ole32-error ; + : configure-keyboard ( keyboard -- keyboard ) - ; + dup c_dfDIKeyboard_HID IDirectInputDevice8W::SetDataFormat + ole32-error set-coop-level ; : configure-controller ( controller -- controller ) - ; + dup c_dfDIJoystick2 IDirectInputDevice8W::SetDataFormat + ole32-error set-coop-level ; : find-keyboard ( -- ) GUID_SysKeyboard get device-for-guid configure-keyboard +keyboard-device+ set-global ; -: controller-device? ( device -- ? ) +: device-info ( device -- DIDEVICEIMAGEINFOW ) "DIDEVICEINSTANCEW" "DIDEVICEINSTANCEW" heap-size over set-DIDEVICEINSTANCEW-dwSize - [ IDirectInputDevice8W::GetDeviceInfo ole32-error ] keep + [ IDirectInputDevice8W::GetDeviceInfo ole32-error ] keep ; + +: controller-device? ( device -- ? ) + device-info DIDEVICEINSTANCEW-dwDevType GET_DIDEVICE_TYPE DI8DEVTYPE_KEYBOARD DI8DEVTYPE_MOUSE 2array member? not ; @@ -43,15 +53,17 @@ SYMBOLS: +dinput+ +keyboard-device+ +controller-devices+ +dinput+ get swap IDirectInput8W::GetDeviceStatus [ ole32-error ] [ S_OK = ] bi ; +: ( memory -- byte-array ) + "GUID" heap-size memory>byte-array ; + : add-controller ( guid -- ) - [ device-for-guid configure-controller ] - [ "GUID" heap-size memory>byte-array ] bi + [ device-for-guid configure-controller ] [ ] bi + over controller-device? [ +controller-devices+ get set-at ] [ drop com-release ] if ; : remove-controller ( guid -- ) - "GUID" heap-size memory>byte-array - +controller-devices+ get [ com-release f ] change-at ; + +controller-devices+ get [ com-release f ] change-at ; : find-controller-callback ( -- alien ) [ ! ( lpddi pvRef -- ? ) @@ -124,12 +136,11 @@ TUPLE: window-rect < rect window-loc ; [ DestroyWindow win32-error=0/f f ] change-at ; : add-wm-devicechange ( -- ) - create-device-change-window - [ 4dup handle-wm-devicechange DefWindowProc ] WM_DEVICECHANGE add-wm-handler ; + [ 4dup handle-wm-devicechange DefWindowProc ] + WM_DEVICECHANGE add-wm-handler ; : remove-wm-devicechange ( -- ) - WM_DEVICECHANGE wm-handlers get-global delete-at - close-device-change-window ; + WM_DEVICECHANGE wm-handlers get-global delete-at ; : release-controllers ( -- ) +controller-devices+ global [ @@ -137,15 +148,80 @@ TUPLE: window-rect < rect window-loc ; ] change-at ; : release-keyboard ( -- ) - +keyboard-device+ global [ com-release f ] change-at ; + +keyboard-device+ global + [ com-release f ] change-at ; M: dinput-game-input-backend open-game-input create-dinput + create-device-change-window find-keyboard - find-controllers ; + find-controllers + add-wm-devicechange ; M: dinput-game-input-backend close-game-input + remove-wm-devicechange release-controllers release-keyboard + close-device-change-window delete-dinput ; +M: dinput-game-input-backend get-controllers + +controller-devices+ get + [ nip controller boa ] { } assoc>map ; + +M: dinput-game-input-backend product-string + handle>> device-info DIDEVICEINSTANCEW-tszProductName + utf16le alien>string ; + +M: dinput-game-input-backend product-id + handle>> device-info DIDEVICEINSTANCEW-guidProduct ; +M: dinput-game-input-backend instance-id + handle>> device-info DIDEVICEINSTANCEW-guidInstance ; + +: with-acquisition ( device quot -- ) + over IDirectInputDevice8W::Acquire ole32-error + over [ IDirectInputDevice8W::Unacquire ole32-error ] curry + [ ] cleanup ; inline + +: >axis ( long -- float ) + ; +: >slider ( long -- float ) + ; +: >pov ( long -- float ) + ; +: >buttons ( alien -- array ) + 128 memory>byte-array [ HEX: 80 bitand c-bool> ] { } map-as ; + +: ( DIJOYSTATE2 -- controller-state ) + ! XXX only transfer elements that are present on device + { + [ DIJOYSTATE2-lX >axis ] + [ DIJOYSTATE2-lY >axis ] + [ DIJOYSTATE2-lZ >axis ] + [ DIJOYSTATE2-lRx >axis ] + [ DIJOYSTATE2-lRy >axis ] + [ DIJOYSTATE2-lRz >axis ] + [ DIJOYSTATE2-rglSlider *long >slider ] + [ DIJOYSTATE2-rgdwPOV *uint >pov ] + [ DIJOYSTATE2-rgbButtons >buttons ] + } cleave controller-state boa ; + +: ( byte-array -- keyboard-state ) + [ c-bool> ] { } map-as keyboard-state boa ; + +: get-device-state ( device state-size -- byte-array ) + dup + [ IDirectInputDevice8W::GetDeviceState ole32-error ] keep ; + +M: dinput-game-input-backend read-controller + handle>> [ + "DIJOYSTATE2" heap-size get-device-state + ] with-acquisition ; + +M: dinput-game-input-backend calibrate-controller + handle>> f 0 IDirectInputDevice8W::RunControlPanel ole32-error ; + +M: dinput-game-input-backend read-keyboard + +keyboard-device+ get [ + 256 get-device-state + ] with-acquisition ; diff --git a/extra/game-input/scancodes/authors.txt b/extra/game-input/scancodes/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/scancodes/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/scancodes/summary.txt b/extra/game-input/scancodes/summary.txt new file mode 100644 index 0000000000..b1bdefeb71 --- /dev/null +++ b/extra/game-input/scancodes/summary.txt @@ -0,0 +1 @@ +Scan code constants for HID keyboards diff --git a/extra/game-input/scancodes/tags.txt b/extra/game-input/scancodes/tags.txt new file mode 100644 index 0000000000..6f4814c59c --- /dev/null +++ b/extra/game-input/scancodes/tags.txt @@ -0,0 +1,2 @@ +keyboard +input diff --git a/extra/iokit/hid/authors.txt b/extra/iokit/hid/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/iokit/hid/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/iokit/hid/summary.txt b/extra/iokit/hid/summary.txt new file mode 100644 index 0000000000..5b660488a4 --- /dev/null +++ b/extra/iokit/hid/summary.txt @@ -0,0 +1 @@ +HID Manager bindings diff --git a/extra/iokit/hid/tags.txt b/extra/iokit/hid/tags.txt new file mode 100644 index 0000000000..c83070b657 --- /dev/null +++ b/extra/iokit/hid/tags.txt @@ -0,0 +1,3 @@ +mac +bindings +system