1 USING: accessors arrays combinators game-input
2 game-input.scancodes game-loop kernel literals locals math
3 math.constants math.functions math.matrices math.order
4 math.vectors opengl opengl.capabilities opengl.gl
5 opengl.shaders opengl.textures opengl.textures.private
6 sequences sequences.product specialized-arrays.float
7 terrain.generation terrain.shaders ui ui.gadgets
8 ui.gadgets.worlds ui.pixel-formats ;
11 CONSTANT: FOV $[ 2.0 sqrt 1+ ]
12 CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ]
13 CONSTANT: FAR-PLANE 2.0
14 CONSTANT: EYE-START { 0.5 0.5 1.2 }
15 CONSTANT: TICK-LENGTH $[ 1000 30 /i ]
16 CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ]
17 CONSTANT: MOVEMENT-SPEED $[ 1.0 512.0 / ]
19 CONSTANT: terrain-vertex-size { 512 512 }
20 CONSTANT: terrain-vertex-distance { $[ 1.0 512.0 / ] $[ 1.0 512.0 / ] }
21 CONSTANT: terrain-vertex-row-length $[ 512 1 + 2 * ]
23 TUPLE: terrain-world < world
25 terrain terrain-segment terrain-texture terrain-program
29 : frustum ( dim -- -x x -y y near far )
31 NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@
32 NEAR-PLANE FAR-PLANE ;
34 : set-modelview-matrix ( gadget -- )
35 GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
36 GL_MODELVIEW glMatrixMode
38 [ pitch>> 1.0 0.0 0.0 glRotatef ]
39 [ yaw>> 0.0 1.0 0.0 glRotatef ]
40 [ eye>> vneg first3 glTranslatef ] tri ;
42 : vertex-array-vertex ( x z -- vertex )
43 [ terrain-vertex-distance first * ]
44 [ terrain-vertex-distance second * ] bi*
45 [ 0 ] dip float-array{ } 3sequence ;
47 : vertex-array-row ( z -- vertices )
49 terrain-vertex-size first 1 + iota
50 2array [ first2 swap vertex-array-vertex ] product-map
53 : vertex-array ( -- vertices )
54 terrain-vertex-size second iota
55 [ vertex-array-row ] map concat ;
57 : >vertex-buffer ( bytes -- buffer )
58 [ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW <gl-buffer> ;
60 : draw-vertex-buffer-row ( i -- )
61 [ GL_TRIANGLE_STRIP ] dip
62 terrain-vertex-row-length * terrain-vertex-row-length
65 : draw-vertex-buffer ( buffer -- )
66 [ GL_ARRAY_BUFFER ] dip [
67 3 GL_FLOAT 0 f glVertexPointer
68 terrain-vertex-size second iota [ draw-vertex-buffer-row ] each
71 : degrees ( deg -- rad )
74 :: eye-rotate ( yaw pitch v -- v' )
76 pitch degrees neg :> p
82 cosy 0.0 siny neg 3array
83 siny sinp * cosp cosy sinp * 3array
84 siny cosp * sinp neg cosy cosp * 3array 3array
87 : forward-vector ( world -- v )
88 [ yaw>> ] [ pitch>> ] bi
89 { 0.0 0.0 $ MOVEMENT-SPEED } vneg eye-rotate ;
90 : rightward-vector ( world -- v )
91 [ yaw>> ] [ pitch>> ] bi
92 { $ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
94 : move-forward ( world -- )
95 dup forward-vector [ v+ ] curry change-eye drop ;
96 : move-backward ( world -- )
97 dup forward-vector [ v- ] curry change-eye drop ;
98 : move-leftward ( world -- )
99 dup rightward-vector [ v- ] curry change-eye drop ;
100 : move-rightward ( world -- )
101 dup rightward-vector [ v+ ] curry change-eye drop ;
103 : rotate-with-mouse ( world mouse -- )
104 [ dx>> MOUSE-SCALE * [ + ] curry change-yaw ]
105 [ dy>> MOUSE-SCALE * [ + ] curry change-pitch ] bi
108 :: handle-input ( world -- )
109 read-keyboard keys>> :> keys
110 key-w keys nth [ world move-forward ] when
111 key-s keys nth [ world move-backward ] when
112 key-a keys nth [ world move-leftward ] when
113 key-d keys nth [ world move-rightward ] when
114 key-escape keys nth [ world close-window ] when
115 world read-mouse rotate-with-mouse
118 M: terrain-world tick*
119 [ handle-input ] keep
120 ! [ eye>> ] [ yaw>> ] [ pitch>> ] tri 3array P ! debug
123 M: terrain-world draw*
126 : set-heightmap-texture-parameters ( texture -- )
127 GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit
128 GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
129 GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
130 GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE glTexParameteri
131 GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE glTexParameteri ;
133 M: terrain-world begin-world
134 "2.0" { "GL_ARB_vertex_buffer_object" "GL_ARB_shader_objects" }
135 require-gl-version-or-extensions
136 GL_DEPTH_TEST glEnable
137 GL_TEXTURE_2D glEnable
138 GL_VERTEX_ARRAY glEnableClientState
139 0.5 0.5 0.5 1.0 glClearColor
143 <terrain> [ >>terrain ] keep
144 { 0 0 } terrain-segment [ >>terrain-segment ] keep
145 make-texture [ set-heightmap-texture-parameters ] keep >>terrain-texture
146 terrain-vertex-shader terrain-pixel-shader <simple-gl-program>
148 vertex-array >vertex-buffer >>terrain-vertex-buffer
149 TICK-LENGTH over <game-loop> [ >>game-loop ] keep start-loop
153 M: terrain-world end-world
156 [ game-loop>> stop-loop ]
157 [ terrain-vertex-buffer>> delete-gl-buffer ]
158 [ terrain-program>> delete-gl-program ]
159 [ terrain-texture>> delete-texture ]
162 M: terrain-world resize-world
163 GL_PROJECTION glMatrixMode
165 dim>> [ [ 0 0 ] dip first2 glViewport ]
166 [ frustum glFrustum ] bi ;
168 M: terrain-world draw-world*
169 [ set-modelview-matrix ]
170 [ terrain-texture>> GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit ]
171 [ dup terrain-program>> [
172 "heightmap" glGetUniformLocation 0 glUniform1i
173 terrain-vertex-buffer>> draw-vertex-buffer
177 M: terrain-world focusable-child* drop t ;
178 M: terrain-world pref-dim* drop { 640 480 } ;
180 : terrain-window ( -- )
182 f T{ world-attributes
183 { world-class terrain-world }
185 { pixel-format-attributes {
188 T{ depth-bits { value 24 } }