extra/game/input/demos/joysticks/joysticks.factor

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