vulkan-tutorial/src/GraphicsPipeline.hs

142 lines
4.6 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module GraphicsPipeline where
import Linear
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import Foreign.C.Types (CInt)
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
loadShader
:: (MonadResource m)
=> Vk.Device
-> FilePath
-> m Vk.ShaderModule
loadShader logicalDevice shaderPath = do
shaderSource <- liftIO $ BS.readFile shaderPath
let createInfo = Vk.zero
{ Vk.code = shaderSource
}
snd <$> allocate
(Vk.createShaderModule logicalDevice createInfo Nothing)
(\shaderModule -> do
putStrLn "destroying shader module"
Vk.destroyShaderModule logicalDevice shaderModule Nothing
)
createGraphicsPipeline
:: (MonadResource m)
=> Vk.ShaderModule
-> Vk.ShaderModule
-> BS.ByteString
-> V2 CInt
-> Vk.Device
-> m Vk.Pipeline
createGraphicsPipeline
vertexShaderModule
fragmentShaderModule
stageName
(V2 width height)
logicalDevice
= do
let vertexShaderStageCreateInfo = Vk.zero
{ Vk.stage = Vk.SHADER_STAGE_VERTEX_BIT
, Vk.module' = vertexShaderModule
, Vk.name = stageName
}
fragmentShaderStageCreateInfo = Vk.zero
{ Vk.stage = Vk.SHADER_STAGE_FRAGMENT_BIT
, Vk.module' = fragmentShaderModule
, Vk.name = stageName
}
pipelineStagesCreateInfos =
V.fromList
[ vertexShaderStageCreateInfo
, fragmentShaderStageCreateInfo
]
dynamicStates =
V.fromList
[ Vk.DYNAMIC_STATE_VIEWPORT
, Vk.DYNAMIC_STATE_SCISSOR
]
dynamicStateCreateInfo = Vk.zero
{ Vk.dynamicStates = dynamicStates
}
vertexInputCreateInfo = Vk.zero
{ Vk.vertexBindingDescriptions = V.empty -- Fill me?
, Vk.vertexAttributeDescriptions = V.empty -- Fill me?
}
inputAssemblyStateCreateInfo = 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
}
multisamplingCreateInfo = 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
}
colorBlendStateCreateInfo = Vk.zero
{ Vk.logicOpEnable = False
, Vk.attachments = V.singleton colorBlendAttachment
}
pipelineLayoutCreateInfo = Vk.zero
pipelineLayout <- snd <$> allocate
(Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
(\pipelineLayout -> do
putStrLn "destroying pipeline layout"
Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
)
error "createGraphicsPipeline: implementation invomplete"