USING: cocoa cocoa.plists core-foundation iokit iokit.hid kernel cocoa.enumeration destructors math.parser cocoa.application core-foundation.data core-foundation.strings sequences locals combinators.short-circuit threads namespaces assocs arrays combinators hints alien core-foundation.run-loop accessors sequences.private alien.c-types alien.data math parser game.input vectors bit-arrays unix.types ; FROM: namespaces => change-global ; IN: game.input.iokit SINGLETON: iokit-game-input-backend SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ; iokit-game-input-backend game-input-backend set-global : make-hid-manager ( -- alien ) f 0 IOHIDManagerCreate ; : set-hid-manager-matching ( alien matching-seq -- ) >plist IOHIDManagerSetDeviceMatchingMultiple ; : devices-from-hid-manager ( manager -- vector ) [ IOHIDManagerCopyDevices [ &CFRelease NSFastEnumeration>vector ] [ f ] if* ] with-destructors ; CONSTANT: game-devices-matching-seq { 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 H{ { "UsagePage" 9 } { "Type" 2 } } CONSTANT: keys-matching-hash H{ { "UsagePage" 7 } { "Type" 2 } } CONSTANT: x-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x30 } { "Type" 1 } } CONSTANT: y-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x31 } { "Type" 1 } } CONSTANT: z-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x32 } { "Type" 1 } } CONSTANT: rx-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x33 } { "Type" 1 } } CONSTANT: ry-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x34 } { "Type" 1 } } CONSTANT: rz-axis-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x35 } { "Type" 1 } } CONSTANT: slider-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x36 } { "Type" 1 } } CONSTANT: wheel-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x38 } { "Type" 1 } } CONSTANT: hat-switch-matching-hash H{ { "UsagePage" 1 } { "Usage" 0x39 } { "Type" 1 } } : device-elements-matching ( device matching-hash -- vector ) [ >plist 0 IOHIDDeviceCopyMatchingElements [ &CFRelease NSFastEnumeration>vector ] [ f ] if* ] with-destructors ; : button-count ( device -- button-count ) buttons-matching-hash device-elements-matching length ; : ?axis ( device hash -- axis/f ) device-elements-matching ?first ; : ?x-axis ( device -- ? ) x-axis-matching-hash ?axis ; : ?y-axis ( device -- ? ) y-axis-matching-hash ?axis ; : ?z-axis ( device -- ? ) z-axis-matching-hash ?axis ; : ?rx-axis ( device -- ? ) rx-axis-matching-hash ?axis ; : ?ry-axis ( device -- ? ) ry-axis-matching-hash ?axis ; : ?rz-axis ( device -- ? ) rz-axis-matching-hash ?axis ; : ?slider ( device -- ? ) slider-matching-hash ?axis ; : ?hat-switch ( device -- ? ) hat-switch-matching-hash ?axis ; : device-property ( device key -- value ) IOHIDDeviceGetProperty [ plist> ] [ f ] if* ; : element-property ( element key -- value ) IOHIDElementGetProperty [ plist> ] [ f ] if* ; : set-element-property ( element key value -- ) [ ] [ >plist ] bi* IOHIDElementSetProperty drop ; : transfer-element-property ( element from-key to-key -- ) [ dupd element-property ] dip swap [ set-element-property ] [ 2drop ] if* ; : mouse-device? ( device -- ? ) 1 2 IOHIDDeviceConformsTo ; : controller-device? ( device -- ? ) { [ 1 4 IOHIDDeviceConformsTo ] [ 1 5 IOHIDDeviceConformsTo ] [ 1 8 IOHIDDeviceConformsTo ] } 1|| ; : element-usage ( element -- {usage-page,usage} ) [ IOHIDElementGetUsagePage ] [ IOHIDElementGetUsage ] bi 2array ; : button? ( element -- ? ) IOHIDElementGetUsagePage 9 = ; inline : keyboard-key? ( element -- ? ) IOHIDElementGetUsagePage 7 = ; inline : axis? ( element -- ? ) IOHIDElementGetUsagePage 1 = ; inline : x-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x30 = ; inline : y-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x31 = ; inline : z-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x32 = ; inline : rx-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x33 = ; inline : ry-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x34 = ; inline : rz-axis? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x35 = ; inline : slider? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x36 = ; inline : wheel? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x38 = ; inline : hat-switch? ( {usage-page,usage} -- ? ) IOHIDElementGetUsage 0x39 = ; inline CONSTANT: pov-values { pov-up pov-up-right pov-right pov-down-right pov-down pov-down-left pov-left pov-up-left pov-neutral } : button-value ( value -- f/(0,1] ) 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 ( state hid-value element -- ) [ buttons>> ] [ button-value ] [ IOHIDElementGetUsage 1 - ] tri* rot set-nth ; : record-controller ( controller-state value -- ) dup IOHIDValueGetElement { { [ dup button? ] [ record-button ] } { [ dup axis? ] [ { { [ dup x-axis? ] [ drop axis-value >>x drop ] } { [ dup y-axis? ] [ drop axis-value >>y drop ] } { [ dup z-axis? ] [ drop axis-value >>z drop ] } { [ dup rx-axis? ] [ drop axis-value >>rx drop ] } { [ dup ry-axis? ] [ drop axis-value >>ry drop ] } { [ dup rz-axis? ] [ drop axis-value >>rz drop ] } { [ dup slider? ] [ drop axis-value >>slider drop ] } { [ dup hat-switch? ] [ drop pov-value >>pov drop ] } [ 3drop ] } cond ] } [ 3drop ] } cond ; HINTS: record-controller { controller-state alien } ; : ?set-nth ( value nth seq -- ) 2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ; : record-keyboard ( keyboard-state value -- ) dup IOHIDValueGetElement dup keyboard-key? [ [ IOHIDValueGetIntegerValue c-bool> ] [ IOHIDElementGetUsage ] bi* rot ?set-nth ] [ 3drop ] if ; HINTS: record-keyboard { bit-array alien } ; : record-mouse ( mouse-state value -- ) dup IOHIDValueGetElement { { [ dup button? ] [ record-button ] } { [ dup axis? ] [ { { [ dup x-axis? ] [ drop mouse-axis-value [ + ] curry change-dx drop ] } { [ dup y-axis? ] [ drop mouse-axis-value [ + ] curry change-dy drop ] } { [ dup wheel? ] [ drop mouse-axis-value [ + ] curry change-scroll-dx drop ] } { [ dup z-axis? ] [ drop mouse-axis-value [ + ] curry change-scroll-dy drop ] } [ 3drop ] } cond ] } [ 3drop ] } cond ; HINTS: record-mouse { mouse-state alien } ; M: iokit-game-input-backend read-mouse +mouse-state+ get-global ; M: iokit-game-input-backend reset-mouse +mouse-state+ get-global 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 ] bi ; : default-calibrate-axis ( element -- ) [ kIOHIDElementCalibrationMinKey -1.0 set-element-property ] [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ] [ default-calibrate-saturation ] tri ; : default-calibrate-slider ( element -- ) [ kIOHIDElementCalibrationMinKey 0.0 set-element-property ] [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ] [ default-calibrate-saturation ] tri ; : (default) ( ? quot -- ) [ f ] if* ; inline : ( device -- controller-state ) { [ ?x-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?y-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?z-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?rx-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?ry-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?rz-axis [ default-calibrate-axis 0.0 ] (default) ] [ ?slider [ default-calibrate-slider 0.0 ] (default) ] [ ?hat-switch pov-neutral and ] [ button-count f ] } cleave controller-state boa ; : ?add-mouse-buttons ( device -- ) button-count +mouse-state+ get-global buttons>> 2dup length > [ set-length ] [ 2drop ] if ; :: (device-matched-callback) ( context result sender device -- ) { { [ device mouse-device? ] [ device ?add-mouse-buttons ] } { [ device controller-device? ] [ device device +controller-states+ get-global set-at ] } [ ] } cond ; : device-matched-callback ( -- alien ) [ (device-matched-callback) ] IOHIDDeviceCallback ; :: (device-removed-callback) ( context result sender device -- ) device +controller-states+ get-global delete-at ; : device-removed-callback ( -- alien ) [ (device-removed-callback) ] IOHIDDeviceCallback ; ! Lion sends the input callback an IOHIDQueue as the "sender". ! Leopard and Snow Leopard send an IOHIDDevice. ! This function gets the IOHIDDevice regardless of which is received : get-input-device ( sender -- device ) dup CFGetTypeID { { [ dup IOHIDDeviceGetTypeID = ] [ drop ] } { [ dup IOHIDQueueGetTypeID = ] [ drop IOHIDQueueGetDevice ] } [ drop "input callback doesn't know how to deal with " swap CF>description append throw ] } cond ; :: (device-input-callback) ( context result sender value -- ) sender get-input-device :> device { { [ device mouse-device? ] [ +mouse-state+ get-global value record-mouse ] } { [ device controller-device? ] [ device +controller-states+ get-global at value record-controller ] } [ +keyboard-state+ get-global value record-keyboard ] } cond ; : device-input-callback ( -- alien ) [ (device-input-callback) ] 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 +keyboard-state+ set-global ; M: iokit-game-input-backend (open-game-input) make-hid-manager { [ initialize-variables ] [ device-matched-callback f IOHIDManagerRegisterDeviceMatchingCallback ] [ device-removed-callback f IOHIDManagerRegisterDeviceRemovalCallback ] [ device-input-callback f IOHIDManagerRegisterInputValueCallback ] [ 0 IOHIDManagerOpen mach-error ] [ game-devices-matching-seq set-hid-manager-matching ] [ CFRunLoopGetMain CFRunLoopDefaultMode IOHIDManagerScheduleWithRunLoop ] } cleave ; M: iokit-game-input-backend (reset-game-input) { +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ } [ f swap set-global ] each ; M: iokit-game-input-backend (close-game-input) +hid-manager+ get-global [ +hid-manager+ [ [ CFRunLoopGetMain CFRunLoopDefaultMode IOHIDManagerUnscheduleFromRunLoop ] [ 0 IOHIDManagerClose drop ] [ CFRelease ] tri f ] change-global f +keyboard-state+ set-global f +mouse-state+ set-global f +controller-states+ set-global ] when ; M: iokit-game-input-backend get-controllers ( -- sequence ) +controller-states+ get-global keys [ controller boa ] map ; : ?join ( pre post sep -- string ) 2over start [ swap 2nip ] [ [ 2array ] dip join ] if ; M: iokit-game-input-backend product-string ( controller -- string ) handle>> [ kIOHIDManufacturerKey device-property ] [ kIOHIDProductKey device-property ] bi " " ?join ; M: iokit-game-input-backend product-id ( controller -- integer ) handle>> [ kIOHIDVendorIDKey device-property ] [ kIOHIDProductIDKey device-property ] bi 2array ; M: iokit-game-input-backend instance-id ( controller -- integer ) handle>> kIOHIDLocationIDKey device-property ; M: iokit-game-input-backend read-controller ( controller -- controller-state ) handle>> +controller-states+ get-global at clone ; M: iokit-game-input-backend read-keyboard ( -- keyboard-state ) +keyboard-state+ get-global clone keyboard-state boa ; M: iokit-game-input-backend calibrate-controller ( controller -- ) drop ;