{-# 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 hiding (void) import Foreign.C.Types (CInt) import Linear import qualified Vulkan as Vk import qualified Vulkan.CStruct.Extends as Vk import qualified Vulkan.Zero as Vk import qualified VulkanMemoryAllocator as VMA -- internal imports import Devices import Types import Memory import Util import Control.Exception (bracket, bracket_) frameOverlap :: Int frameOverlap = 2 maxObjects :: Int maxObjects = 10000 createFrames :: (MonadResource m, MonadFail m) => Vk.PhysicalDevice -> Vk.Device -> VMA.Allocator -> Vk.DescriptorPool -> Vk.DescriptorSetLayout -> Vk.DescriptorSetLayout -> m (V.Vector FrameData, Vk.Queue) createFrames physicalDevice logicalDevice allocator descriptorPool setLayout objectSetLayout = do queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT deviceProperties <- Vk.getPhysicalDeviceProperties physicalDevice let poolCreateInfo = Vk.zero { Vk.flags = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT , Vk.queueFamilyIndex = queueFamilyIndex } :: Vk.CommandPoolCreateInfo graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0 frames <- V.mapM (\index -> do commandPool <- snd <$> allocate (Vk.createCommandPool logicalDevice poolCreateInfo Nothing) (\commandPool -> do putStrLn "destroying command pool" Vk.destroyCommandPool logicalDevice commandPool Nothing ) let commandBufferAllocationInfo = Vk.zero { Vk.commandPool = commandPool , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY , Vk.commandBufferCount = 1 } commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo let semaphoreCreateInfo = Vk.zero fenceCreateInfo = Vk.zero { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT } :: Vk.FenceCreateInfo '[] [presentSemaphore, renderSemaphore] <- replicateM 2 (snd <$> allocate (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing) (\semaphore -> do putStrLn "destroying semaphore" Vk.destroySemaphore logicalDevice semaphore Nothing ) ) renderFence <- snd <$> allocate (Vk.createFence logicalDevice fenceCreateInfo Nothing) (\fence -> do putStrLn "destroying fence" Vk.destroyFence logicalDevice fence Nothing ) cameraBuffer <- createAllocatedBuffer allocator (sizeOf (GPUCameraData identity identity identity)) Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT VMA.MEMORY_USAGE_CPU_TO_GPU let sceneParamBufferSize = -- frameOverlap * fromIntegral (padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProperties) sceneBuffer <- createAllocatedBuffer allocator (sizeOf undefinedGPUSceneData * frameOverlap) Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT VMA.MEMORY_USAGE_CPU_TO_GPU objectBuffer <- createAllocatedBuffer allocator (sizeOf undefinedGPUObjectData * maxObjects) Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT VMA.MEMORY_USAGE_CPU_TO_GPU let allocationInfo = Vk.zero { Vk.descriptorPool = descriptorPool , Vk.setLayouts = V.singleton setLayout } objectSetAllocInfo = Vk.zero { Vk.descriptorPool = descriptorPool , Vk.setLayouts = V.singleton objectSetLayout } globalDescriptor <- Vk.allocateDescriptorSets logicalDevice allocationInfo objectDescriptor <- Vk.allocateDescriptorSets logicalDevice objectSetAllocInfo let cameraInfo = Vk.zero { Vk.buffer = allocatedBuffer cameraBuffer , Vk.offset = 0 , Vk.range = fromIntegral $ sizeOf (GPUCameraData identity identity identity) } :: Vk.DescriptorBufferInfo sceneInfo = Vk.zero { Vk.buffer = allocatedBuffer sceneBuffer , Vk.offset = 0 -- , Vk.offset = padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProperties * fromIntegral index , Vk.range = fromIntegral $ sizeOf undefinedGPUSceneData } :: Vk.DescriptorBufferInfo objectInfo = Vk.zero { Vk.buffer = allocatedBuffer objectBuffer , Vk.offset = 0 , Vk.range = fromIntegral $ sizeOf undefinedGPUObjectData * maxObjects } :: Vk.DescriptorBufferInfo cameraWrite = writeDescriptorBuffer Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER (V.head globalDescriptor) cameraInfo 0 sceneWrite = writeDescriptorBuffer Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC (V.head globalDescriptor) sceneInfo 1 objectWrite = writeDescriptorBuffer Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER (V.head objectDescriptor) objectInfo 0 setWrites = V.fromList [ cameraWrite , sceneWrite , objectWrite ] Vk.updateDescriptorSets logicalDevice setWrites V.empty return FrameData { framePresentSemaphore = presentSemaphore , frameRenderSemaphore = renderSemaphore , frameRenderFence = renderFence , frameCommandPool = commandPool , frameMainCommandBuffer = V.head commandBuffer , frameCameraBuffer = cameraBuffer , frameSceneBuffer = sceneBuffer , frameObjectBuffer = objectBuffer , frameGlobalDescriptor = V.head globalDescriptor , frameObjectDescriptor = V.head objectDescriptor } ) (V.fromList [1 .. frameOverlap]) return (frames, graphicsQueue) recordCommandBuffer :: (MonadResource m, MonadReader ReadState m, MonadIO m) => Vk.CommandBuffer -> Vk.RenderPass -> Vk.Framebuffer -> V2 CInt -> Vk.Pipeline -> Vk.PipelineLayout -> VMA.Allocator -> GPUSceneData -> AllocatedBuffer -> Vk.PhysicalDeviceProperties -> FrameData -> Int -> m () recordCommandBuffer commandBuffer renderPass frameBuffer (V2 width height) graphicsPipeline meshLayout allocator sceneParameters sceneParameterBuffer deviceProps frame frameNumber = do let commandBufferBeginInfo = Vk.zero { Vk.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT , Vk.inheritanceInfo = Nothing } Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo let renderPassInfo = Vk.zero { Vk.renderPass = renderPass , Vk.framebuffer = frameBuffer , Vk.renderArea = Vk.Rect2D { offset = Vk.Offset2D { Vk.x = 0 , Vk.y = 0 } , extent = Vk.Extent2D { Vk.width = fromIntegral width , Vk.height = fromIntegral height } } , Vk.clearValues = V.fromList [ Vk.Color (Vk.Float32 0 0 0 1), Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)] } Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline let viewport = Vk.zero { Vk.x = 0 , Vk.y = 0 , Vk.width = fromIntegral width , Vk.height = fromIntegral height , Vk.minDepth = 0 , Vk.maxDepth = 1 } scissor = Vk.Rect2D { Vk.offset = Vk.Offset2D { Vk.x = 0 , Vk.y = 0 } , Vk.extent = Vk.Extent2D { Vk.width = fromIntegral width , Vk.height = fromIntegral height } } Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport) Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor) let framed = fromIntegral frameNumber / 120 ambient = normalize $ V4 (sin framed) 0 (cos framed) 1 -- ambient = V4 1 0 1 1 ambientParams = sceneParameters { ambientColor = ambient } frameIndex = frameNumber `mod` frameOverlap sceneDataOffset = padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProps liftIO $ do -- VMA.withMappedMemory allocator (bufferAllocation (frameSceneBuffer frame)) bracket $ -- \scenePointer -> let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame)) -- dataPointer <- liftIO $ new scenePointer -- paramsPtr <- liftIO (new ambientParams) -- liftIO $ copyBytes -- (scenePointer `plusPtr` (fromIntegral sceneDataOffset * fromIntegral frameIndex)) -- paramsPtr -- (sizeOf undefinedGPUSceneData) liftIO $ poke (castPtr scenePointer) -- (castPtr scenePointer `plusPtr` -- (fromIntegral $ -- padUniformBufferSize (fromIntegral $ sizeOf (undefinedGPUSceneData)) deviceProps))-- * -- -- fromIntegral frameIndex)) ambientParams -- liftIO $ do -- test <- peek (castPtr scenePointer :: Ptr GPUSceneData) -- print test -- VMA.unmapMemory allocator (bufferAllocation sceneParameterBuffer) renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary V.mapM_ (\(index, RenderObject meshID materialID modelMatrix) -> do let camPosition = V3 (-10 * sin (fromIntegral frameNumber / 90)) (-2) (-10 * cos (fromIntegral frameNumber / 90)) camCenter = V3 0 0 0 camUp = V3 0 1 0 camView = lookAt camPosition camCenter camUp camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200 materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary let cameraData = GPUCameraData { view = transpose camView , projection = transpose camProjection , viewProjection = transpose $ camProjection !*! camView } constants = MeshPushConstants { meshPushData = V4 0 0 0 0 , meshRenderMatrix = transpose modelMatrix } mesh = meshMap M.! meshID material = materialMap M.! materialID liftIO $ VMA.withMappedMemory allocator (bufferAllocation $ frameCameraBuffer frame) bracket $ \memoryPointer -> liftIO $ poke (castPtr memoryPointer) cameraData -- VMA.unmapMemory allocator (bufferAllocation $ frameCameraBuffer frame) Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material) let uniformOffset = padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProps * fromIntegral frameIndex Vk.cmdBindDescriptorSets commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipelineLayout material) 0 (V.singleton $ frameGlobalDescriptor frame) V.empty -- (V.singleton $ fromIntegral uniformOffset) Vk.cmdBindDescriptorSets commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipelineLayout material) 1 (V.singleton $ frameObjectDescriptor frame) V.empty dataPointer <- liftIO (castPtr <$> new constants) Vk.cmdPushConstants commandBuffer (materialPipelineLayout material) Vk.SHADER_STAGE_VERTEX_BIT 0 (fromIntegral $ sizeOf constants) dataPointer Vk.cmdBindVertexBuffers commandBuffer 0 (V.fromList [ allocatedBuffer $ meshBuffer mesh ]) (V.fromList [ 0 ]) Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index ) (V.zip (V.fromList [0 ..]) renderObjects ) Vk.cmdEndRenderPass commandBuffer Vk.endCommandBuffer commandBuffer