From 0ebe8180079a454581d3fddd3c3df443d2e4f1ae Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 5 Jan 2023 23:07:21 +0100 Subject: [PATCH] fill ReadState --- src/CommandBuffer.hs | 34 +++++++++++++++++-------------- src/Draw.hs | 16 +++++++++------ src/GraphicsPipeline.hs | 25 +++++++++++++---------- src/Init.hs | 44 ++++++++++++++++++++++++++++------------- src/Main.hs | 5 +---- src/Types.hs | 3 --- 6 files changed, 75 insertions(+), 52 deletions(-) diff --git a/src/CommandBuffer.hs b/src/CommandBuffer.hs index 233b9c3..7769826 100644 --- a/src/CommandBuffer.hs +++ b/src/CommandBuffer.hs @@ -1,11 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} module CommandBuffer where +import qualified Control.Concurrent.STM as STM import Control.Monad import Control.Monad.IO.Class +import Control.Monad.Reader import Control.Monad.Trans.Resource +import qualified Data.Map.Strict as M import qualified Data.Vector as V import Foreign import Foreign.C.Types (CInt) @@ -61,15 +65,13 @@ createCommandBuffer logicalDevice commandPool number = do replicateM number (Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo) recordCommandBuffer - :: (MonadResource m) + :: (MonadResource m, MonadReader ReadState m, MonadIO m) => Vk.CommandBuffer -> Vk.RenderPass -> Vk.Framebuffer -> V2 CInt -> Vk.Pipeline -> Vk.PipelineLayout - -> Maybe Mesh - -> Int -> m () recordCommandBuffer commandBuffer @@ -78,8 +80,6 @@ recordCommandBuffer (V2 width height) graphicsPipeline meshLayout - mesh - frameNumber = do let commandBufferBeginInfo = Vk.zero @@ -131,20 +131,24 @@ recordCommandBuffer Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport) Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor) - liftIO $ maybe - (Vk.cmdDraw commandBuffer 3 1 0 0) - (\jmesh -> do + renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables + meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary + materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary + + V.mapM_ + (\(RenderObject meshID materialID modelMatrix) -> do + let camPosition = V3 0 0 (-5) camCenter = V3 0 0 0 camUp = V3 0 1 0 view = lookAt camPosition camCenter camUp projection = perspective (pi/4) (800 / 600) 0.1 200 - modelRot = axisAngle (V3 0 1 0) (fromIntegral frameNumber / (10 * pi)) - model = mkTransformation modelRot (V3 0 0 0) - pvm = projection !*! view !*! model + pvm = projection !*! view !*! modelMatrix constants = MeshPushConstants (V4 0 0 0 0) (transpose pvm) + mesh = meshMap M.! meshID + material = materialMap M.! materialID - pointer <- castPtr <$> new constants + pointer <- liftIO (castPtr <$> new constants) Vk.cmdPushConstants commandBuffer meshLayout @@ -156,12 +160,12 @@ recordCommandBuffer Vk.cmdBindVertexBuffers commandBuffer 0 - (V.fromList [ allocatedBuffer $ meshBuffer jmesh ]) + (V.fromList [ allocatedBuffer $ meshBuffer mesh ]) (V.fromList [ 0 ]) - Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices jmesh) 1 0 0 + Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 0 ) - mesh + renderObjects Vk.cmdEndRenderPass commandBuffer diff --git a/src/Draw.hs b/src/Draw.hs index 7ad0587..e5eb1a0 100644 --- a/src/Draw.hs +++ b/src/Draw.hs @@ -1,9 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} module Draw where +import qualified Control.Concurrent.STM as STM import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Reader import Control.Monad.Trans.Resource +import qualified Data.Map.Strict as M import qualified Data.Vector as V import qualified Vulkan.Core10 as Vk import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr @@ -16,11 +21,10 @@ import CommandBuffer import Types drawFrame - :: (MonadResource m, MonadFail m) + :: (MonadResource m, MonadFail m, MonadReader ReadState m) => EngineData - -> Int -> m () -drawFrame engineData frameNumber = do +drawFrame engineData = do unless (all (V.length (engineCommandBuffers engineData) ==) [ V.length (engineCommandBuffers engineData) @@ -51,16 +55,16 @@ drawFrame engineData frameNumber = do Vk.resetCommandBuffer (engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0) + matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary + -- liftIO $ putStrLn "recording command buffer" recordCommandBuffer (engineCommandBuffers engineData V.! fromIntegral index) (engineRenderPass engineData) (engineFramebuffers engineData V.! fromIntegral index) (engineWindowDimensions engineData) - (meshPipeline engineData V.! fromIntegral index) + (materialPipeline $ matLibrary M.! "defaultMesh") (meshPipelineLayout engineData) - (Just $ engineMesh engineData) - frameNumber let submitInfo = Vk.zero { Vk.waitSemaphores = diff --git a/src/GraphicsPipeline.hs b/src/GraphicsPipeline.hs index 13cbbeb..ac7dcb3 100644 --- a/src/GraphicsPipeline.hs +++ b/src/GraphicsPipeline.hs @@ -1,15 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} module GraphicsPipeline where import Linear -import Control.Monad (unless) -import Control.Monad.IO.Class (liftIO) +import qualified Control.Concurrent.STM as STM +import Control.Monad.Reader import Control.Monad.Trans.Resource import Data.Bits -- import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS +import qualified Data.Map.Strict as M import qualified Data.Vector as V import Foreign (sizeOf) import Foreign.C.Types (CInt) @@ -21,7 +23,6 @@ import qualified Vulkan.Utils.ShaderQQ.GLSL.Shaderc as Vk -- internal imports import Types -import Mesh loadShader :: (MonadResource m) @@ -194,24 +195,23 @@ createMultisampleStateCreateInfo = } createGraphicsPipelines - :: (MonadResource m) + :: (MonadResource m, MonadReader ReadState m) => Vk.Device -> Vk.RenderPass -> ShaderContainer -> V2 CInt - -> Int -> Vk.PipelineLayout -> Maybe Vk.PipelineDepthStencilStateCreateInfo - -> m (V.Vector Vk.Pipeline) + -> m () createGraphicsPipelines logicalDevice renderPass shaderContainer (V2 width height) - number pipelineLayout depthState = do + meshLib <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary let pipelineStagesCreateInfos = V.fromList $ map Vk.SomeStruct ( maybe @@ -242,7 +242,7 @@ createGraphicsPipelines pipelineDynamicStateCreateInfo = Vk.zero { Vk.dynamicStates = dynamicStates } - vertexDescription = getVertexDescription (V.head loadMeshes) + vertexDescription = getVertexDescription (V.head $ meshVertices $ meshLib M.! "mask") pipelineVertexInputCreateInfo = Vk.zero { Vk.vertexBindingDescriptions = vidBindings vertexDescription , Vk.vertexAttributeDescriptions = vidAttributes vertexDescription @@ -300,12 +300,12 @@ createGraphicsPipelines , Vk.basePipelineIndex = -1 } - snd <$> allocate + pipeline <- snd <$> allocate (do (result, pipelines) <- Vk.createGraphicsPipelines logicalDevice Vk.NULL_HANDLE - (V.replicate number (Vk.SomeStruct pipelineCreateInfo)) + (V.singleton (Vk.SomeStruct pipelineCreateInfo)) Nothing unless (result == Vk.SUCCESS) $ error "createGraphicsPipelines: Failed creating pipelines" @@ -319,6 +319,11 @@ createGraphicsPipelines ) pipelines ) + let material = Material (V.head pipeline) pipelineLayout + matLibraryTMVar <- asks materialLibrary + matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar + let newMatLibrary = M.insert "defaultMesh" material matLibrary + void $ liftIO $ STM.atomically $ STM.swapTMVar matLibraryTMVar newMatLibrary createPipelineLayout :: MonadResource m diff --git a/src/Init.hs b/src/Init.hs index f80232f..78d5a71 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -1,14 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} module Init where +import qualified Control.Concurrent.STM as STM import Control.Monad import Control.Monad.IO.Class +import Control.Monad.Reader import Control.Monad.Trans.Resource +import qualified Data.Vector as V import qualified SDL hiding (V2) import qualified SDL.Video.Vulkan as SDL import Foreign.Ptr +import Linear as L import qualified Vulkan.Core10 as Vk import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr import qualified Vulkan.Extensions.VK_KHR_surface as Khr @@ -77,8 +82,6 @@ initVulkan window = do allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance - maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator - dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window (swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator @@ -88,15 +91,13 @@ initVulkan window = do renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT meshLayout <- createMeshPipelineLayout vulkanLogicalDevice let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader) - meshPipelines <- - createGraphicsPipelines - vulkanLogicalDevice - renderPass - meshContainer - dimensions - (length imageViews) - meshLayout - (Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL)) + createGraphicsPipelines + vulkanLogicalDevice + renderPass + meshContainer + dimensions + meshLayout + (Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL)) frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions @@ -106,6 +107,10 @@ initVulkan window = do (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <- createSyncObjects vulkanLogicalDevice + loadMeshes allocator + + initScene + return $ EngineData window dimensions @@ -117,14 +122,25 @@ initVulkan window = do commandBuffer frameBuffers meshLayout - meshPipelines renderPass inFlightFence imageAvailableSemaphore renderFinishedSemaphore - maskMesh - maskMesh allocator depthImageView depthAllocatedImage Vk.FORMAT_D32_SFLOAT + +initScene :: (MonadReader ReadState m, MonadIO m) => m () +initScene = do + let mask = RenderObject + { objectMesh = "mask" + , objectMaterial = "defaultMesh" + , objectMatrix = identity + } + + renderableContainer <- asks renderables + renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer + + void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $ + renderableVector `V.snoc` mask diff --git a/src/Main.hs b/src/Main.hs index 65701bc..5cbed5b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,17 +39,14 @@ main = do -- create abort condition for upcoming lop quit <- liftIO $ STM.newTMVarIO True - frameContainer <- liftIO $ STM.newTMVarIO 0 -- main loop whileM_ (liftIO $ STM.atomically $ STM.readTMVar quit ) ( do - frameNumber <- liftIO $ STM.atomically $ STM.takeTMVar frameContainer - liftIO $ STM.atomically $ STM.putTMVar frameContainer (succ frameNumber) -- draw - drawFrame engineData frameNumber + drawFrame engineData -- poll events evs <- liftIO SDL.pollEvents -- flip abort condition on window close diff --git a/src/Types.hs b/src/Types.hs index 71ed74e..3e1410e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -34,13 +34,10 @@ data EngineData = EngineData , engineCommandBuffers :: V.Vector Vk.CommandBuffer , engineFramebuffers :: V.Vector Vk.Framebuffer , meshPipelineLayout :: Vk.PipelineLayout - , meshPipeline :: V.Vector Vk.Pipeline , engineRenderPass :: Vk.RenderPass , engineInFlightFence :: Vk.Fence , engineImageAvailableSemaphore :: Vk.Semaphore , engineRenderFinishedSemaphore :: Vk.Semaphore - , engineMesh :: Mesh - , engineExternalMesh :: Mesh , engineAllocator :: VMA.Allocator , engineDepthImageView :: Vk.ImageView , engineDepthImage :: AllocatedImage