From 5d558623f359340416e386b3bd93ee9c1e3f4ad8 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 2 Jan 2021 17:27:30 +0000 Subject: Successfully render terrain --- src/Vivant.hs | 42 +++++++++++--------------------- src/Vivant/Common.hs | 9 +++++++ src/Vivant/Renderer.hs | 42 ++++++++++++++++++++++++++++---- src/Vivant/Terrain.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++--- vivant.cabal | 5 +++- 5 files changed, 127 insertions(+), 36 deletions(-) create mode 100644 src/Vivant/Common.hs 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, -- cgit