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 ;
|
||||
IN: game-loop
|
||||
|
||||
|
|
@ -50,7 +50,7 @@ CONSTANT: MAX-FRAMES-TO-SKIP 5
|
|||
|
||||
: (run-loop) ( loop -- )
|
||||
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 ;
|
||||
|
||||
: 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