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