extra/terrain/terrain.factor

   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 ;
   9 IN: terrain
  10
  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 / ]
  18
  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 * ]
  22
  23 TUPLE: terrain-world < world
  24     eye yaw pitch
  25     terrain terrain-segment terrain-texture terrain-program
  26     terrain-vertex-buffer
  27     game-loop ;
  28
  29 : frustum ( dim -- -x x -y y near far )
  30     dup first2 min v/n
  31     NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@
  32     NEAR-PLANE FAR-PLANE ;
  33
  34 : set-modelview-matrix ( gadget -- )
  35     GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  36     GL_MODELVIEW glMatrixMode
  37     glLoadIdentity
  38     [ pitch>> 1.0 0.0 0.0 glRotatef ]
  39     [ yaw>> 0.0 1.0 0.0 glRotatef ]
  40     [ eye>> vneg first3 glTranslatef ] tri ;
  41
  42 : vertex-array-vertex ( x z -- vertex )
  43     [ terrain-vertex-distance first * ]
  44     [ terrain-vertex-distance second * ] bi*
  45     [ 0 ] dip float-array{ } 3sequence ;
  46
  47 : vertex-array-row ( z -- vertices )
  48     dup 1 + 2array
  49     terrain-vertex-size first 1 + iota
  50     2array [ first2 swap vertex-array-vertex ] product-map
  51     concat ;
  52
  53 : vertex-array ( -- vertices )
  54     terrain-vertex-size second iota
  55     [ vertex-array-row ] map concat ;
  56
  57 : >vertex-buffer ( bytes -- buffer )
  58     [ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW <gl-buffer> ;
  59
  60 : draw-vertex-buffer-row ( i -- )
  61     [ GL_TRIANGLE_STRIP ] dip
  62     terrain-vertex-row-length * terrain-vertex-row-length
  63     glDrawArrays ;
  64
  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
  69     ] with-gl-buffer ;
  70
  71 : degrees ( deg -- rad )
  72     pi 180.0 / * ;
  73
  74 :: eye-rotate ( yaw pitch v -- v' )
  75     yaw degrees neg :> y
  76     pitch degrees neg :> p
  77     y cos :> cosy
  78     y sin :> siny
  79     p cos :> cosp
  80     p sin :> sinp
  81
  82     cosy         0.0       siny        neg 3array
  83     siny sinp *  cosp      cosy sinp *     3array
  84     siny cosp *  sinp neg  cosy cosp *     3array 3array
  85     v swap v.m ;
  86
  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 ;
  93
  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 ;
 102
 103 : rotate-with-mouse ( world mouse -- )
 104     [ dx>> MOUSE-SCALE * [ + ] curry change-yaw ]
 105     [ dy>> MOUSE-SCALE * [ + ] curry change-pitch ] bi
 106     drop ;
 107
 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     world read-mouse rotate-with-mouse
 115     reset-mouse ;
 116
 117 M: terrain-world tick*
 118     [ handle-input ] keep
 119     ! [ eye>> ] [ yaw>> ] [ pitch>> ] tri 3array P ! debug
 120     drop ;
 121
 122 M: terrain-world draw*
 123     nip draw-world ;
 124
 125 : set-heightmap-texture-parameters ( texture -- )
 126     GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit
 127     GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
 128     GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
 129     GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE glTexParameteri
 130     GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE glTexParameteri ;
 131
 132 M: terrain-world begin-world
 133     "2.0" { "GL_ARB_vertex_buffer_object" "GL_ARB_shader_objects" }
 134     require-gl-version-or-extensions
 135     GL_DEPTH_TEST glEnable
 136     GL_TEXTURE_2D glEnable
 137     GL_VERTEX_ARRAY glEnableClientState
 138     0.5 0.5 0.5 1.0 glClearColor
 139     EYE-START >>eye
 140     0.0 >>yaw
 141     0.0 >>pitch
 142     <terrain> [ >>terrain ] keep
 143     { 0 0 } terrain-segment [ >>terrain-segment ] keep
 144     make-texture [ set-heightmap-texture-parameters ] keep >>terrain-texture
 145     terrain-vertex-shader terrain-pixel-shader <simple-gl-program>
 146     >>terrain-program
 147     vertex-array >vertex-buffer >>terrain-vertex-buffer
 148     TICK-LENGTH over <game-loop> [ >>game-loop ] keep start-loop
 149     open-game-input
 150     drop ;
 151
 152 M: terrain-world end-world
 153     close-game-input
 154     {
 155         [ game-loop>> stop-loop ]
 156         [ terrain-vertex-buffer>> delete-gl-buffer ]
 157         [ terrain-program>> delete-gl-program ]
 158         [ terrain-texture>> delete-texture ]
 159     } cleave ;
 160
 161 M: terrain-world resize-world
 162     GL_PROJECTION glMatrixMode
 163     glLoadIdentity
 164     dim>> [ [ 0 0 ] dip first2 glViewport ]
 165     [ frustum glFrustum ] bi ;
 166
 167 M: terrain-world draw-world*
 168     [ set-modelview-matrix ]
 169     [ terrain-texture>> GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit ]
 170     [ dup terrain-program>> [
 171         "heightmap" glGetUniformLocation 0 glUniform1i
 172         terrain-vertex-buffer>> draw-vertex-buffer
 173     ] with-gl-program ]
 174     tri gl-error ;
 175
 176 M: terrain-world focusable-child* drop t ;
 177 M: terrain-world pref-dim* drop { 640 480 } ;
 178
 179 : terrain-window ( -- )
 180     [
 181         f T{ world-attributes
 182             { world-class terrain-world }
 183             { title "Terrain" }
 184             { pixel-format-attributes {
 185                 windowed
 186                 double-buffered
 187                 T{ depth-bits { value 24 } }
 188             } }
 189             { grab-input? t }
 190         } open-window
 191     ] with-ui ;