gravity, jetpack, collision detection for terrain demo

extra/terrain/shaders/shaders.factor

@@ -4,15 +4,14 @@ IN: terrain.shaders
 STRING: terrain-vertex-shader
 
 uniform sampler2D heightmap;
+uniform vec4 component_scale;
 
 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);
+    return dot(v, component_scale);
 }
 
 void main()
@@ -27,15 +26,14 @@ void main()
 STRING: terrain-pixel-shader
 
 uniform sampler2D heightmap;
+uniform vec4 component_scale;
 
 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);
+    return dot(v, component_scale);
 }
 
 void main()

extra/terrain/terrain.factor

@@ -1,6 +1,6 @@
 USING: accessors arrays combinators game-input
-game-input.scancodes game-loop kernel literals locals math
+game-input.scancodes game-loop grouping kernel literals locals
-math.constants math.functions math.matrices math.order
+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
@@ -9,19 +9,27 @@ ui.gadgets.worlds ui.pixel-formats ;
 IN: terrain
 
 CONSTANT: FOV $[ 2.0 sqrt 1+ ]
-CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ]
+CONSTANT: NEAR-PLANE $[ 1.0 2048.0 / ]
-CONSTANT: FAR-PLANE 2.0
+CONSTANT: FAR-PLANE 1.0
-CONSTANT: EYE-START { 0.5 0.5 1.2 }
+CONSTANT: PLAYER-START-LOCATION { 0.5 0.51 0.5 }
+CONSTANT: PLAYER-HEIGHT $[ 3.0 1024.0 / ]
+CONSTANT: GRAVITY $[ 1.0 4096.0 / ]
+CONSTANT: JUMP $[ 1.0 1024.0 / ]
 CONSTANT: TICK-LENGTH $[ 1000 30 /i ]
 CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ]
-CONSTANT: MOVEMENT-SPEED $[ 1.0 512.0 / ]
+CONSTANT: MOVEMENT-SPEED $[ 1.0 16384.0 / ]
+CONSTANT: FRICTION 0.95
+CONSTANT: COMPONENT-SCALE { 0.5 0.01 0.002 0.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: player
+    location yaw pitch velocity ;
+
 TUPLE: terrain-world < world
-    eye yaw pitch
+    player
     terrain terrain-segment terrain-texture terrain-program
     terrain-vertex-buffer
     game-loop ;
@@ -35,9 +43,10 @@ TUPLE: terrain-world < world
     GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
     GL_MODELVIEW glMatrixMode
     glLoadIdentity
+    player>>
     [ pitch>> 1.0 0.0 0.0 glRotatef ]
     [ yaw>> 0.0 1.0 0.0 glRotatef ]
-    [ eye>> vneg first3 glTranslatef ] tri ;
+    [ location>> vneg first3 glTranslatef ] tri ;
 
 : vertex-array-vertex ( x z -- vertex )
     [ terrain-vertex-distance first * ]
@@ -79,47 +88,77 @@ TUPLE: terrain-world < world
     p cos :> cosp
     p sin :> sinp
 
-    cosy         0.0       siny        neg 3array
+    cosy         0.0       siny        neg  3array
-    siny sinp *  cosp      cosy sinp *     3array
+    siny sinp *  cosp      cosy sinp *      3array
-    siny cosp *  sinp neg  cosy cosp *     3array 3array
+    siny cosp *  sinp neg  cosy cosp *      3array 3array
     v swap v.m ;
 
-: forward-vector ( world -- v )
+: forward-vector ( player -- v )
-    [ yaw>> ] [ pitch>> ] bi
+    yaw>> 0.0
     { 0.0 0.0 $ MOVEMENT-SPEED } vneg eye-rotate ;
-: rightward-vector ( world -- v )
+: rightward-vector ( player -- v )
-    [ yaw>> ] [ pitch>> ] bi
+    yaw>> 0.0
     { $ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
 
-: move-forward ( world -- )
+: walk-forward ( player -- )
-    dup forward-vector [ v+ ] curry change-eye drop ;
+    dup forward-vector [ v+ ] curry change-velocity drop ;
-: move-backward ( world -- )
+: walk-backward ( player -- )
-    dup forward-vector [ v- ] curry change-eye drop ;
+    dup forward-vector [ v- ] curry change-velocity drop ;
-: move-leftward ( world -- )
+: walk-leftward ( player -- )
-    dup rightward-vector [ v- ] curry change-eye drop ;
+    dup rightward-vector [ v- ] curry change-velocity drop ;
-: move-rightward ( world -- )
+: walk-rightward ( player -- )
-    dup rightward-vector [ v+ ] curry change-eye drop ;
+    dup rightward-vector [ v+ ] curry change-velocity drop ;
+: jump ( player -- )
+    [ { 0.0 $ JUMP 0.0 } v+ ] change-velocity drop ;
 
-: rotate-with-mouse ( world mouse -- )
+: clamp-pitch ( pitch -- pitch' )
+    90.0 min -90.0 max ;
+
+: rotate-with-mouse ( player mouse -- )
     [ dx>> MOUSE-SCALE * [ + ] curry change-yaw ]
-    [ dy>> MOUSE-SCALE * [ + ] curry change-pitch ] bi
+    [ dy>> MOUSE-SCALE * [ + clamp-pitch ] curry change-pitch ] bi
     drop ;
 
 :: handle-input ( world -- )
+    world player>> :> player
     read-keyboard keys>> :> keys
-    key-w keys nth [ world move-forward ] when 
+    key-w keys nth [ player walk-forward ] when 
-    key-s keys nth [ world move-backward ] when 
+    key-s keys nth [ player walk-backward ] when 
-    key-a keys nth [ world move-leftward ] when 
+    key-a keys nth [ player walk-leftward ] when 
-    key-d keys nth [ world move-rightward ] when 
+    key-d keys nth [ player walk-rightward ] when 
+    key-space keys nth [ player jump ] when 
     key-escape keys nth [ world close-window ] when
-    world read-mouse rotate-with-mouse
+    player read-mouse rotate-with-mouse
     reset-mouse ;
 
-M: terrain-world tick*
+: apply-friction ( velocity -- velocity' )
-    [ handle-input ] keep
+    FRICTION v*n ;
-    ! [ eye>> ] [ yaw>> ] [ pitch>> ] tri 3array P ! debug
+
+: apply-gravity ( velocity -- velocity' )
+    1 over [ GRAVITY - ] change-nth ;
+
+: pixel ( coords dim -- index )
+    [ drop first ] [ [ second ] [ first ] bi* * ] 2bi + ;
+
+: terrain-height-at ( segment point -- height )
+    over dim>> [ v* vfloor ] [ pixel >integer ] bi
+    swap bitmap>> 4 <groups> nth COMPONENT-SCALE v. 255.0 / ;
+
+: collide ( segment location -- location' )
+    [ [ first ] [ third ] bi 2array terrain-height-at PLAYER-HEIGHT + ]
+    [ [ 1 ] 2dip [ max ] with change-nth ]
+    [ ] tri ;
+
+: tick-player ( world player -- )
+    [ apply-friction apply-gravity ] change-velocity
+    dup velocity>> [ v+ [ terrain-segment>> ] dip collide ] curry with change-location
+    P
     drop ;
 
+M: terrain-world tick*
+    [ dup focused?>> [ handle-input ] [ drop ] if ]
+    [ dup player>> tick-player ] bi ;
+
 M: terrain-world draw*
     nip draw-world ;
 
@@ -137,9 +176,7 @@ M: terrain-world begin-world
     GL_TEXTURE_2D glEnable
     GL_VERTEX_ARRAY glEnableClientState
     0.5 0.5 0.5 1.0 glClearColor
-    EYE-START >>eye
+    PLAYER-START-LOCATION 0.0 0.0 { 0.0 0.0 0.0 } player boa >>player
-    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
@@ -169,7 +206,8 @@ 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
+        [ "heightmap" glGetUniformLocation 0 glUniform1i ]
+        [ "component_scale" glGetUniformLocation COMPONENT-SCALE first4 glUniform4f ] bi
         terrain-vertex-buffer>> draw-vertex-buffer
     ] with-gl-program ]
     tri gl-error ;
@@ -190,3 +228,5 @@ M: terrain-world pref-dim* drop { 640 480 } ;
             { grab-input? t }
         } open-window
     ] with-ui ;
+
+MAIN: terrain-window