From 3f26ce1b76fc2ff77740b71c9470e093ebde69b5 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 3 Jan 2021 12:22:14 +0000 Subject: Format with ormolu --- Setup.hs | 1 + shaders/phong.frag.glsl | 2 +- src/Vivant.hs | 255 ++++++++++++++++++++++++++++++++---------------- src/Vivant/Common.hs | 4 +- src/Vivant/Renderer.hs | 17 ++-- src/Vivant/Terrain.hs | 89 ++++++++++------- 6 files changed, 237 insertions(+), 131 deletions(-) diff --git a/Setup.hs b/Setup.hs index 9a994af..e8ef27d 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/shaders/phong.frag.glsl b/shaders/phong.frag.glsl index a1a0645..e7d7a33 100644 --- a/shaders/phong.frag.glsl +++ b/shaders/phong.frag.glsl @@ -10,7 +10,7 @@ uniform vec3 light_pos; void main() { vec3 ambient = vec3(0.2, 0.2, 0.2); vec3 light_colour = vec3(1.0, 1.0, 1.0); - vec3 object_colour = vec3(0.5, 0.2, 0.8); + vec3 object_colour = vec3(0.8, 0.6, 0.2); vec3 norm = normalize(o_normal); vec3 light_dir = normalize(light_pos - o_frag_pos); float diff = max(dot(norm, light_dir), 0.0); diff --git a/src/Vivant.hs b/src/Vivant.hs index 001b463..21c397e 100644 --- a/src/Vivant.hs +++ b/src/Vivant.hs @@ -14,7 +14,7 @@ module Main where -import Control.Lens ((.~), (^.), (%~)) +import Control.Lens ((%~), (.~), (^.)) import Control.Monad import qualified Data.ByteString as BS import Data.Fixed (mod') @@ -29,11 +29,11 @@ import Foreign.Marshal.Alloc (free, malloc) import Foreign.Ptr import Foreign.Storable (poke, sizeOf) import qualified Graphics.GL.Compatibility33 as GL +import Graphics.Rendering.OpenGL (($=)) 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 Graphics.Rendering.OpenGL (($=)) import qualified SDL import SDL.Raw.Enum as SDL import SDL.Raw.Video as SDL (glSetAttribute) @@ -41,10 +41,10 @@ import SDL.Time (ticks) import SDL.Vect import System.Exit (exitFailure) import System.IO -import Vivant.Shader (createProgram) +import Vivant.Noise import Vivant.Renderer +import Vivant.Shader (createProgram) import Vivant.Terrain -import Vivant.Noise screenWidth, screenHeight :: CInt (screenWidth, screenHeight) = (640, 480) @@ -123,7 +123,7 @@ main = do window <- SDL.createWindow - "SDL / OpenGL Example" + "Vivant" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL @@ -182,14 +182,14 @@ parseEvents keys mouse = do . changeIfIn events' mouseWheel (\(k, m) -> (k, m {mouseWheel = 0})) $ changeIfIn events' mouseMoving (\(k, m) -> (k, m {mouseRelative = V2 0 0})) (k, m) where - mouseMoving (SDL.MouseMotionEvent{}) = True + mouseMoving (SDL.MouseMotionEvent {}) = True mouseMoving _ = False - mouseWheel (SDL.MouseWheelEvent{}) = True + mouseWheel (SDL.MouseWheelEvent {}) = True mouseWheel _ = False changeIfIn events event modification initial = if (> 0) . length $ filter event events - then initial - else modification initial + then initial + else modification initial handleEvents :: SDL.EventPayload -> @@ -212,20 +212,23 @@ handleEvents event (k, m) = ) -> (k, MouseInputs pos vel (mousePositionOld m) (mousePressed m) (mouseWheel m)) SDL.MouseButtonEvent - (SDL.MouseButtonEventData - { SDL.mouseButtonEventMotion = SDL.Pressed - }) -> - (k, m {mousePressed = True}) + ( SDL.MouseButtonEventData + { SDL.mouseButtonEventMotion = SDL.Pressed + } + ) -> + (k, m {mousePressed = True}) SDL.MouseButtonEvent - (SDL.MouseButtonEventData - { SDL.mouseButtonEventMotion = SDL.Released - }) -> - (k, m {mousePressed = False}) + ( SDL.MouseButtonEventData + { SDL.mouseButtonEventMotion = SDL.Released + } + ) -> + (k, m {mousePressed = False}) SDL.MouseWheelEvent - (SDL.MouseWheelEventData - { SDL.mouseWheelEventPos = V2 x y - }) -> - (k, m {mouseWheel = y}) + ( SDL.MouseWheelEventData + { SDL.mouseWheelEventPos = V2 x y + } + ) -> + (k, m {mouseWheel = y}) SDL.QuitEvent {} -> (Set.insert escapeKey k, m) _ -> (k, m) @@ -235,40 +238,43 @@ updateMouse mouse game = game { gameCamera = (gameCamera game) - { - cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront), + { cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront), cameraFront = newFront, cameraUp = newUp } } where rotation v - | mousePressed mouse = rotate (axisAngle (V3 0 0 1) - ((/ 2) . toRadians . fromIntegral - $ - (mouseRelative mouse ^. _x))) v + | mousePressed mouse = + rotate + ( axisAngle + (V3 0 0 1) + ( (/ 2) . toRadians . fromIntegral $ + - (mouseRelative mouse ^. _x) + ) + ) + v | otherwise = v newPos = rotation . cameraPos $ gameCamera game newUp = rotation . cameraUp $ gameCamera game newFront = normalize (V3 0 0 0 ^-^ newPos) -pixelRenderer :: Double -> Int -> Int -> Word8 +pixelRenderer :: Double -> Int -> Int -> Float pixelRenderer n x y = - doubleToByte $ + fromRational . toRational $ ( ( perlin3 permutation - ( (fromIntegral x - 32) / 4, - (fromIntegral y - 32) / 4, + ( (fromIntegral x - 32) / 16, + (fromIntegral y - 32) / 16, n ) ) + 1 ) - / 2 - * 128 createTerrain :: [[Float]] createTerrain = - fmap (\y -> fmap (\x -> fromIntegral (pixelRenderer 0 x y) / 20) [0..63]) [0..63] + fmap (\y -> fmap (\x -> pixelRenderer 3 x y * 5) [0 .. 256]) [0 .. 256] initResources :: IO Game initResources = do @@ -327,7 +333,7 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t}) cameraPosition = cameraPos camera targetPosition = cameraPosition ^+^ cameraFront camera viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera) - projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 200 + projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 500 poke (gameViewP game) viewMatrix poke (gameProjectionP game) projectionMatrix @@ -336,9 +342,9 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t}) GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game)) ourColorLoc <- GL.uniformLocation p "light_pos" - GL.uniform ourColorLoc $= - (GL.Vector3 (0::Float) (32 * sin (fromIntegral tick / 2000)) (16 * (abs $ cos (fromIntegral tick / 2000)))) - --castV3 (cameraPos (gameCamera game)) + GL.uniform ourColorLoc + $= (GL.Vector3 (0 :: Float) (128 * sin (fromIntegral tick / 2000)) (64 * (abs $ cos (fromIntegral tick / 2000)))) + --castV3 (cameraPos (gameCamera game)) render $ terrainRenderer t @@ -351,59 +357,138 @@ vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float) vertices :: V.Vector Float vertices = V.fromList - [ 0.5, -0.5, 0, - -0.5, -0.5, 0, - 0.5, 0.5, 0, - -0.5, 0.5, 0, - -0.5, -0.5, 0, - 0.5, 0.5, 0 + [ 0.5, + -0.5, + 0, + -0.5, + -0.5, + 0, + 0.5, + 0.5, + 0, + -0.5, + 0.5, + 0, + -0.5, + -0.5, + 0, + 0.5, + 0.5, + 0 ] square :: V.Vector Float square = V.fromList - [ -0.5, -0.5, -0.5, - 0.5, -0.5, -0.5, - 0.5, 0.5, -0.5, - 0.5, 0.5, -0.5, - -0.5, 0.5, -0.5, - -0.5, -0.5, -0.5, - - -0.5, -0.5, 0.5, - 0.5, -0.5, 0.5, - 0.5, 0.5, 0.5, - 0.5, 0.5, 0.5, - -0.5, 0.5, 0.5, - -0.5, -0.5, 0.5, - - -0.5, 0.5, 0.5, - -0.5, 0.5, -0.5, - -0.5, -0.5, -0.5, - -0.5, -0.5, -0.5, - -0.5, -0.5, 0.5, - -0.5, 0.5, 0.5, - - 0.5, 0.5, 0.5, - 0.5, 0.5, -0.5, - 0.5, -0.5, -0.5, - 0.5, -0.5, -0.5, - 0.5, -0.5, 0.5, - 0.5, 0.5, 0.5, - - -0.5, -0.5, -0.5, - 0.5, -0.5, -0.5, - 0.5, -0.5, 0.5, - 0.5, -0.5, 0.5, - -0.5, -0.5, 0.5, - -0.5, -0.5, -0.5, - - -0.5, 0.5, -0.5, - 0.5, 0.5, -0.5, - 0.5, 0.5, 0.5, - 0.5, 0.5, 0.5, - -0.5, 0.5, 0.5, - -0.5, 0.5, -0.5 - ] + [ -0.5, + -0.5, + -0.5, + 0.5, + -0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + -0.5, + 0.5, + -0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + -0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + 0.5, + 0.5, + 0.5, + 0.5, + -0.5, + -0.5, + -0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + -0.5, + -0.5, + 0.5, + -0.5, + -0.5, + -0.5, + -0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + 0.5, + -0.5, + 0.5, + 0.5, + -0.5, + 0.5, + -0.5 + ] locs :: [V3 Float] locs = diff --git a/src/Vivant/Common.hs b/src/Vivant/Common.hs index cf017ca..a02f8ad 100644 --- a/src/Vivant/Common.hs +++ b/src/Vivant/Common.hs @@ -1,6 +1,4 @@ -module Vivant.Common - (vectorSize, uncurry3) -where +module Vivant.Common (vectorSize, uncurry3) where import qualified Data.Vector.Storable as V import Foreign.Storable (sizeOf) diff --git a/src/Vivant/Renderer.hs b/src/Vivant/Renderer.hs index f66b0d7..91a395f 100644 --- a/src/Vivant/Renderer.hs +++ b/src/Vivant/Renderer.hs @@ -1,28 +1,27 @@ -module Vivant.Renderer - (Renderer(..), getUniformLocation, destroyRenderer, render, setVertexAttribute) -where +module Vivant.Renderer (Renderer (..), getUniformLocation, destroyRenderer, render, setVertexAttribute) where -import qualified Graphics.Rendering.OpenGL as GL -import Linear +import Foreign.Marshal.Alloc (free) import Foreign.Ptr +import Foreign.Storable (sizeOf) import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv) import Graphics.Rendering.OpenGL (($=)) -import Foreign.Marshal.Alloc (free) -import Foreign.Storable (sizeOf) +import qualified Graphics.Rendering.OpenGL as GL +import Linear data Renderer = Renderer { rendererProgram :: Maybe GL.Program, rendererVao :: Maybe GL.VertexArrayObject, rendererModelP :: Ptr (M44 Float), rendererTriangleNum :: Int - } deriving (Show) + } + deriving (Show) 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.currentProgram $= rendererProgram r GL.bindVertexArrayObject $= rendererVao r model <- getUniformLocation <$> GL.uniformLocation p "model" diff --git a/src/Vivant/Terrain.hs b/src/Vivant/Terrain.hs index befee88..b73469a 100644 --- a/src/Vivant/Terrain.hs +++ b/src/Vivant/Terrain.hs @@ -1,24 +1,22 @@ -module Vivant.Terrain - (Terrain(..), initTerrain) -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, uncurry3) import Foreign.Storable (poke) +import qualified Graphics.Rendering.OpenGL as GL import Linear +import SDL (($=)) +import Vivant.Common (uncurry3, vectorSize) +import Vivant.Renderer data Terrain = Terrain - { - terrainWidth :: Int, + { terrainWidth :: Int, terrainHeight :: Int, terrainGeometry :: [[Float]], terrainRenderer :: Renderer - } deriving (Show) + } + deriving (Show) normal :: Num c => (c, c, c) -> (c, c, c) -> (c, c, c) -> (c, c, c) normal a b c = @@ -26,30 +24,53 @@ normal a b c = where transform (V3 a b c) = (a, b, c) -partition - :: (V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1 +partition :: + (V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1 partition r = - V.fromList . concat . concat . - fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0..]) - $ zip (zip r $ tail r) [0..] + V.fromList . 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) = - let (n1x, n1y, n1z) = normal (x, y, z1) (x, y+1, z2) (x+1, y, z3) - (n2x, n2y, n2z) = normal (x+1, y+1, z4) (x, y+1, z2) (x+1, y, z3) - in - [ x, y, z1 - , -n1x, -n1y, -n1z - , x, y+1, z2 - , -n1x, -n1y, -n1z - , x+1, y, z3 - , -n1x, -n1y, -n1z - , x, y+1, z2 - , n2x, n2y, n2z - , x+1, y, z3 - , n2x, n2y, n2z - , x+1, y+1, z4 - , n2x, n2y, n2z - ] + let (n1x, n1y, n1z) = normal (x, y, z1) (x, y + 1, z2) (x + 1, y, z3) + (n2x, n2y, n2z) = normal (x + 1, y + 1, z4) (x, y + 1, z2) (x + 1, y, z3) + in [ x, + y, + z1, + - n1x, + - n1y, + - n1z, + x, + y + 1, + z2, + - n1x, + - n1y, + - n1z, + x + 1, + y, + z3, + - n1x, + - n1y, + - n1z, + x, + y + 1, + z2, + n2x, + n2y, + n2z, + x + 1, + y, + z3, + n2x, + n2y, + n2z, + x + 1, + y + 1, + z4, + n2x, + n2y, + n2z + ] initTerrain :: [[Float]] -> GL.Program -> IO Terrain initTerrain g p = do @@ -70,8 +91,10 @@ initTerrain g p = do let h = length g w = length (head g) - modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0) - (V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0) + modelMatrix = + mkTransformation + (axisAngle (V3 0 0 0) 0) + (V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0) modelP <- malloc poke modelP modelMatrix -- cgit