starting coding the graphics pipeline. still incomplete

I like the sound of bricks bashing my head...

src/GraphicsPipeline.hs

@@ -0,0 +1,141 @@
+{-# 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"

vulkan-tutorial.cabal

@@ -27,6 +27,7 @@ executable vulkan-tutorial
     other-modules:    Init
                       Instance
                       Devices
+                      GraphicsPipeline
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions: