extra/game-input/game-input.factor

   1 USING: arrays accessors continuations kernel symbols
   2 combinators.lib sequences namespaces init ;
   3 IN: game-input
   4
   5 SYMBOLS: game-input-backend game-input-opened ;
   6
   7 HOOK: (open-game-input)  game-input-backend ( -- )
   8 HOOK: (close-game-input) game-input-backend ( -- )
   9
  10 : game-input-opened? ( -- ? )
  11     game-input-opened get ;
  12
  13 <PRIVATE
  14
  15 : reset-game-input ( -- )
  16     game-input-opened off ;
  17
  18 [ reset-game-input ] "game-input" add-init-hook
  19
  20 PRIVATE>
  21
  22
  23 : open-game-input ( -- )
  24     game-input-opened? [
  25         (open-game-input)
  26         game-input-opened on
  27     ] unless ;
  28 : close-game-input ( -- )
  29     game-input-opened? [
  30         (close-game-input)
  31         reset-game-input
  32     ] when ;
  33
  34 : with-game-input ( quot -- )
  35     open-game-input [ close-game-input ] [ ] cleanup ;
  36
  37 TUPLE: controller handle ;
  38 TUPLE: controller-state x y z rx ry rz slider pov buttons ;
  39
  40 M: controller-state clone
  41     call-next-method dup buttons>> clone >>buttons ;
  42
  43 SYMBOLS:
  44     pov-neutral
  45     pov-up pov-up-right pov-right pov-down-right
  46     pov-down pov-down-left pov-left pov-up-left ;
  47
  48 HOOK: get-controllers game-input-backend ( -- sequence )
  49
  50 HOOK: product-string game-input-backend ( controller -- string )
  51 HOOK: product-id game-input-backend ( controller -- id )
  52 HOOK: instance-id game-input-backend ( controller -- id )
  53
  54 : find-controller-products ( product-id -- sequence )
  55     get-controllers [ product-id = ] with filter ;
  56 : find-controller-instance ( product-id instance-id -- controller/f )
  57     get-controllers [
  58         [ product-id  = ]
  59         [ instance-id = ] bi, bi* and
  60     ] 2with find nip ;
  61
  62 HOOK: read-controller game-input-backend ( controller -- controller-state )
  63 HOOK: calibrate-controller game-input-backend ( controller -- )
  64
  65 TUPLE: keyboard-state keys ;
  66
  67 M: keyboard-state clone
  68     call-next-method dup keys>> clone >>keys ;
  69
  70 HOOK: read-keyboard game-input-backend ( -- keyboard-state )