257 lines
9 KiB
Haskell
257 lines
9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
module GraphicsPipeline where
|
|
|
|
import Linear
|
|
import Control.Monad (unless)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Trans.Resource
|
|
import Data.Bits
|
|
-- import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import qualified Data.Vector as V
|
|
import Foreign.C.Types (CInt)
|
|
import qualified Vulkan.Core10 as Vk
|
|
import qualified Vulkan.Zero as Vk
|
|
import qualified Vulkan.CStruct.Extends as Vk
|
|
import qualified Vulkan.Utils.ShaderQQ.GLSL.Shaderc as Vk
|
|
|
|
-- internal imports
|
|
import Types
|
|
|
|
loadShader
|
|
:: (MonadResource m)
|
|
=> Vk.Device
|
|
-> FilePath
|
|
-> String
|
|
-> m Vk.ShaderModule
|
|
loadShader logicalDevice shaderPath stage = do
|
|
shaderSource <- liftIO $ BS.readFile shaderPath
|
|
|
|
(warnings, eShader) <- Vk.compileShader Nothing Nothing stage (BS.unpack shaderSource)
|
|
unless (null warnings) $ liftIO $ do
|
|
putStrLn "loadShader: Shader compilation warnings:"
|
|
print warnings
|
|
shader <- either
|
|
(\errors -> do
|
|
error ("loadShader: Compilation errors:" <> "\n" <> show errors)
|
|
)
|
|
return
|
|
eShader
|
|
|
|
|
|
let createInfo = Vk.zero
|
|
{ Vk.code = shader
|
|
}
|
|
|
|
snd <$> allocate
|
|
(Vk.createShaderModule logicalDevice createInfo Nothing)
|
|
(\shaderModule -> do
|
|
putStrLn "destroying shader module"
|
|
Vk.destroyShaderModule logicalDevice shaderModule Nothing
|
|
)
|
|
|
|
createRenderPass
|
|
:: (MonadResource m)
|
|
=> Vk.Device
|
|
-> Vk.Format
|
|
-> m Vk.RenderPass
|
|
createRenderPass
|
|
logicalDevice
|
|
swapchainImageFormat
|
|
= do
|
|
|
|
|
|
|
|
let colorAttachmentDescription = (Vk.zero :: Vk.AttachmentDescription)
|
|
{ Vk.format = swapchainImageFormat
|
|
, Vk.samples = Vk.SAMPLE_COUNT_1_BIT
|
|
, Vk.loadOp = Vk.ATTACHMENT_LOAD_OP_CLEAR
|
|
, Vk.storeOp = Vk.ATTACHMENT_STORE_OP_STORE
|
|
, Vk.stencilLoadOp = Vk.ATTACHMENT_LOAD_OP_DONT_CARE
|
|
, Vk.stencilStoreOp = Vk.ATTACHMENT_STORE_OP_DONT_CARE
|
|
, Vk.initialLayout = Vk.IMAGE_LAYOUT_UNDEFINED
|
|
, Vk.finalLayout = Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
|
|
}
|
|
colorAttachmentReference = (Vk.zero :: Vk.AttachmentReference)
|
|
{ Vk.attachment = 0
|
|
, Vk.layout = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
|
|
}
|
|
subpassDescriptor = (Vk.zero :: Vk.SubpassDescription)
|
|
{ Vk.pipelineBindPoint = Vk.PIPELINE_BIND_POINT_GRAPHICS
|
|
, Vk.colorAttachments = V.singleton colorAttachmentReference
|
|
}
|
|
subpassDependency = Vk.zero
|
|
{ Vk.srcSubpass = Vk.SUBPASS_EXTERNAL
|
|
, Vk.dstSubpass = 0
|
|
, Vk.srcStageMask = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
|
|
, Vk.dstStageMask = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
|
|
, Vk.srcAccessMask = Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT
|
|
, Vk.dstAccessMask =
|
|
Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT
|
|
}
|
|
renderPassCreateInfo = Vk.zero
|
|
{ Vk.attachments = V.singleton colorAttachmentDescription
|
|
, Vk.subpasses = V.singleton subpassDescriptor
|
|
, Vk.dependencies = V.singleton subpassDependency
|
|
} :: Vk.RenderPassCreateInfo '[]
|
|
|
|
snd <$> allocate
|
|
(Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
|
|
(\renderPass -> do
|
|
putStrLn "destroying render pass"
|
|
Vk.destroyRenderPass logicalDevice renderPass Nothing
|
|
)
|
|
|
|
|
|
createGraphicsPipelines
|
|
:: (MonadResource m)
|
|
=> Vk.Device
|
|
-> Vk.RenderPass
|
|
-> ShaderContainer
|
|
-> BS.ByteString
|
|
-> V2 CInt
|
|
-> Int
|
|
-> Vk.PipelineLayout
|
|
-> m (V.Vector Vk.Pipeline)
|
|
createGraphicsPipelines
|
|
logicalDevice
|
|
renderPass
|
|
shaderContainer
|
|
stageName
|
|
(V2 width height)
|
|
number
|
|
pipelineLayout
|
|
= do
|
|
let vertexShaderStageCreateInfo = Vk.zero
|
|
{ Vk.stage = Vk.SHADER_STAGE_VERTEX_BIT
|
|
, Vk.module' = containedVertexShader shaderContainer
|
|
, Vk.name = stageName
|
|
}
|
|
fragmentShaderStageCreateInfo = Vk.zero
|
|
{ Vk.stage = Vk.SHADER_STAGE_FRAGMENT_BIT
|
|
, Vk.module' = containedFragmentShader shaderContainer
|
|
, Vk.name = stageName
|
|
}
|
|
pipelineStagesCreateInfos =
|
|
V.fromList $ map Vk.SomeStruct
|
|
[ vertexShaderStageCreateInfo
|
|
, fragmentShaderStageCreateInfo
|
|
]
|
|
dynamicStates =
|
|
V.fromList
|
|
[ Vk.DYNAMIC_STATE_VIEWPORT
|
|
, Vk.DYNAMIC_STATE_SCISSOR
|
|
]
|
|
pipelineDynamicStateCreateInfo = Vk.zero
|
|
{ Vk.dynamicStates = dynamicStates
|
|
}
|
|
pipelineVertexInputCreateInfo = Vk.zero
|
|
{ Vk.vertexBindingDescriptions = V.empty -- Fill me?
|
|
, Vk.vertexAttributeDescriptions = V.empty -- Fill me?
|
|
}
|
|
pipelineInputAssemblyStateCreateInfo = Vk.zero
|
|
{ Vk.topology = Vk.PRIMITIVE_TOPOLOGY_TRIANGLE_LIST
|
|
, Vk.primitiveRestartEnable = False
|
|
}
|
|
viewport = Vk.Viewport
|
|
{ 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 0 0
|
|
, Vk.extent = Vk.Extent2D (fromIntegral width) (fromIntegral height)
|
|
}
|
|
pipelineViewportStateCreateInfo = Vk.zero
|
|
{ Vk.viewports = V.singleton viewport
|
|
, Vk.scissors = V.singleton scissor
|
|
}
|
|
pipelineRasterizationStateCreateInfo = Vk.zero
|
|
{ Vk.depthClampEnable = False
|
|
, Vk.rasterizerDiscardEnable = False
|
|
, Vk.polygonMode = Vk.POLYGON_MODE_FILL
|
|
, Vk.lineWidth = 1
|
|
, Vk.cullMode = Vk.CULL_MODE_BACK_BIT
|
|
, Vk.frontFace = Vk.FRONT_FACE_CLOCKWISE
|
|
, Vk.depthBiasEnable = False
|
|
, Vk.depthBiasConstantFactor = 0
|
|
, Vk.depthBiasClamp = 0
|
|
, Vk.depthBiasSlopeFactor = 0
|
|
}
|
|
pipelineMultisamplingCreateInfo = Vk.zero
|
|
{ Vk.sampleShadingEnable = False
|
|
, Vk.rasterizationSamples = Vk.SAMPLE_COUNT_1_BIT
|
|
}
|
|
colorBlendAttachment = Vk.zero
|
|
{ Vk.colorWriteMask =
|
|
Vk.COLOR_COMPONENT_R_BIT .|.
|
|
Vk.COLOR_COMPONENT_G_BIT .|.
|
|
Vk.COLOR_COMPONENT_B_BIT .|.
|
|
Vk.COLOR_COMPONENT_A_BIT
|
|
, Vk.blendEnable = True
|
|
, Vk.srcColorBlendFactor = Vk.BLEND_FACTOR_ONE
|
|
, Vk.dstColorBlendFactor = Vk.BLEND_FACTOR_ONE_MINUS_SRC_ALPHA
|
|
, Vk.colorBlendOp = Vk.BLEND_OP_ADD
|
|
, Vk.srcAlphaBlendFactor = Vk.BLEND_FACTOR_ONE
|
|
, Vk.dstAlphaBlendFactor = Vk.BLEND_FACTOR_ZERO
|
|
, Vk.alphaBlendOp = Vk.BLEND_OP_ADD
|
|
}
|
|
pipelineColorBlendStateCreateInfo = Vk.zero
|
|
{ Vk.logicOpEnable = False
|
|
, Vk.attachments = V.singleton colorBlendAttachment
|
|
}
|
|
pipelineCreateInfo = Vk.zero
|
|
{ Vk.stageCount = 2
|
|
, Vk.stages = pipelineStagesCreateInfos
|
|
, Vk.vertexInputState = Just $ Vk.SomeStruct pipelineVertexInputCreateInfo
|
|
, Vk.inputAssemblyState = Just pipelineInputAssemblyStateCreateInfo
|
|
, Vk.viewportState = Just $ Vk.SomeStruct pipelineViewportStateCreateInfo
|
|
, Vk.rasterizationState = Just $ Vk.SomeStruct pipelineRasterizationStateCreateInfo
|
|
, Vk.multisampleState = Just $ Vk.SomeStruct pipelineMultisamplingCreateInfo
|
|
, Vk.colorBlendState = Just $ Vk.SomeStruct pipelineColorBlendStateCreateInfo
|
|
, Vk.dynamicState = Just pipelineDynamicStateCreateInfo
|
|
, Vk.layout = pipelineLayout
|
|
, Vk.renderPass = renderPass
|
|
, Vk.subpass = 0
|
|
, Vk.basePipelineHandle = Vk.NULL_HANDLE
|
|
, Vk.basePipelineIndex = -1
|
|
}
|
|
|
|
snd <$> allocate
|
|
(do
|
|
(result, pipelines) <- Vk.createGraphicsPipelines
|
|
logicalDevice
|
|
Vk.NULL_HANDLE
|
|
(V.replicate number (Vk.SomeStruct pipelineCreateInfo))
|
|
Nothing
|
|
unless (result == Vk.SUCCESS) $
|
|
error "createGraphicsPiepelines: Failed creating pipelines"
|
|
return pipelines
|
|
)
|
|
(\pipelines -> do
|
|
V.mapM_
|
|
(\pipeline -> do
|
|
putStrLn "destroying pipeline"
|
|
Vk.destroyPipeline logicalDevice pipeline Nothing
|
|
)
|
|
pipelines
|
|
)
|
|
|
|
createPipelineLayout
|
|
:: MonadResource m
|
|
=> Vk.Device
|
|
-> m Vk.PipelineLayout
|
|
createPipelineLayout logicalDevice = do
|
|
let pipelineLayoutCreateInfo = Vk.zero
|
|
|
|
snd <$> allocate
|
|
(Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
|
|
(\pipelineLayout -> do
|
|
putStrLn "destroying pipeline layout"
|
|
Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
|
|
)
|