{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} module CommandBuffer where import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource import qualified Data.Vector as V import Foreign import Foreign.C.Types (CInt) import Linear import qualified Vulkan as Vk import qualified Vulkan.Zero as Vk -- internal imports import Devices import Types createCommandPool :: (MonadResource m) => Vk.PhysicalDevice -> Vk.Device -> m (Vk.CommandPool, Vk.Queue) createCommandPool physicalDevice logicalDevice = do queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT 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 commandPool <- snd <$> allocate (Vk.createCommandPool logicalDevice poolCreateInfo Nothing) (\commandPool -> do putStrLn "destroying command pool" Vk.destroyCommandPool logicalDevice commandPool Nothing ) return (commandPool, graphicsQueue) createCommandBuffer :: (MonadResource m) => Vk.Device -> Vk.CommandPool -> Int -> m (V.Vector Vk.CommandBuffer) createCommandBuffer logicalDevice commandPool number = do let commandBufferAllocationInfo = Vk.zero { Vk.commandPool = commandPool , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY , Vk.commandBufferCount = 1 } V.concat <$> replicateM number (Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo) recordCommandBuffer :: (MonadResource m) => Vk.CommandBuffer -> Vk.RenderPass -> Vk.Framebuffer -> V2 CInt -> Vk.Pipeline -> Vk.PipelineLayout -> Maybe Mesh -> Int -> m () recordCommandBuffer commandBuffer renderPass frameBuffer (V2 width height) graphicsPipeline meshLayout mesh 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) liftIO $ maybe (Vk.cmdDraw commandBuffer 3 1 0 0) (\jmesh -> 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 constants = MeshPushConstants (V4 0 0 0 0) (transpose pvm) pointer <- castPtr <$> new constants Vk.cmdPushConstants commandBuffer meshLayout Vk.SHADER_STAGE_VERTEX_BIT 0 (fromIntegral $ sizeOf constants) pointer Vk.cmdBindVertexBuffers commandBuffer 0 (V.fromList [ allocatedBuffer $ meshBuffer jmesh ]) (V.fromList [ 0 ]) Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices jmesh) 1 0 0 ) mesh Vk.cmdEndRenderPass commandBuffer Vk.endCommandBuffer commandBuffer createSyncObjects :: (MonadResource m, MonadFail m) => Vk.Device -> m (Vk.Semaphore, Vk.Semaphore, Vk.Fence) createSyncObjects logicalDevice = do let semaphoreCreateInfo = Vk.zero fenceCreateInfo = Vk.zero { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT } :: Vk.FenceCreateInfo '[] [imageAvailableSemaphore, renderFinishedSemaphore] <- replicateM 2 (snd <$> allocate (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing) (\semaphore -> do putStrLn "destroying semaphore" Vk.destroySemaphore logicalDevice semaphore Nothing ) ) inFlightFence <- snd <$> allocate (Vk.createFence logicalDevice fenceCreateInfo Nothing) (\fence -> do putStrLn "destroying fence" Vk.destroyFence logicalDevice fence Nothing ) return (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence)