extra/game-input/game-input.factor

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