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