add the module

This commit is contained in:
nek0 2022-07-13 19:29:38 +02:00
parent 216879b97a
commit a9715e1767

122
src/CommandBuffer.hs Normal file
View file

@ -0,0 +1,122 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module CommandBuffer where
import Control.Monad
import Control.Monad.Loops
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Bits
import qualified Data.Vector as V
import Data.Word
import Foreign.C.Types (CInt)
import Linear
import qualified SDL hiding (V2)
import qualified Control.Concurrent.STM as STM
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
-- internal imports
import Devices
import qualified Vulkan.Dynamic as Vk
createCommandPool
:: (MonadResource m)
=> Vk.PhysicalDevice
-> Vk.Device
-> m Vk.CommandPool
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
snd <$> allocate
(Vk.createCommandPool logicalDevice poolCreateInfo Nothing)
(\commandPool -> do
putStrLn "destroying comman pool"
Vk.destroyCommandPool logicalDevice commandPool Nothing
)
createCommandBuffer
:: (MonadResource m)
=> Vk.CommandPool
-> Vk.Device
-> m (V.Vector Vk.CommandBuffer)
createCommandBuffer commandPool logicalDevice = do
let commandBufferAllocationInfo = Vk.zero
{ Vk.commandPool = commandPool
, Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY
, Vk.commandBufferCount = 1
}
Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo
recordCommandBuffer
:: (MonadResource m)
=> Vk.CommandBuffer
-> Vk.RenderPass
-> Vk.Framebuffer
-> V2 CInt
-> Vk.Pipeline
-> m ()
recordCommandBuffer commandBuffer renderPass frameBuffer (V2 width height) graphicsPipeline = 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.singleton (Vk.Color $ Vk.Float32 0 0 0 1)
}
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 = 0
}
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)
Vk.cmdDraw commandBuffer 3 1 0 0
Vk.cmdEndRenderPass commandBuffer