slow, ugly, unoptimized terrain generation demo
Joe Groff
parent
cd7e2aecd2
commit
7fc5dfab3d
|
|
@ -1,4 +1,4 @@
|
||||||
USING: accessors destructors kernel math math.order namespaces
|
USING: accessors calendar destructors kernel math math.order namespaces
|
||||||
system threads ;
|
system threads ;
|
||||||
IN: game-loop
|
IN: game-loop
|
||||||
|
|
||||||
|
|
@ -50,7 +50,7 @@ CONSTANT: MAX-FRAMES-TO-SKIP 5
|
||||||
|
|
||||||
: (run-loop) ( loop -- )
|
: (run-loop) ( loop -- )
|
||||||
dup running?>>
|
dup running?>>
|
||||||
[ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ yield (run-loop) ] tri ]
|
[ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ 1 milliseconds sleep (run-loop) ] tri ]
|
||||||
[ drop ] if ;
|
[ drop ] if ;
|
||||||
|
|
||||||
: run-loop ( loop -- )
|
: run-loop ( loop -- )
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,60 @@
|
||||||
|
USING: accessors arrays byte-arrays combinators fry grouping
|
||||||
|
images kernel math math.affine-transforms math.order
|
||||||
|
math.vectors noise random sequences ;
|
||||||
|
IN: terrain.generation
|
||||||
|
|
||||||
|
CONSTANT: terrain-segment-size { 512 512 }
|
||||||
|
CONSTANT: terrain-big-noise-scale { 0.002 0.002 }
|
||||||
|
CONSTANT: terrain-small-noise-scale { 0.05 0.05 }
|
||||||
|
|
||||||
|
TUPLE: terrain big-noise-table small-noise-table tiny-noise-seed ;
|
||||||
|
|
||||||
|
: <terrain> ( -- terrain )
|
||||||
|
<perlin-noise-table> <perlin-noise-table>
|
||||||
|
32 random-bits terrain boa ;
|
||||||
|
|
||||||
|
: seed-at ( seed at -- seed' )
|
||||||
|
first2 [ + ] dip [ 32 random-bits + ] curry with-seed ;
|
||||||
|
|
||||||
|
: big-noise-segment ( terrain at -- map )
|
||||||
|
[ big-noise-table>> terrain-big-noise-scale first2 <scale> ] dip
|
||||||
|
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ;
|
||||||
|
: small-noise-segment ( terrain at -- map )
|
||||||
|
[ small-noise-table>> terrain-small-noise-scale first2 <scale> ] dip
|
||||||
|
terrain-segment-size [ v* <translation> a. ] keep perlin-noise-byte-map ;
|
||||||
|
: tiny-noise-segment ( terrain at -- map )
|
||||||
|
[ tiny-noise-seed>> ] dip seed-at 0.1
|
||||||
|
terrain-segment-size normal-noise-byte-map ;
|
||||||
|
|
||||||
|
: padding ( terrain at -- padding )
|
||||||
|
2drop terrain-segment-size product 255 <repetition> ;
|
||||||
|
|
||||||
|
TUPLE: segment image ;
|
||||||
|
|
||||||
|
: terrain-segment ( terrain at -- image )
|
||||||
|
{
|
||||||
|
[ big-noise-segment ]
|
||||||
|
[ small-noise-segment ]
|
||||||
|
[ tiny-noise-segment ]
|
||||||
|
[ padding ]
|
||||||
|
} 2cleave
|
||||||
|
4array flip concat >byte-array
|
||||||
|
[ terrain-segment-size RGBA f ] dip image boa ;
|
||||||
|
|
||||||
|
: 4max ( a b c d -- max )
|
||||||
|
max max max ; inline
|
||||||
|
|
||||||
|
: mipmap ( {{pixels}} quot: ( aa ab ba bb -- c ) -- pixels' )
|
||||||
|
[ [ 2 <groups> ] map 2 <groups> ] dip
|
||||||
|
'[ first2 [ [ first2 ] bi@ @ ] 2map ] map ; inline
|
||||||
|
|
||||||
|
: group-pixels ( bitmap dim -- scanlines )
|
||||||
|
[ 4 <groups> ] [ first <groups> ] bi* ;
|
||||||
|
|
||||||
|
: concat-pixels ( scanlines -- bitmap )
|
||||||
|
[ concat ] map concat ;
|
||||||
|
|
||||||
|
: segment-mipmap ( image -- image' )
|
||||||
|
[ clone ] [ bitmap>> ] [ dim>> ] tri
|
||||||
|
group-pixels [ 4max ] mipmap concat-pixels >>bitmap
|
||||||
|
[ 2 v/n ] change-dim ;
|
||||||
|
|
@ -0,0 +1,46 @@
|
||||||
|
USING: multiline ;
|
||||||
|
IN: terrain.shaders
|
||||||
|
|
||||||
|
STRING: terrain-vertex-shader
|
||||||
|
|
||||||
|
uniform sampler2D heightmap;
|
||||||
|
|
||||||
|
varying vec2 heightcoords;
|
||||||
|
|
||||||
|
const vec4 COMPONENT_SCALE = vec4(0.5, 0.01, 0.002, 0.0);
|
||||||
|
|
||||||
|
float height(sampler2D map, vec2 coords)
|
||||||
|
{
|
||||||
|
vec4 v = texture2D(map, coords);
|
||||||
|
return dot(v, COMPONENT_SCALE);
|
||||||
|
}
|
||||||
|
|
||||||
|
void main()
|
||||||
|
{
|
||||||
|
gl_Position = gl_ModelViewProjectionMatrix
|
||||||
|
* (gl_Vertex + vec4(0, height(heightmap, gl_Vertex.xz), 0, 0));
|
||||||
|
heightcoords = gl_Vertex.xz;
|
||||||
|
}
|
||||||
|
|
||||||
|
;
|
||||||
|
|
||||||
|
STRING: terrain-pixel-shader
|
||||||
|
|
||||||
|
uniform sampler2D heightmap;
|
||||||
|
|
||||||
|
varying vec2 heightcoords;
|
||||||
|
|
||||||
|
const vec4 COMPONENT_SCALE = vec4(0.5, 0.01, 0.002, 0.0);
|
||||||
|
|
||||||
|
float height(sampler2D map, vec2 coords)
|
||||||
|
{
|
||||||
|
vec4 v = texture2D(map, coords);
|
||||||
|
return dot(v, COMPONENT_SCALE);
|
||||||
|
}
|
||||||
|
|
||||||
|
void main()
|
||||||
|
{
|
||||||
|
gl_FragColor = texture2D(heightmap, heightcoords);
|
||||||
|
}
|
||||||
|
|
||||||
|
;
|
||||||
|
|
@ -0,0 +1,190 @@
|
||||||
|
USING: accessors arrays combinators game-input
|
||||||
|
game-input.scancodes game-loop kernel literals locals math
|
||||||
|
math.constants math.functions math.matrices math.order
|
||||||
|
math.vectors opengl opengl.capabilities opengl.gl
|
||||||
|
opengl.shaders opengl.textures opengl.textures.private
|
||||||
|
sequences sequences.product specialized-arrays.float
|
||||||
|
terrain.generation terrain.shaders ui ui.gadgets
|
||||||
|
ui.gadgets.worlds ui.pixel-formats ;
|
||||||
|
IN: terrain
|
||||||
|
|
||||||
|
CONSTANT: FOV $[ 2.0 sqrt 1+ ]
|
||||||
|
CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ]
|
||||||
|
CONSTANT: FAR-PLANE 1.0
|
||||||
|
CONSTANT: EYE-START { 0.5 0.5 1.2 }
|
||||||
|
CONSTANT: TICK-LENGTH $[ 1000 30 /i ]
|
||||||
|
CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ]
|
||||||
|
CONSTANT: MOVEMENT-SPEED $[ 1.0 512.0 / ]
|
||||||
|
|
||||||
|
CONSTANT: terrain-vertex-size { 512 512 }
|
||||||
|
CONSTANT: terrain-vertex-distance { $[ 1.0 512.0 / ] $[ 1.0 512.0 / ] }
|
||||||
|
CONSTANT: terrain-vertex-row-length $[ 512 1 + 2 * ]
|
||||||
|
|
||||||
|
TUPLE: terrain-world < world
|
||||||
|
eye yaw pitch
|
||||||
|
terrain terrain-segment terrain-texture terrain-program
|
||||||
|
terrain-vertex-buffer
|
||||||
|
game-loop ;
|
||||||
|
|
||||||
|
: frustum ( dim -- -x x -y y near far )
|
||||||
|
dup first2 min v/n
|
||||||
|
NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@
|
||||||
|
NEAR-PLANE FAR-PLANE ;
|
||||||
|
|
||||||
|
: set-modelview-matrix ( gadget -- )
|
||||||
|
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
|
||||||
|
GL_MODELVIEW glMatrixMode
|
||||||
|
glLoadIdentity
|
||||||
|
[ pitch>> 1.0 0.0 0.0 glRotatef ]
|
||||||
|
[ yaw>> 0.0 1.0 0.0 glRotatef ]
|
||||||
|
[ eye>> vneg first3 glTranslatef ] tri ;
|
||||||
|
|
||||||
|
: vertex-array-vertex ( x z -- vertex )
|
||||||
|
[ terrain-vertex-distance first * ]
|
||||||
|
[ terrain-vertex-distance second * ] bi*
|
||||||
|
[ 0 ] dip float-array{ } 3sequence ;
|
||||||
|
|
||||||
|
: vertex-array-row ( z -- vertices )
|
||||||
|
dup 1 + 2array
|
||||||
|
terrain-vertex-size first 1 + iota
|
||||||
|
2array [ first2 swap vertex-array-vertex ] product-map
|
||||||
|
concat ;
|
||||||
|
|
||||||
|
: vertex-array ( -- vertices )
|
||||||
|
terrain-vertex-size second iota
|
||||||
|
[ vertex-array-row ] map concat ;
|
||||||
|
|
||||||
|
: >vertex-buffer ( bytes -- buffer )
|
||||||
|
[ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW <gl-buffer> ;
|
||||||
|
|
||||||
|
: draw-vertex-buffer-row ( i -- )
|
||||||
|
[ GL_TRIANGLE_STRIP ] dip
|
||||||
|
terrain-vertex-row-length * terrain-vertex-row-length
|
||||||
|
glDrawArrays ;
|
||||||
|
|
||||||
|
: draw-vertex-buffer ( buffer -- )
|
||||||
|
[ GL_ARRAY_BUFFER ] dip [
|
||||||
|
3 GL_FLOAT 0 f glVertexPointer
|
||||||
|
terrain-vertex-size second iota [ draw-vertex-buffer-row ] each
|
||||||
|
] with-gl-buffer ;
|
||||||
|
|
||||||
|
: degrees ( deg -- rad )
|
||||||
|
pi 180.0 / * ;
|
||||||
|
|
||||||
|
:: eye-rotate ( yaw pitch v -- v' )
|
||||||
|
yaw degrees neg :> y
|
||||||
|
pitch degrees neg :> p
|
||||||
|
y cos :> cosy
|
||||||
|
y sin :> siny
|
||||||
|
p cos :> cosp
|
||||||
|
p sin :> sinp
|
||||||
|
|
||||||
|
cosy 0.0 siny neg 3array
|
||||||
|
siny sinp * cosp cosy sinp * 3array
|
||||||
|
siny cosp * sinp neg cosy cosp * 3array 3array
|
||||||
|
v swap v.m ;
|
||||||
|
|
||||||
|
: forward-vector ( world -- v )
|
||||||
|
[ yaw>> ] [ pitch>> ] bi
|
||||||
|
{ 0.0 0.0 $ MOVEMENT-SPEED } vneg eye-rotate ;
|
||||||
|
: rightward-vector ( world -- v )
|
||||||
|
[ yaw>> ] [ pitch>> ] bi
|
||||||
|
{ $ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
|
||||||
|
|
||||||
|
: move-forward ( world -- )
|
||||||
|
dup forward-vector [ v+ ] curry change-eye drop ;
|
||||||
|
: move-backward ( world -- )
|
||||||
|
dup forward-vector [ v- ] curry change-eye drop ;
|
||||||
|
: move-leftward ( world -- )
|
||||||
|
dup rightward-vector [ v- ] curry change-eye drop ;
|
||||||
|
: move-rightward ( world -- )
|
||||||
|
dup rightward-vector [ v+ ] curry change-eye drop ;
|
||||||
|
|
||||||
|
: rotate-with-mouse ( world mouse -- )
|
||||||
|
[ dx>> MOUSE-SCALE * [ + ] curry change-yaw ]
|
||||||
|
[ dy>> MOUSE-SCALE * [ + ] curry change-pitch ] bi
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
:: handle-input ( world -- )
|
||||||
|
read-keyboard keys>> :> keys
|
||||||
|
key-w keys nth [ world move-forward ] when
|
||||||
|
key-s keys nth [ world move-backward ] when
|
||||||
|
key-a keys nth [ world move-leftward ] when
|
||||||
|
key-d keys nth [ world move-rightward ] when
|
||||||
|
world read-mouse rotate-with-mouse
|
||||||
|
reset-mouse ;
|
||||||
|
|
||||||
|
M: terrain-world tick*
|
||||||
|
[ handle-input ] keep
|
||||||
|
! [ eye>> ] [ yaw>> ] [ pitch>> ] tri 3array P ! debug
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
M: terrain-world draw*
|
||||||
|
nip draw-world ;
|
||||||
|
|
||||||
|
: set-heightmap-texture-parameters ( texture -- )
|
||||||
|
GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit
|
||||||
|
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
|
||||||
|
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
|
||||||
|
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri
|
||||||
|
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri ;
|
||||||
|
|
||||||
|
M: terrain-world begin-world
|
||||||
|
"2.0" { "GL_ARB_vertex_buffer_object" "GL_ARB_shader_objects" }
|
||||||
|
require-gl-version-or-extensions
|
||||||
|
GL_DEPTH_TEST glEnable
|
||||||
|
GL_TEXTURE_2D glEnable
|
||||||
|
GL_VERTEX_ARRAY glEnableClientState
|
||||||
|
0.5 0.5 0.5 1.0 glClearColor
|
||||||
|
EYE-START >>eye
|
||||||
|
0.0 >>yaw
|
||||||
|
0.0 >>pitch
|
||||||
|
<terrain> [ >>terrain ] keep
|
||||||
|
{ 0 0 } terrain-segment [ >>terrain-segment ] keep
|
||||||
|
make-texture [ set-heightmap-texture-parameters ] keep >>terrain-texture
|
||||||
|
terrain-vertex-shader terrain-pixel-shader <simple-gl-program>
|
||||||
|
>>terrain-program
|
||||||
|
vertex-array >vertex-buffer >>terrain-vertex-buffer
|
||||||
|
TICK-LENGTH over <game-loop> [ >>game-loop ] keep start-loop
|
||||||
|
reset-mouse
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
M: terrain-world end-world
|
||||||
|
{
|
||||||
|
[ game-loop>> stop-loop ]
|
||||||
|
[ terrain-vertex-buffer>> delete-gl-buffer ]
|
||||||
|
[ terrain-program>> delete-gl-program ]
|
||||||
|
[ terrain-texture>> delete-texture ]
|
||||||
|
} cleave ;
|
||||||
|
|
||||||
|
M: terrain-world resize-world
|
||||||
|
GL_PROJECTION glMatrixMode
|
||||||
|
glLoadIdentity
|
||||||
|
dim>> [ [ 0 0 ] dip first2 glViewport ]
|
||||||
|
[ frustum glFrustum ] bi ;
|
||||||
|
|
||||||
|
M: terrain-world draw-world*
|
||||||
|
[ set-modelview-matrix ]
|
||||||
|
[ terrain-texture>> GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit ]
|
||||||
|
[ dup terrain-program>> [
|
||||||
|
"heightmap" glGetUniformLocation 0 glUniform1i
|
||||||
|
terrain-vertex-buffer>> draw-vertex-buffer
|
||||||
|
] with-gl-program ]
|
||||||
|
tri gl-error ;
|
||||||
|
|
||||||
|
M: terrain-world focusable-child* drop t ;
|
||||||
|
M: terrain-world pref-dim* drop { 640 480 } ;
|
||||||
|
|
||||||
|
: terrain-window ( -- )
|
||||||
|
[
|
||||||
|
open-game-input
|
||||||
|
f T{ world-attributes
|
||||||
|
{ world-class terrain-world }
|
||||||
|
{ title "Terrain" }
|
||||||
|
{ pixel-format-attributes {
|
||||||
|
windowed
|
||||||
|
double-buffered
|
||||||
|
T{ depth-bits { value 24 } }
|
||||||
|
} }
|
||||||
|
} open-window
|
||||||
|
] with-ui ;
|
||||||
Loading…
Reference in New Issue