basis/game/input/iokit/iokit.factor

   1 USING: cocoa cocoa.plists core-foundation iokit iokit.hid
   2 kernel cocoa.enumeration destructors math.parser cocoa.application
   3 core-foundation.data core-foundation.strings
   4 sequences locals combinators.short-circuit threads
   5 namespaces assocs arrays combinators hints alien
   6 core-foundation.run-loop accessors sequences.private
   7 alien.c-types alien.data math parser game.input vectors
   8 bit-arrays unix.types ;
   9 IN: game.input.iokit
  10
  11 SINGLETON: iokit-game-input-backend
  12
  13 SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ;
  14
  15 iokit-game-input-backend game-input-backend set-global
  16
  17 : make-hid-manager ( -- alien )
  18     f 0 IOHIDManagerCreate ;
  19
  20 : set-hid-manager-matching ( alien matching-seq -- )
  21     >plist IOHIDManagerSetDeviceMatchingMultiple ;
  22
  23 : devices-from-hid-manager ( manager -- vector )
  24     [
  25         IOHIDManagerCopyDevices
  26         [ &CFRelease NSFastEnumeration>vector ] [ f ] if*
  27     ] with-destructors ;
  28
  29 CONSTANT: game-devices-matching-seq
  30     {
  31         H{ { "DeviceUsage" 2 } { "DeviceUsagePage" 1 } } ! mouses
  32         H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks
  33         H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads
  34         H{ { "DeviceUsage" 6 } { "DeviceUsagePage" 1 } } ! keyboards
  35         H{ { "DeviceUsage" 7 } { "DeviceUsagePage" 1 } } ! keypads
  36         H{ { "DeviceUsage" 8 } { "DeviceUsagePage" 1 } } ! multiaxis controllers
  37     }
  38
  39 CONSTANT: buttons-matching-hash
  40     H{ { "UsagePage" 9 } { "Type" 2 } }
  41 CONSTANT: keys-matching-hash
  42     H{ { "UsagePage" 7 } { "Type" 2 } }
  43 CONSTANT: x-axis-matching-hash
  44     H{ { "UsagePage" 1 } { "Usage" HEX: 30 } { "Type" 1 } }
  45 CONSTANT: y-axis-matching-hash
  46     H{ { "UsagePage" 1 } { "Usage" HEX: 31 } { "Type" 1 } }
  47 CONSTANT: z-axis-matching-hash
  48     H{ { "UsagePage" 1 } { "Usage" HEX: 32 } { "Type" 1 } }
  49 CONSTANT: rx-axis-matching-hash
  50     H{ { "UsagePage" 1 } { "Usage" HEX: 33 } { "Type" 1 } }
  51 CONSTANT: ry-axis-matching-hash
  52     H{ { "UsagePage" 1 } { "Usage" HEX: 34 } { "Type" 1 } }
  53 CONSTANT: rz-axis-matching-hash
  54     H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } }
  55 CONSTANT: slider-matching-hash
  56     H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } }
  57 CONSTANT: wheel-matching-hash
  58     H{ { "UsagePage" 1 } { "Usage" HEX: 38 } { "Type" 1 } }
  59 CONSTANT: hat-switch-matching-hash
  60     H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } }
  61
  62 : device-elements-matching ( device matching-hash -- vector )
  63     [
  64         >plist 0 IOHIDDeviceCopyMatchingElements
  65         [ &CFRelease NSFastEnumeration>vector ] [ f ] if*
  66     ] with-destructors ;
  67
  68 : button-count ( device -- button-count )
  69     buttons-matching-hash device-elements-matching length ;
  70
  71 : ?axis ( device hash -- axis/f )
  72     device-elements-matching [ f ] [ first ] if-empty ;
  73
  74 : ?x-axis ( device -- ? )
  75     x-axis-matching-hash ?axis ;
  76 : ?y-axis ( device -- ? )
  77     y-axis-matching-hash ?axis ;
  78 : ?z-axis ( device -- ? )
  79     z-axis-matching-hash ?axis ;
  80 : ?rx-axis ( device -- ? )
  81     rx-axis-matching-hash ?axis ;
  82 : ?ry-axis ( device -- ? )
  83     ry-axis-matching-hash ?axis ;
  84 : ?rz-axis ( device -- ? )
  85     rz-axis-matching-hash ?axis ;
  86 : ?slider ( device -- ? )
  87     slider-matching-hash ?axis ;
  88 : ?hat-switch ( device -- ? )
  89     hat-switch-matching-hash ?axis ;
  90
  91 : device-property ( device key -- value )
  92     <NSString> IOHIDDeviceGetProperty [ plist> ] [ f ] if* ;
  93 : element-property ( element key -- value )
  94     <NSString> IOHIDElementGetProperty [ plist> ] [ f ] if* ;
  95 : set-element-property ( element key value -- )
  96     [ <NSString> ] [ >plist ] bi* IOHIDElementSetProperty drop ;
  97 : transfer-element-property ( element from-key to-key -- )
  98     [ dupd element-property ] dip swap
  99     [ set-element-property ] [ 2drop ] if* ;
 100
 101 : mouse-device? ( device -- ? )
 102     1 2 IOHIDDeviceConformsTo ;
 103
 104 : controller-device? ( device -- ? )
 105     {
 106         [ 1 4 IOHIDDeviceConformsTo ]
 107         [ 1 5 IOHIDDeviceConformsTo ]
 108         [ 1 8 IOHIDDeviceConformsTo ]
 109     } 1|| ;
 110
 111 : element-usage ( element -- {usage-page,usage} )
 112     [ IOHIDElementGetUsagePage ] [ IOHIDElementGetUsage ] bi
 113     2array ;
 114
 115 : button? ( element -- ? )
 116     IOHIDElementGetUsagePage 9 = ; inline
 117 : keyboard-key? ( element -- ? )
 118     IOHIDElementGetUsagePage 7 = ; inline
 119 : axis? ( element -- ? )
 120     IOHIDElementGetUsagePage 1 = ; inline
 121
 122 : x-axis? ( {usage-page,usage} -- ? )
 123     IOHIDElementGetUsage HEX: 30 = ; inline
 124 : y-axis? ( {usage-page,usage} -- ? )
 125     IOHIDElementGetUsage HEX: 31 = ; inline
 126 : z-axis? ( {usage-page,usage} -- ? )
 127     IOHIDElementGetUsage HEX: 32 = ; inline
 128 : rx-axis? ( {usage-page,usage} -- ? )
 129     IOHIDElementGetUsage HEX: 33 = ; inline
 130 : ry-axis? ( {usage-page,usage} -- ? )
 131     IOHIDElementGetUsage HEX: 34 = ; inline
 132 : rz-axis? ( {usage-page,usage} -- ? )
 133     IOHIDElementGetUsage HEX: 35 = ; inline
 134 : slider? ( {usage-page,usage} -- ? )
 135     IOHIDElementGetUsage HEX: 36 = ; inline
 136 : wheel? ( {usage-page,usage} -- ? )
 137     IOHIDElementGetUsage HEX: 38 = ; inline
 138 : hat-switch? ( {usage-page,usage} -- ? )
 139     IOHIDElementGetUsage HEX: 39 = ; inline
 140
 141 CONSTANT: pov-values
 142     {
 143         pov-up pov-up-right pov-right pov-down-right
 144         pov-down pov-down-left pov-left pov-up-left
 145         pov-neutral
 146     }
 147
 148 : button-value ( value -- f/(0,1] )
 149     IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
 150 : axis-value ( value -- [-1,1] )
 151     kIOHIDValueScaleTypeCalibrated IOHIDValueGetScaledValue ;
 152 : mouse-axis-value ( value -- n )
 153     IOHIDValueGetIntegerValue ;
 154 : pov-value ( value -- pov-direction )
 155     IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ;
 156
 157 : record-button ( state hid-value element -- )
 158     [ buttons>> ] [ button-value ] [ IOHIDElementGetUsage 1 - ] tri* rot set-nth ;
 159
 160 : record-controller ( controller-state value -- )
 161     dup IOHIDValueGetElement {
 162         { [ dup button? ] [ record-button ] }
 163         { [ dup axis? ] [ {
 164             { [ dup x-axis? ] [ drop axis-value >>x drop ] }
 165             { [ dup y-axis? ] [ drop axis-value >>y drop ] }
 166             { [ dup z-axis? ] [ drop axis-value >>z drop ] }
 167             { [ dup rx-axis? ] [ drop axis-value >>rx drop ] }
 168             { [ dup ry-axis? ] [ drop axis-value >>ry drop ] }
 169             { [ dup rz-axis? ] [ drop axis-value >>rz drop ] }
 170             { [ dup slider? ] [ drop axis-value >>slider drop ] }
 171             { [ dup hat-switch? ] [ drop pov-value >>pov drop ] }
 172             [ 3drop ]
 173         } cond ] }
 174         [ 3drop ]
 175     } cond ;
 176
 177 HINTS: record-controller { controller-state alien } ;
 178
 179 : ?set-nth ( value nth seq -- )
 180     2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ;
 181
 182 : record-keyboard ( keyboard-state value -- )
 183     dup IOHIDValueGetElement dup keyboard-key? [
 184         [ IOHIDValueGetIntegerValue c-bool> ]
 185         [ IOHIDElementGetUsage ] bi*
 186         rot ?set-nth
 187     ] [ 3drop ] if ;
 188
 189 HINTS: record-keyboard { bit-array alien } ;
 190
 191 : record-mouse ( mouse-state value -- )
 192     dup IOHIDValueGetElement {
 193         { [ dup button? ] [ record-button ] }
 194         { [ dup axis? ] [ {
 195             { [ dup x-axis? ] [ drop mouse-axis-value [ + ] curry change-dx drop ] }
 196             { [ dup y-axis? ] [ drop mouse-axis-value [ + ] curry change-dy drop ] }
 197             { [ dup wheel?  ] [ drop mouse-axis-value [ + ] curry change-scroll-dx drop ] }
 198             { [ dup z-axis? ] [ drop mouse-axis-value [ + ] curry change-scroll-dy drop ] }
 199             [ 3drop ]
 200         } cond ] }
 201         [ 3drop ]
 202     } cond ;
 203
 204 HINTS: record-mouse { mouse-state alien } ;
 205
 206 M: iokit-game-input-backend read-mouse
 207     +mouse-state+ get-global ;
 208
 209 M: iokit-game-input-backend reset-mouse
 210     +mouse-state+ get-global
 211         0 >>dx
 212         0 >>dy
 213         0 >>scroll-dx
 214         0 >>scroll-dy
 215         drop ;
 216
 217 : default-calibrate-saturation ( element -- )
 218     [ kIOHIDElementMinKey kIOHIDElementCalibrationSaturationMinKey transfer-element-property ]
 219     [ kIOHIDElementMaxKey kIOHIDElementCalibrationSaturationMaxKey transfer-element-property ]
 220     bi ;
 221
 222 : default-calibrate-axis ( element -- )
 223     [ kIOHIDElementCalibrationMinKey -1.0 set-element-property ]
 224     [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ]
 225     [ default-calibrate-saturation ]
 226     tri ;
 227
 228 : default-calibrate-slider ( element -- )
 229     [ kIOHIDElementCalibrationMinKey 0.0 set-element-property ]
 230     [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ]
 231     [ default-calibrate-saturation ]
 232     tri ;
 233
 234 : (default) ( ? quot -- )
 235     [ f ] if* ; inline
 236
 237 : <device-controller-state> ( device -- controller-state )
 238     {
 239         [ ?x-axis [ default-calibrate-axis 0.0 ] (default) ]
 240         [ ?y-axis [ default-calibrate-axis 0.0 ] (default) ]
 241         [ ?z-axis [ default-calibrate-axis 0.0 ] (default) ]
 242         [ ?rx-axis [ default-calibrate-axis 0.0 ] (default) ]
 243         [ ?ry-axis [ default-calibrate-axis 0.0 ] (default) ]
 244         [ ?rz-axis [ default-calibrate-axis 0.0 ] (default) ]
 245         [ ?slider [ default-calibrate-slider 0.0 ] (default) ]
 246         [ ?hat-switch pov-neutral and ]
 247         [ button-count f <array> ]
 248     } cleave controller-state boa ;
 249
 250 : ?add-mouse-buttons ( device -- )
 251     button-count +mouse-state+ get-global buttons>>
 252     2dup length >
 253     [ set-length ] [ 2drop ] if ;
 254
 255 :: (device-matched-callback) ( context result sender device -- )
 256     {
 257         { [ device mouse-device? ] [ device ?add-mouse-buttons ] }
 258         { [ device controller-device? ] [
 259             device <device-controller-state>
 260             device +controller-states+ get-global set-at
 261         ] }
 262         [ ]
 263     } cond ;
 264
 265 : device-matched-callback ( -- alien )
 266     [ (device-matched-callback) ] IOHIDDeviceCallback ;
 267
 268 :: (device-removed-callback) ( context result sender device -- )
 269     device +controller-states+ get-global delete-at ;
 270
 271 : device-removed-callback ( -- alien )
 272     [ (device-removed-callback) ] IOHIDDeviceCallback ;
 273
 274 ! Lion sends the input callback an IOHIDQueue as the "sender".
 275 ! Leopard and Snow Leopard send an IOHIDDevice.
 276 ! This function gets the IOHIDDevice regardless of which is received
 277 : get-input-device ( sender -- device )
 278     dup CFGetTypeID {
 279         { [ dup IOHIDDeviceGetTypeID = ] [ drop ] }
 280         { [ dup IOHIDQueueGetTypeID = ] [ drop IOHIDQueueGetDevice ] }
 281         [
 282             drop
 283             "input callback doesn't know how to deal with "
 284             swap CF>description append throw
 285         ]
 286     } cond ;
 287
 288 :: (device-input-callback) ( context result sender value -- )
 289     sender get-input-device :> device
 290     {
 291         { [ device mouse-device? ] [ +mouse-state+ get-global value record-mouse ] }
 292         { [ device controller-device? ] [
 293             device +controller-states+ get-global at value record-controller
 294         ] }
 295         [ +keyboard-state+ get-global value record-keyboard ]
 296     } cond ;
 297
 298 : device-input-callback ( -- alien )
 299     [ (device-input-callback) ] IOHIDValueCallback ;
 300
 301 : initialize-variables ( manager -- )
 302     +hid-manager+ set-global
 303     4 <vector> +controller-states+ set-global
 304     0 0 0 0 2 <vector> mouse-state boa
 305         +mouse-state+ set-global
 306     256 <bit-array> +keyboard-state+ set-global ;
 307
 308 M: iokit-game-input-backend (open-game-input)
 309     make-hid-manager {
 310         [ initialize-variables ]
 311         [ device-matched-callback f IOHIDManagerRegisterDeviceMatchingCallback ]
 312         [ device-removed-callback f IOHIDManagerRegisterDeviceRemovalCallback ]
 313         [ device-input-callback f IOHIDManagerRegisterInputValueCallback ]
 314         [ 0 IOHIDManagerOpen mach-error ]
 315         [ game-devices-matching-seq set-hid-manager-matching ]
 316         [
 317             CFRunLoopGetMain CFRunLoopDefaultMode
 318             IOHIDManagerScheduleWithRunLoop
 319         ]
 320     } cleave ;
 321
 322 M: iokit-game-input-backend (reset-game-input)
 323     { +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ }
 324     [ f swap set-global ] each ;
 325
 326 M: iokit-game-input-backend (close-game-input)
 327     +hid-manager+ get-global [
 328         +hid-manager+ [
 329             [
 330                 CFRunLoopGetMain CFRunLoopDefaultMode
 331                 IOHIDManagerUnscheduleFromRunLoop
 332             ]
 333             [ 0 IOHIDManagerClose drop ]
 334             [ CFRelease ] tri
 335             f
 336         ] change-global
 337         f +keyboard-state+ set-global
 338         f +mouse-state+ set-global
 339         f +controller-states+ set-global
 340     ] when ;
 341
 342 M: iokit-game-input-backend get-controllers ( -- sequence )
 343     +controller-states+ get-global keys [ controller boa ] map ;
 344
 345 : ?join ( pre post sep -- string )
 346     2over start [ swap 2nip ] [ [ 2array ] dip join ] if ;
 347
 348 M: iokit-game-input-backend product-string ( controller -- string )
 349     handle>>
 350     [ kIOHIDManufacturerKey device-property ]
 351     [ kIOHIDProductKey      device-property ] bi " " ?join ;
 352 M: iokit-game-input-backend product-id ( controller -- integer )
 353     handle>>
 354     [ kIOHIDVendorIDKey  device-property ]
 355     [ kIOHIDProductIDKey device-property ] bi 2array ;
 356 M: iokit-game-input-backend instance-id ( controller -- integer )
 357     handle>> kIOHIDLocationIDKey device-property ;
 358
 359 M: iokit-game-input-backend read-controller ( controller -- controller-state )
 360     handle>> +controller-states+ get-global at clone ;
 361
 362 M: iokit-game-input-backend read-keyboard ( -- keyboard-state )
 363     +keyboard-state+ get-global clone keyboard-state boa ;
 364
 365 M: iokit-game-input-backend calibrate-controller ( controller -- )
 366     drop ;