add framebuffers

src/Framebuffers.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+module Framebuffers 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.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
+
+
+createFramebuffer
+  :: (MonadResource m)
+  => Vk.RenderPass
+  -> V.Vector Vk.ImageView
+  -> V2 CInt
+  -> Vk.Device
+  -> m Vk.Framebuffer
+createFramebuffer renderPass swapchainImageViews (V2 swapchainWidth swapcheinHeight) logicalDevice
+  = do
+
+    let framebufferCreateInfo = Vk.zero
+          { Vk.renderPass = renderPass
+          , Vk.attachments = swapchainImageViews
+          , Vk.width = fromIntegral swapchainWidth
+          , Vk.height = fromIntegral swapcheinHeight
+          , Vk.layers = 1
+          }
+
+    snd <$> allocate
+      (Vk.createFramebuffer logicalDevice framebufferCreateInfo Nothing)
+      (\framebuffer -> do
+        putStrLn "destroying framebuffer"
+        Vk.destroyFramebuffer logicalDevice framebuffer Nothing
+        )

src/GraphicsPipeline.hs

@@ -165,6 +165,7 @@ createGraphicsPipelines
           , Vk.subpasses    = V.singleton subpassDescriptor
           , Vk.dependencies = V.empty
           } :: Vk.RenderPassCreateInfo '[]
+
     pipelineRenderPass <- snd <$> allocate
       (Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
       (\renderPass -> do
@@ -175,7 +176,7 @@ createGraphicsPipelines
     let pipelineCreateInfo = Vk.zero
           { Vk.stageCount         = 2
           , Vk.stages             = pipelineStagesCreateInfos
-          , Vk.vertexInputState   = Nothing -- pipelineVertexInputCreateInfo
+          , Vk.vertexInputState   = Just $ Vk.SomeStruct pipelineVertexInputCreateInfo
           , Vk.inputAssemblyState = Just pipelineInputAssemblyStateCreateInfo
           , Vk.viewportState      = Just $ Vk.SomeStruct pipelineViewportStateCreateInfo
           , Vk.rasterizationState = Just $ Vk.SomeStruct pipelineRasterizationStateCreateInfo

vulkan-tutorial.cabal

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