basis/game-input/game-input.factor

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