diff options
Diffstat (limited to 'src/Vivant.hs')
| -rw-r--r-- | src/Vivant.hs | 69 |
1 files changed, 53 insertions, 16 deletions
diff --git a/src/Vivant.hs b/src/Vivant.hs index 323602f..a3973a5 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') @@ -23,12 +23,12 @@ import Data.Int (Int32) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Vector.Storable as V -import Data.Word (Word32) +import Data.Word (Word32, Word8) import Foreign.C.Types import Foreign.Marshal.Alloc (free, malloc) import Foreign.Ptr import Foreign.Storable (poke, sizeOf) -import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv) +import qualified Graphics.GL.Compatibility33 as GL import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as GL (UniformLocation (..)) import Linear @@ -44,6 +44,7 @@ import System.IO import Vivant.Shader (createProgram) import Vivant.Renderer import Vivant.Terrain +import Vivant.Noise screenWidth, screenHeight :: CInt (screenWidth, screenHeight) = (640, 480) @@ -96,7 +97,8 @@ data MouseInputs = MouseInputs { mousePosition :: Point V2 Int32, mouseRelative :: V2 Int32, mousePositionOld :: Maybe (V2 Int32), - mousePressed :: Bool + mousePressed :: Bool, + mouseWheel :: Int32 } deriving (Show) @@ -106,7 +108,8 @@ initialMouse = { mousePosition = P (V2 400 300), mouseRelative = V2 0 0, mousePositionOld = Nothing, - mousePressed = False + mousePressed = False, + mouseWheel = 0 } main :: IO () @@ -137,6 +140,7 @@ main = do _ <- SDL.glCreateContext window + GL.depthFunc $= Just GL.Less GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight)) game <- initResources @@ -173,14 +177,19 @@ parseEvents :: Set SDL.Keysym -> MouseInputs -> IO (Set SDL.Keysym, MouseInputs) parseEvents keys mouse = do events <- SDL.pollEvents let events' = fmap SDL.eventPayload events - let isMoving = (> 0) . length $ filter mouseMoving events' let (k, m) = foldr handleEvents (keys, mouse) events' - return (if isMoving - then (k, m) - else (k, m {mouseRelative = V2 0 0})) + return + . 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 _ = False + mouseWheel (SDL.MouseWheelEvent{}) = True + mouseWheel _ = False + changeIfIn events event modification initial = + if (> 0) . length $ filter event events + then initial + else modification initial handleEvents :: SDL.EventPayload -> @@ -201,7 +210,7 @@ handleEvents event (k, m) = SDL.mouseMotionEventRelMotion = vel } ) -> - (k, MouseInputs pos vel (mousePositionOld m) (mousePressed m)) + (k, MouseInputs pos vel (mousePositionOld m) (mousePressed m) (mouseWheel m)) SDL.MouseButtonEvent (SDL.MouseButtonEventData { SDL.mouseButtonEventMotion = SDL.Pressed @@ -212,6 +221,11 @@ handleEvents event (k, m) = { SDL.mouseButtonEventMotion = SDL.Released }) -> (k, m {mousePressed = False}) + SDL.MouseWheelEvent + (SDL.MouseWheelEventData + { SDL.mouseWheelEventPos = V2 x y + }) -> + (k, m {mouseWheel = y}) SDL.QuitEvent {} -> (Set.insert escapeKey k, m) _ -> (k, m) @@ -222,8 +236,8 @@ updateMouse mouse game = { gameCamera = (gameCamera game) { - cameraPos = newPos, - cameraFront = normalize (V3 0 0 0 ^-^ newPos), + cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront), + cameraFront = newFront, cameraUp = newUp } } @@ -235,6 +249,26 @@ updateMouse mouse game = | 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 n x y = + doubleToByte $ + ( ( perlin3 + permutation + ( (fromIntegral x - 32) / 4, + (fromIntegral y - 32) / 4, + n + ) + ) + + 1 + ) + / 2 + * 128 + +createTerrain :: [[Float]] +createTerrain = + fmap (\y -> fmap (\x -> fromIntegral (pixelRenderer 0 x y) / 15) [0..63]) [0..63] initResources :: IO Game initResources = do @@ -254,7 +288,7 @@ 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 + terrain <- initTerrain createTerrain prog return $ initialGameState @@ -273,6 +307,9 @@ toRadians = (*) (pi / 180) scaledMat :: V4 (V4 Float) -> V4 (V4 Float) scaledMat n = ((n * identity) & _w . _w .~ 1) +castV3 :: V3 a -> GL.Vector3 a +castV3 (V3 a b c) = GL.Vector3 a b c + draw :: Game -> IO () draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t}) = do tick <- ticks @@ -290,7 +327,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 100 + projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 1000 poke (gameViewP game) viewMatrix poke (gameProjectionP game) projectionMatrix @@ -298,8 +335,8 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t}) GL.glUniformMatrix4fv view 1 1 (castPtr (gameViewP game)) GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game)) - ourColorLoc <- GL.uniformLocation p "ourColour" - GL.uniform ourColorLoc $= (GL.Vector4 (1 :: Float) 0.5 1 1) + ourColorLoc <- GL.uniformLocation p "light_pos" + GL.uniform ourColorLoc $= castV3 (cameraPos (gameCamera game)) render $ terrainRenderer t |