1 ! Copyright (C) 2009 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators.smart game.input
4 game.input.scancodes game.loop game.worlds
5 gpu.render gpu.state kernel literals
6 locals math math.constants math.functions math.matrices
7 math.matrices.extras math.order math.vectors opengl.gl
8 sequences ui ui.gadgets.worlds specialized-arrays audio.engine ;
9 FROM: alien.c-types => float ;
10 SPECIALIZED-ARRAY: float
13 UNIFORM-TUPLE: mvp-uniforms
14 { "mv_matrix" mat4-uniform f }
15 { "p_matrix" mat4-uniform f } ;
17 CONSTANT: -pi/2 $[ pi -2.0 / ]
18 CONSTANT: pi/2 $[ pi 2.0 / ]
20 TUPLE: wasd-world < game-world location yaw pitch p-matrix ;
22 GENERIC: wasd-near-plane ( world -- near-plane )
23 M: wasd-world wasd-near-plane drop 0.25 ;
25 GENERIC: wasd-far-plane ( world -- far-plane )
26 M: wasd-world wasd-far-plane drop 1024.0 ;
28 GENERIC: wasd-movement-speed ( world -- speed )
29 M: wasd-world wasd-movement-speed drop 1/16. ;
31 GENERIC: wasd-mouse-scale ( world -- scale )
32 M: wasd-world wasd-mouse-scale drop 1/600. ;
34 GENERIC: wasd-pitch-range ( world -- min max )
35 M: wasd-world wasd-pitch-range drop -pi/2 pi/2 ;
37 GENERIC: wasd-fly-vertically? ( world -- ? )
38 M: wasd-world wasd-fly-vertically? drop t ;
40 : wasd-mv-matrix ( world -- matrix )
41 [ { 1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ]
42 [ { 0.0 1.0 0.0 } swap yaw>> <rotation-matrix4> ]
43 [ location>> vneg <translation-matrix4> ] tri mdot mdot ;
45 : wasd-mv-inv-matrix ( world -- matrix )
46 [ location>> <translation-matrix4> ]
47 [ { 0.0 -1.0 0.0 } swap yaw>> <rotation-matrix4> ]
48 [ { -1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ] tri
51 : wasd-p-matrix ( world -- matrix )
54 : <mvp-uniforms> ( world -- uniforms )
55 [ wasd-mv-matrix ] [ wasd-p-matrix ] bi mvp-uniforms boa ;
59 : wasd-fov-vector ( world -- fov )
60 dim>> dup first2 min >float v/n fov v*n ; inline
62 :: generate-p-matrix ( world -- matrix )
63 world wasd-near-plane :> near-plane
64 world wasd-far-plane :> far-plane
66 world wasd-fov-vector near-plane v*n
67 near-plane far-plane <frustum-matrix4> ;
69 :: wasd-pixel-ray ( world loc -- direction )
70 loc world dim>> [ /f 0.5 - 2.0 * ] 2map
71 world wasd-fov-vector v*
72 first2 neg -1.0 0.0 4array
73 world wasd-mv-inv-matrix swap mdotv ;
75 : set-wasd-view ( world location yaw pitch -- world )
76 [ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
78 :: eye-rotate ( yaw pitch v -- v' )
86 cosy 0.0 siny neg 3array
87 siny sinp * cosp cosy sinp * 3array
88 siny cosp * sinp neg cosy cosp * 3array 3array
91 : ?pitch ( world -- pitch )
92 dup wasd-fly-vertically? [ pitch>> ] [ drop 0.0 ] if ;
94 : forward-vector ( world -- v )
95 [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
96 { 0.0 0.0 -1.0 } n*v eye-rotate ;
97 : rightward-vector ( world -- v )
98 [ yaw>> ] [ ?pitch ] [ wasd-movement-speed ] tri
99 { 1.0 0.0 0.0 } n*v eye-rotate ;
101 M: wasd-world audio-position location>> ; inline
102 M: wasd-world audio-orientation
103 forward-vector { 0.0 1.0 0.0 } <audio-orientation-state> ; inline
105 : walk-forward ( world -- )
106 dup forward-vector [ v+ ] curry change-location drop ;
107 : walk-backward ( world -- )
108 dup forward-vector [ v- ] curry change-location drop ;
109 : walk-leftward ( world -- )
110 dup rightward-vector [ v- ] curry change-location drop ;
111 : walk-rightward ( world -- )
112 dup rightward-vector [ v+ ] curry change-location drop ;
113 : walk-upward ( world -- )
114 dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v+ ] curry change-location drop ;
115 : walk-downward ( world -- )
116 dup wasd-movement-speed { 0.0 1.0 0.0 } n*v [ v- ] curry change-location drop ;
118 : clamp-pitch ( world -- world )
119 dup [ wasd-pitch-range clamp ] curry change-pitch ;
121 : rotate-with-mouse ( world mouse -- )
122 [ [ dup wasd-mouse-scale ] [ dx>> ] bi* * [ + ] curry change-yaw ]
123 [ [ dup wasd-mouse-scale ] [ dy>> ] bi* * [ + ] curry change-pitch clamp-pitch ] bi
126 :: wasd-keyboard-input ( world -- )
127 read-keyboard keys>> :> keys
128 key-w keys nth [ world walk-forward ] when
129 key-s keys nth [ world walk-backward ] when
130 key-a keys nth [ world walk-leftward ] when
131 key-d keys nth [ world walk-rightward ] when
132 key-space keys nth [ world walk-upward ] when
133 key-c keys nth [ world walk-downward ] when
134 key-escape keys nth [ world close-window ] when ;
136 : wasd-mouse-input ( world -- )
137 read-mouse rotate-with-mouse ;
139 M: wasd-world tick-game-world
141 [ wasd-keyboard-input ] [ wasd-mouse-input ] bi
145 M: wasd-world resize-world
146 [ <viewport-state> set-gpu-state* ]
147 [ dup generate-p-matrix >>p-matrix drop ] bi ;