Successfully render terrain

5 files changed, 127 insertions, 36 deletions

diff --git a/src/Vivant.hs b/src/Vivant.hs
index 45ed667..323602f 100644
--- a/src/Vivant.hs
+++ b/src/Vivant.hs
@@ -33,7 +33,7 @@ import qualified Graphics.Rendering.OpenGL as GL
 import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as GL (UniformLocation (..))
 import Linear
 import Paths_vivant (getDataDir)
-import SDL (($=))
+import Graphics.Rendering.OpenGL (($=))
 import qualified SDL
 import SDL.Raw.Enum as SDL
 import SDL.Raw.Video as SDL (glSetAttribute)
@@ -42,6 +42,8 @@ import SDL.Vect
 import System.Exit (exitFailure)
 import System.IO
 import Vivant.Shader (createProgram)
+import Vivant.Renderer
+import Vivant.Terrain
 
 screenWidth, screenHeight :: CInt
 (screenWidth, screenHeight) = (640, 480)
@@ -73,7 +75,8 @@ data Game = Game
     gameModelP :: Ptr (M44 Float),
     gameViewP :: Ptr (M44 Float),
     gameProjectionP :: Ptr (M44 Float),
-    gameCamera :: Camera
+    gameCamera :: Camera,
+    gameTerrain :: Maybe Terrain
   }
   deriving (Show)
 
@@ -85,7 +88,8 @@ initialGameState =
       gameModelP = nullPtr,
       gameViewP = nullPtr,
       gameProjectionP = nullPtr,
-      gameCamera = initialCamera
+      gameCamera = initialCamera,
+      gameTerrain = Nothing
     }
 
 data MouseInputs = MouseInputs
@@ -232,23 +236,6 @@ updateMouse mouse game =
     newPos = rotation . cameraPos $ gameCamera game
     newUp = rotation . cameraUp $ gameCamera game
 
-setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO ()
-setVertexAttribute program name vertices stride offset = do
-  let floatSize = sizeOf (1.0 :: Float)
-  attrib <- GL.get $ GL.attribLocation program name
-  GL.vertexAttribPointer attrib
-    $= ( GL.ToFloat,
-         GL.VertexArrayDescriptor
-           (fromIntegral vertices)
-           GL.Float
-           (fromIntegral $ stride * floatSize)
-           (plusPtr nullPtr (offset * floatSize))
-       )
-  GL.vertexAttribArray attrib $= GL.Enabled
-
-getUniformLocation :: GL.UniformLocation -> GL.GLint
-getUniformLocation (GL.UniformLocation i) = i
-
 initResources :: IO Game
 initResources = do
   vao <- GL.genObjectName
@@ -267,13 +254,16 @@ initResources = do
   viewP <- malloc
   projectionP <- malloc
 
+  terrain <- initTerrain [[1, 2, 3, 4], [3, 2, 1, 4], [2, 5, 2, 3], [3, 1, 2, 4]] prog
+
   return $
     initialGameState
       { gameProgram = Just prog,
         gameVao = Just vao,
         gameModelP = modelP,
         gameViewP = viewP,
-        gameProjectionP = projectionP
+        gameProjectionP = projectionP,
+        gameTerrain = Just terrain
       }
 
 -- | Convert degrees to radians
@@ -284,13 +274,13 @@ scaledMat :: V4 (V4 Float) -> V4 (V4 Float)
 scaledMat n = ((n * identity) & _w . _w .~ 1)
 
 draw :: Game -> IO ()
-draw game@(Game {gameProgram = Just p, gameVao = Just v}) = do
+draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t}) = do
   tick <- ticks
   GL.clearColor $= GL.Color4 1 1 1 1
   GL.clear [GL.ColorBuffer, GL.DepthBuffer]
 
   GL.currentProgram $= gameProgram game
-  GL.bindVertexArrayObject $= gameVao game
+  GL.bindVertexArrayObject $= rendererVao (terrainRenderer t)
 
   model <- getUniformLocation <$> GL.uniformLocation p "model"
   view <- getUniformLocation <$> GL.uniformLocation p "view"
@@ -311,11 +301,7 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v}) = do
   ourColorLoc <- GL.uniformLocation p "ourColour"
   GL.uniform ourColorLoc $= (GL.Vector4 (1 :: Float) 0.5 1 1)
 
-  forM_ locs $ \l -> do
-    let modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0) l !*! scaledMat 5
-    poke (gameModelP game) modelMatrix
-    GL.glUniformMatrix4fv model 1 1 (castPtr (gameModelP game))
-    GL.drawArrays GL.Triangles 0 36
+  render $ terrainRenderer t
 
   GL.bindVertexArrayObject $= Nothing
   return ()
diff --git a/src/Vivant/Common.hs b/src/Vivant/Common.hs
new file mode 100644
index 0000000..fd90233
--- /dev/null
+++ b/src/Vivant/Common.hs
@@ -0,0 +1,9 @@
+module Vivant.Common
+  (vectorSize)
+where
+
+import qualified Data.Vector.Storable as V
+import Foreign.Storable (sizeOf)
+
+vectorSize :: (Num b, V.Storable a) => V.Vector a -> b
+vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
diff --git a/src/Vivant/Renderer.hs b/src/Vivant/Renderer.hs
index ca623e7..f66b0d7 100644
--- a/src/Vivant/Renderer.hs
+++ b/src/Vivant/Renderer.hs
@@ -1,15 +1,49 @@
 module Vivant.Renderer
