extra/gpu/util/wasd/wasd.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: accessors arrays combinators.smart game-input
   3 game-input.scancodes game-loop game-worlds
   4 gpu.render gpu.state kernel literals
   5 locals math math.constants math.functions math.matrices
   6 math.order math.vectors opengl.gl sequences
   7 ui ui.gadgets.worlds specialized-arrays ;
   8 SPECIALIZED-ARRAY: float
   9 IN: gpu.util.wasd
  10
  11 UNIFORM-TUPLE: mvp-uniforms
  12     { "mv_matrix"  mat4-uniform f }
  13     { "p_matrix"   mat4-uniform f } ;
  14
  15 CONSTANT: -pi/2 $[ pi -2.0 / ]
  16 CONSTANT:  pi/2 $[ pi  2.0 / ]
  17
  18 TUPLE: wasd-world < game-world location yaw pitch p-matrix ;
  19
  20 GENERIC: wasd-near-plane ( world -- near-plane )
  21 M: wasd-world wasd-near-plane drop 0.25 ;
  22
  23 GENERIC: wasd-far-plane ( world -- far-plane )
  24 M: wasd-world wasd-far-plane drop 1024.0 ;
  25
  26 GENERIC: wasd-movement-speed ( world -- speed )
  27 M: wasd-world wasd-movement-speed drop 1/16. ;
  28
  29 GENERIC: wasd-mouse-scale ( world -- scale )
  30 M: wasd-world wasd-mouse-scale drop 1/600. ;
  31
  32 GENERIC: wasd-pitch-range ( world -- min max )
  33 M: wasd-world wasd-pitch-range drop -pi/2 pi/2 ;
  34
  35 GENERIC: wasd-fly-vertically? ( world -- ? )
  36 M: wasd-world wasd-fly-vertically? drop t ;
  37
  38 : wasd-mv-matrix ( world -- matrix )
  39     [ { 1.0 0.0 0.0 } swap pitch>> rotation-matrix4 ]
  40     [ { 0.0 1.0 0.0 } swap yaw>>   rotation-matrix4 ]
  41     [ location>> vneg translation-matrix4 ] tri m. m. ;
  42
  43 : wasd-mv-inv-matrix ( world -- matrix )
  44     [ location>> translation-matrix4 ]
  45     [ {  0.0 -1.0 0.0 } swap yaw>>   rotation-matrix4 ]
  46     [ { -1.0  0.0 0.0 } swap pitch>> rotation-matrix4 ] tri m. m. ;
  47
  48 : wasd-p-matrix ( world -- matrix )
  49     p-matrix>> ;
  50
  51 CONSTANT: fov 0.7
  52
  53 :: generate-p-matrix ( world -- matrix )
  54     world wasd-near-plane :> near-plane
  55     world wasd-far-plane :> far-plane
  56
  57     world dim>> dup first2 min >float v/n fov v*n near-plane v*n
  58     near-plane far-plane frustum-matrix4 ;
  59
  60 : set-wasd-view ( world location yaw pitch -- world )
  61     [ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
  62
  63 :: eye-rotate ( yaw pitch v -- v' )
  64     yaw neg :> y
  65     pitch neg :> p
  66     y cos :> cosy
  67     y sin :> siny
  68     p cos :> cosp
  69     p sin :> sinp
  70
  71     cosy         0.0       siny        neg  3array
  72     siny sinp *  cosp      cosy sinp *      3array
  73     siny cosp *  sinp neg  cosy cosp *      3array 3array
  74     v swap v.m ;
  75
  76 : ?pitch ( world -- pitch )
  77     dup wasd-fly-vertically? [ pitch>> ] [ drop 0.0 ] if ;
  78
  79 : forward-vector ( world -- v )
  80     [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  81     { 0.0 0.0 -1.0 } n*v eye-rotate ;
  82 : rightward-vector ( world -- v )
  83     [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  84     { 1.0 0.0 0.0 } n*v eye-rotate ;
  85
  86 : walk-forward ( world -- )
  87     dup forward-vector [ v+ ] curry change-location drop ;
  88 : walk-backward ( world -- )
  89     dup forward-vector [ v- ] curry change-location drop ;
  90 : walk-leftward ( world -- )
  91     dup rightward-vector [ v- ] curry change-location drop ;
  92 : walk-rightward ( world -- )
  93     dup rightward-vector [ v+ ] curry change-location drop ;
  94 : walk-upward ( world -- )
  95     dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v+ ] curry change-location drop ;
  96 : walk-downward ( world -- )
  97     dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v- ] curry change-location drop ;
  98
  99 : clamp-pitch ( world -- world )
 100     dup [ wasd-pitch-range clamp ] curry change-pitch ;
 101
 102 : rotate-with-mouse ( world mouse -- )
 103     [ [ dup wasd-mouse-scale ] [ dx>> ] bi* * [ + ] curry change-yaw ]
 104     [ [ dup wasd-mouse-scale ] [ dy>> ] bi* * [ + ] curry change-pitch clamp-pitch ] bi
 105     drop ;
 106
 107 :: wasd-keyboard-input ( world -- )
 108     read-keyboard keys>> :> keys
 109     key-w keys nth key-, keys nth or [ world walk-forward   ] when
 110     key-s keys nth key-o keys nth or [ world walk-backward  ] when
 111     key-a keys nth                   [ world walk-leftward  ] when
 112     key-d keys nth key-e keys nth or [ world walk-rightward ] when
 113     key-space keys nth [ world walk-upward ] when
 114     key-c keys nth key-j keys nth or [ world walk-downward ] when
 115     key-escape keys nth [ world close-window ] when ;
 116
 117 : wasd-mouse-input ( world -- )
 118     read-mouse rotate-with-mouse ;
 119
 120 M: wasd-world tick*
 121     dup focused?>> [
 122         [ wasd-keyboard-input ] [ wasd-mouse-input ] bi
 123         reset-mouse
 124     ] [ drop ] if ;
 125
 126 M: wasd-world resize-world
 127     [ <viewport-state> set-gpu-state* ]
 128     [ dup generate-p-matrix >>p-matrix drop ] bi ;
 129