/extra/gpu/util/wasd/wasd.factor

http://github.com/abeaumont/factor · Factor · 145 lines · 112 code · 32 blank · 1 comment · 14 complexity · ea419b9a922343912fc23b4a754ac936 MD5 · raw file

  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 audio.engine ;
  8. FROM: alien.c-types => float ;
  9. SPECIALIZED-ARRAY: float
  10. IN: gpu.util.wasd
  11. UNIFORM-TUPLE: mvp-uniforms
  12. { "mv_matrix" mat4-uniform f }
  13. { "p_matrix" mat4-uniform f } ;
  14. CONSTANT: -pi/2 $[ pi -2.0 / ]
  15. CONSTANT: pi/2 $[ pi 2.0 / ]
  16. TUPLE: wasd-world < game-world location yaw pitch p-matrix ;
  17. GENERIC: wasd-near-plane ( world -- near-plane )
  18. M: wasd-world wasd-near-plane drop 0.25 ;
  19. GENERIC: wasd-far-plane ( world -- far-plane )
  20. M: wasd-world wasd-far-plane drop 1024.0 ;
  21. GENERIC: wasd-movement-speed ( world -- speed )
  22. M: wasd-world wasd-movement-speed drop 1/16. ;
  23. GENERIC: wasd-mouse-scale ( world -- scale )
  24. M: wasd-world wasd-mouse-scale drop 1/600. ;
  25. GENERIC: wasd-pitch-range ( world -- min max )
  26. M: wasd-world wasd-pitch-range drop -pi/2 pi/2 ;
  27. GENERIC: wasd-fly-vertically? ( world -- ? )
  28. M: wasd-world wasd-fly-vertically? drop t ;
  29. : wasd-mv-matrix ( world -- matrix )
  30. [ { 1.0 0.0 0.0 } swap pitch>> rotation-matrix4 ]
  31. [ { 0.0 1.0 0.0 } swap yaw>> rotation-matrix4 ]
  32. [ location>> vneg translation-matrix4 ] tri m. m. ;
  33. : wasd-mv-inv-matrix ( world -- matrix )
  34. [ location>> translation-matrix4 ]
  35. [ { 0.0 -1.0 0.0 } swap yaw>> rotation-matrix4 ]
  36. [ { -1.0 0.0 0.0 } swap pitch>> rotation-matrix4 ] tri m. m. ;
  37. : wasd-p-matrix ( world -- matrix )
  38. p-matrix>> ;
  39. : <mvp-uniforms> ( world -- uniforms )
  40. [ wasd-mv-matrix ] [ wasd-p-matrix ] bi mvp-uniforms boa ;
  41. CONSTANT: fov 0.7
  42. : wasd-fov-vector ( world -- fov )
  43. dim>> dup first2 min >float v/n fov v*n ; inline
  44. :: generate-p-matrix ( world -- matrix )
  45. world wasd-near-plane :> near-plane
  46. world wasd-far-plane :> far-plane
  47. world wasd-fov-vector near-plane v*n
  48. near-plane far-plane frustum-matrix4 ;
  49. :: wasd-pixel-ray ( world loc -- direction )
  50. loc world dim>> [ /f 0.5 - 2.0 * ] 2map
  51. world wasd-fov-vector v*
  52. first2 neg -1.0 0.0 4array
  53. world wasd-mv-inv-matrix swap m.v ;
  54. : set-wasd-view ( world location yaw pitch -- world )
  55. [ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
  56. :: eye-rotate ( yaw pitch v -- v' )
  57. yaw neg :> y
  58. pitch neg :> p
  59. y cos :> cosy
  60. y sin :> siny
  61. p cos :> cosp
  62. p sin :> sinp
  63. cosy 0.0 siny neg 3array
  64. siny sinp * cosp cosy sinp * 3array
  65. siny cosp * sinp neg cosy cosp * 3array 3array
  66. v swap v.m ;
  67. : ?pitch ( world -- pitch )
  68. dup wasd-fly-vertically? [ pitch>> ] [ drop 0.0 ] if ;
  69. : forward-vector ( world -- v )
  70. [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  71. { 0.0 0.0 -1.0 } n*v eye-rotate ;
  72. : rightward-vector ( world -- v )
  73. [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
  74. { 1.0 0.0 0.0 } n*v eye-rotate ;
  75. M: wasd-world audio-position location>> ; inline
  76. M: wasd-world audio-orientation forward-vector { 0.0 1.0 0.0 } <audio-orientation> ; inline
  77. : walk-forward ( world -- )
  78. dup forward-vector [ v+ ] curry change-location drop ;
  79. : walk-backward ( world -- )
  80. dup forward-vector [ v- ] curry change-location drop ;
  81. : walk-leftward ( world -- )
  82. dup rightward-vector [ v- ] curry change-location drop ;
  83. : walk-rightward ( world -- )
  84. dup rightward-vector [ v+ ] curry change-location drop ;
  85. : walk-upward ( world -- )
  86. dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v+ ] curry change-location drop ;
  87. : walk-downward ( world -- )
  88. dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v- ] curry change-location drop ;
  89. : clamp-pitch ( world -- world )
  90. dup [ wasd-pitch-range clamp ] curry change-pitch ;
  91. : rotate-with-mouse ( world mouse -- )
  92. [ [ dup wasd-mouse-scale ] [ dx>> ] bi* * [ + ] curry change-yaw ]
  93. [ [ dup wasd-mouse-scale ] [ dy>> ] bi* * [ + ] curry change-pitch clamp-pitch ] bi
  94. drop ;
  95. :: wasd-keyboard-input ( world -- )
  96. read-keyboard keys>> :> keys
  97. key-w keys nth [ world walk-forward ] when
  98. key-s keys nth [ world walk-backward ] when
  99. key-a keys nth [ world walk-leftward ] when
  100. key-d keys nth [ world walk-rightward ] when
  101. key-space keys nth [ world walk-upward ] when
  102. key-c keys nth [ world walk-downward ] when
  103. key-escape keys nth [ world close-window ] when ;
  104. : wasd-mouse-input ( world -- )
  105. read-mouse rotate-with-mouse ;
  106. M: wasd-world tick-game-world
  107. dup focused?>> [
  108. [ wasd-keyboard-input ] [ wasd-mouse-input ] bi
  109. reset-mouse
  110. ] [ drop ] if ;
  111. M: wasd-world resize-world
  112. [ <viewport-state> set-gpu-state* ]
  113. [ dup generate-p-matrix >>p-matrix drop ] bi ;