-  (Renderer(..))
+  (Renderer(..), getUniformLocation, destroyRenderer, render, setVertexAttribute)
 where
 
 import qualified Graphics.Rendering.OpenGL as GL
 import Linear
 import Foreign.Ptr
+import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv)
+import Graphics.Rendering.OpenGL (($=))
+import Foreign.Marshal.Alloc (free)
+import Foreign.Storable (sizeOf)
 
 data Renderer = Renderer
   { rendererProgram :: Maybe GL.Program,
     rendererVao :: Maybe GL.VertexArrayObject,
-    rendererModelP :: Ptr (M44 Float)
-  } deriving Show
+    rendererModelP :: Ptr (M44 Float),
+    rendererTriangleNum :: Int
+  } deriving (Show)
 
-draw :: Renderer -> IO ()
+getUniformLocation :: GL.UniformLocation -> GL.GLint
+getUniformLocation (GL.UniformLocation i) = i
+
+render :: Renderer -> IO ()
+render r@(Renderer {rendererProgram = Just p}) = do
+--  GL.currentProgram $= rendererProgram r
+  GL.bindVertexArrayObject $= rendererVao r
+
+  model <- getUniformLocation <$> GL.uniformLocation p "model"
+  GL.glUniformMatrix4fv model 1 1 (castPtr (rendererModelP r))
+
+  GL.drawArrays GL.Triangles 0 (fromIntegral $ rendererTriangleNum r)
+
+destroyRenderer :: Renderer -> IO ()
+destroyRenderer r =
+  free $ rendererModelP r
+
+setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO ()
+setVertexAttribute program name vertices stride offset = do
+  let floatSize = sizeOf (1.0 :: Float)
+  attrib <- GL.get $ GL.attribLocation program name
+  GL.vertexAttribPointer attrib
+    $= ( GL.ToFloat,
+         GL.VertexArrayDescriptor
+           (fromIntegral vertices)
+           GL.Float
+           (fromIntegral $ stride * floatSize)
+           (plusPtr nullPtr (offset * floatSize))
+       )
+  GL.vertexAttribArray attrib $= GL.Enabled
diff --git a/src/Vivant/Terrain.hs b/src/Vivant/Terrain.hs
index 9d5201a..3099177 100644
--- a/src/Vivant/Terrain.hs
+++ b/src/Vivant/Terrain.hs
@@ -1,6 +1,65 @@
-module Vivant.Terrain where
+module Vivant.Terrain
+  (Terrain(..), initTerrain)
+where
+
+import Vivant.Renderer
+import qualified Data.Vector.Storable as V
+import qualified Graphics.Rendering.OpenGL as GL
+import SDL (($=))
+import Foreign.Marshal.Alloc (free, malloc)
+import Foreign.Ptr
+import Vivant.Common (vectorSize)
+import Foreign.Storable (poke)
+import Linear
 
 data Terrain = Terrain
   {
-    terrainVao ::
-  }
+    terrainWidth :: Int,
+    terrainHeight :: Int,
+    terrainGeometry :: [[Int]],
+    terrainRenderer :: Renderer
+  } deriving (Show)
+
+partition
+  :: (V.Storable a1, Integral a2, Num a1) => [[a2]] -> V.Vector a1
+partition r =
+  V.fromList . fmap fromIntegral . concat . concat .
+  fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0..])
+  $ zip (zip r $ tail r) [0..]
+  where
+    generateP y (((z1, z2), (z3, z4)), x) =
+      [ x,   y,   z1
+      , x,   y+1, z2
+      , x+1, y,   z3
+      , x,   y+1, z2
+      , x+1, y,   z3
+      , x+1, y+1, z4
+      ]
+
+initTerrain :: [[Int]] -> GL.Program -> IO Terrain
+initTerrain g p = do
+  vao <- GL.genObjectName
+  GL.bindVertexArrayObject $= Just vao
+
+  vbo <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just vbo
+
+  let g' = partition g :: V.Vector Float
+  V.unsafeWith g' $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $= (vectorSize g', castPtr ptr, GL.StaticDraw)
+
+  setVertexAttribute p "position" 3 0 0
+
+  GL.bindVertexArrayObject $= Nothing
+
+  modelP <- malloc
+  let modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0) (V3 (-2.5) (-2.5) 0)
+  poke modelP modelMatrix
+
+  let h = length g
+      w = length (head g)
+  return $ Terrain w h g (Renderer (Just p) (Just vao) modelP 72)
+
+destroyTerrain :: Terrain -> IO ()
+destroyTerrain t =
+  destroyRenderer $ terrainRenderer t
diff --git a/vivant.cabal b/vivant.cabal
index 2d73afd..ade5c8d 100644
--- a/vivant.cabal
+++ b/vivant.cabal
@@ -24,8 +24,11 @@ data-files: shaders/*.vert,
 executable vivant
   main-is:            Vivant.hs
   other-modules:      Paths_vivant,
+                      Vivant.Common,
                       Vivant.Noise,
-                      Vivant.Shader
+                      Vivant.Shader,
+                      Vivant.Renderer,
+                      Vivant.Terrain
   default-extensions: OverloadedStrings
   build-depends:      base >=4.14 && <4.15,
                       sdl2 >=2.5.3.0 && <2.6,