graphics pipeline creation complete for now

src/GraphicsPipeline.hs

@@ -4,6 +4,7 @@
 module GraphicsPipeline where
 
 import Linear
+import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource
 import Data.Bits
@@ -12,6 +13,7 @@ import qualified Data.Vector as V
 import Foreign.C.Types (CInt)
 import qualified Vulkan as Vk
 import qualified Vulkan.Zero as Vk
+import qualified Vulkan.CStruct.Extends as Vk
 
 loadShader
   :: (MonadResource m)
@@ -32,19 +34,21 @@ loadShader logicalDevice shaderPath = do
       Vk.destroyShaderModule logicalDevice shaderModule Nothing
       )
 
-createGraphicsPipeline
+createGraphicsPipelines
   :: (MonadResource m)
   => Vk.ShaderModule
   -> Vk.ShaderModule
   -> BS.ByteString
   -> V2 CInt
+  -> Vk.Format
   -> Vk.Device
-  -> m Vk.Pipeline
-createGraphicsPipeline
+  -> m (V.Vector Vk.Pipeline)
+createGraphicsPipelines
   vertexShaderModule
   fragmentShaderModule
   stageName
   (V2 width height)
+  swapchainImageFormat
   logicalDevice
   = do
 
@@ -59,7 +63,7 @@ createGraphicsPipeline
           , Vk.name    = stageName
           }
         pipelineStagesCreateInfos =
-          V.fromList
+          V.fromList $ map Vk.SomeStruct
             [ vertexShaderStageCreateInfo
             , fragmentShaderStageCreateInfo
             ]
@@ -68,14 +72,14 @@ createGraphicsPipeline
             [ Vk.DYNAMIC_STATE_VIEWPORT
             , Vk.DYNAMIC_STATE_SCISSOR
             ]
-        dynamicStateCreateInfo = Vk.zero
+        pipelineDynamicStateCreateInfo = Vk.zero
           { Vk.dynamicStates = dynamicStates
           }
-        vertexInputCreateInfo = Vk.zero
+        pipelineVertexInputCreateInfo = Vk.zero
           { Vk.vertexBindingDescriptions   = V.empty -- Fill me?
           , Vk.vertexAttributeDescriptions = V.empty -- Fill me?
           }
-        inputAssemblyStateCreateInfo = Vk.zero
+        pipelineInputAssemblyStateCreateInfo = Vk.zero
           { Vk.topology               = Vk.PRIMITIVE_TOPOLOGY_TRIANGLE_LIST
           , Vk.primitiveRestartEnable = False
           }
@@ -107,7 +111,7 @@ createGraphicsPipeline
           , Vk.depthBiasClamp          = 0
           , Vk.depthBiasSlopeFactor    = 0
           }
-        multisamplingCreateInfo = Vk.zero
+        pipelineMultisamplingCreateInfo = Vk.zero
           { Vk.sampleShadingEnable  = False
           , Vk.rasterizationSamples = Vk.SAMPLE_COUNT_1_BIT
           }
@@ -125,7 +129,7 @@ createGraphicsPipeline
           , Vk.dstAlphaBlendFactor = Vk.BLEND_FACTOR_ZERO
           , Vk.alphaBlendOp        = Vk.BLEND_OP_ADD
           }
-        colorBlendStateCreateInfo = Vk.zero
+        pipelineColorBlendStateCreateInfo = Vk.zero
           { Vk.logicOpEnable = False
           , Vk.attachments = V.singleton colorBlendAttachment
           }
@@ -138,4 +142,69 @@ createGraphicsPipeline
         Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
         )
 
-    error "createGraphicsPipeline: implementation invomplete"
+    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
+          }
+        renderPassCreateInfo = Vk.zero
+          { Vk.attachments  = V.singleton colorAttachmentDescription
+          , Vk.subpasses    = V.singleton subpassDescriptor
+          , Vk.dependencies = V.empty
+          } :: Vk.RenderPassCreateInfo '[]
+    pipelineRenderPass <- snd <$> allocate
+      (Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
+      (\renderPass -> do
+        putStrLn "destroying render pass"
+        Vk.destroyRenderPass logicalDevice renderPass Nothing
+        )
+
+    let pipelineCreateInfo = Vk.zero
+          { Vk.stageCount         = 2
+          , Vk.stages             = pipelineStagesCreateInfos
+          , Vk.vertexInputState   = Nothing -- 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         = pipelineRenderPass
+          , Vk.subpass            = 0
+          , Vk.basePipelineHandle = Vk.NULL_HANDLE
+          , Vk.basePipelineIndex  = -1
+          }
+
+    snd <$> allocate
+      (do
+        (result, pipelines) <- Vk.createGraphicsPipelines
+          logicalDevice
+          Vk.NULL_HANDLE
+          (V.singleton (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
+        )