basis/game/input/input.factor

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