extra/joystick-demo/joystick-demo.factor

   1 USING: ui ui.gadgets sequences kernel arrays math colors
   2 ui.render math.vectors accessors fry ui.gadgets.packs game-input
   3 ui.gadgets.labels ui.gadgets.borders alarms
   4 calendar locals strings ui.gadgets.buttons
   5 combinators math.parser assocs threads ;
   6 IN: joystick-demo
   7
   8 CONSTANT: SIZE { 151 151 }
   9 CONSTANT: INDICATOR-SIZE { 4 4 }
  10 : FREQUENCY ( -- f ) 30 recip seconds ;
  11
  12 TUPLE: axis-gadget < gadget indicator z-indicator pov ;
  13
  14 M: axis-gadget pref-dim* drop SIZE ;
  15
  16 : (rect-polygon) ( lo hi -- polygon )
  17     2dup
  18     [ [ second ] [ first  ] bi* swap 2array ]
  19     [ [ first  ] [ second ] bi*      2array ] 2bi swapd 4array ;
  20
  21 : indicator-polygon ( -- polygon )
  22     { 0 0 } INDICATOR-SIZE (rect-polygon) ;
  23
  24 CONSTANT: pov-polygons
  25     V{
  26         { pov-neutral    { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } }
  27         { pov-up         { { 70 65 } { 75 60 } { 80 65 } } }
  28         { pov-up-right   { { 83 60 } { 90 60 } { 90 67 } } }
  29         { pov-right      { { 85 70 } { 90 75 } { 85 80 } } }
  30         { pov-down-right { { 90 83 } { 90 90 } { 83 90 } } }
  31         { pov-down       { { 70 85 } { 75 90 } { 80 85 } } }
  32         { pov-down-left  { { 67 90 } { 60 90 } { 60 83 } } }
  33         { pov-left       { { 65 70 } { 60 75 } { 65 80 } } }
  34         { pov-up-left    { { 67 60 } { 60 60 } { 60 67 } } }
  35     }
  36
  37 : <indicator-gadget> ( color -- indicator )
  38     indicator-polygon <polygon-gadget> ;
  39
  40 : (>loc) ( axisloc -- windowloc )
  41     0.5 v*n { 0.5 0.5 } v+ SIZE v* [ >integer ] map
  42     INDICATOR-SIZE 2 v/n v- ;
  43
  44 : (xy>loc) ( x y -- xyloc )
  45     2array (>loc) ;
  46 : (z>loc) ( z -- zloc )
  47     0.0 swap 2array (>loc) ;
  48
  49 : (xyz>loc) ( x y z -- xyloc zloc )
  50     [ [ 0.0 ] unless* ] tri@
  51     [ (xy>loc) ] dip (z>loc) ;
  52
  53 : move-axis ( gadget x y z -- )
  54     (xyz>loc) rot tuck
  55     [ indicator>>   (>>loc) ]
  56     [ z-indicator>> (>>loc) ] 2bi* ;
  57
  58 : move-pov ( gadget pov -- )
  59     swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ]
  60     with assoc-each ;
  61
  62 :: add-pov-gadget ( gadget direction polygon -- gadget direction gadget )
  63     gadget white polygon <polygon-gadget> [ add-gadget ] keep
  64     direction swap ;
  65
  66 : add-pov-gadgets ( gadget -- gadget )
  67     pov-polygons [ add-pov-gadget ] assoc-map >>pov ;
  68
  69 : <axis-gadget> ( -- gadget )
  70     axis-gadget new
  71     add-pov-gadgets
  72     black <indicator-gadget> [ >>z-indicator ] [ add-gadget ] bi
  73     red   <indicator-gadget> [ >>indicator   ] [ add-gadget ] bi
  74     dup [ 0.0 0.0 0.0 move-axis ] [ f move-pov ] bi ;
  75
  76 TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
  77
  78 : add-gadget-with-border ( parent child -- parent )
  79     { 2 2 } <border> gray <solid> >>boundary add-gadget ;
  80
  81 : add-controller-label ( gadget controller -- gadget )
  82     [ >>controller ] [ product-string <label> add-gadget ] bi ;
  83
  84 : add-axis-gadget ( gadget shelf -- gadget shelf )
  85     <axis-gadget> tuck [ >>axis ] [ add-gadget-with-border ] 2bi* ;
  86
  87 : add-raxis-gadget ( gadget shelf -- gadget shelf )
  88     <axis-gadget> tuck [ >>raxis ] [ add-gadget-with-border ] 2bi* ;
  89
  90 :: (add-button-gadgets) ( gadget shelf -- )
  91     gadget controller>> read-controller buttons>> length [
  92         number>string [ ] <bevel-button>
  93         shelf over add-gadget drop
  94     ] map gadget (>>buttons) ;
  95
  96 : add-button-gadgets ( gadget shelf -- gadget shelf )
  97     [ (add-button-gadgets) ] 2keep ;
  98
  99 : <joystick-demo-gadget> ( controller -- gadget )
 100     joystick-demo-gadget new
 101     { 0 1 } >>orientation
 102     swap add-controller-label
 103     <shelf> add-axis-gadget add-raxis-gadget add-gadget
 104     <shelf> add-button-gadgets add-gadget ;
 105
 106 : update-buttons ( buttons button-states -- )
 107     [ >>selected? drop ] 2each ;
 108
 109 : kill-update-axes ( gadget -- )
 110     gray <solid> >>interior
 111     [ [ cancel-alarm ] when* f ] change-alarm
 112     relayout-1 ;
 113
 114 : (update-axes) ( gadget controller-state -- )
 115     {
 116         [ [ axis>>  ] [ [ x>>  ] [ y>>  ] [ z>>  ] tri ] bi* move-axis ]
 117         [ [ raxis>> ] [ [ rx>> ] [ ry>> ] [ rz>> ] tri ] bi* move-axis ]
 118         [ [ axis>>  ] [ pov>> ] bi* move-pov ]
 119         [ [ buttons>> ] [ buttons>> ] bi* update-buttons ]
 120         [ drop relayout-1 ]
 121     } 2cleave ;
 122
 123 : update-axes ( gadget -- )
 124     dup controller>> read-controller
 125     [ (update-axes) ] [ kill-update-axes ] if* ;
 126
 127 M: joystick-demo-gadget graft*
 128     dup '[ _ update-axes ] FREQUENCY every >>alarm
 129     drop ;
 130
 131 M: joystick-demo-gadget ungraft*
 132     alarm>> [ cancel-alarm ] when* ;
 133
 134 : joystick-window ( controller -- )
 135     [ <joystick-demo-gadget> ] [ product-string ] bi
 136     open-window ;
 137
 138 : joystick-demo ( -- )
 139     [
 140         open-game-input
 141         0.1 seconds sleep ! It might take a moment to find devices...
 142         get-controllers [ joystick-window ] each
 143     ] with-ui ;
 144
 145 MAIN: joystick-demo