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