final commit for now

sgillespie · Jun 3, 2023 · a3949d4 · a3949d4
1 parent 9957aad
commit a3949d4
Show file tree

Hide file tree

Showing 4 changed files with 82 additions and 4 deletions.
diff --git a/lib/Graphics/Seangine/Errors.hs b/lib/Graphics/Seangine/Errors.hs
@@ -7,6 +7,7 @@ data SeangineError
   | NoDeviceError
   | NoDepthFormatError
   | NoSurfaceFormatError
+  | NoSwapchainImages
   deriving (Typeable)
 
 instance Exception SeangineError
@@ -16,3 +17,4 @@ instance Show SeangineError where
   show NoDeviceError = "Can't find a suitable device!"
   show NoDepthFormatError = "Can't find a suitable depth format!"
   show NoSurfaceFormatError = "Can't find a surface format!"
+  show NoSwapchainImages = "Can't retrieve swapchain images!"
diff --git a/lib/Graphics/Seangine/Frame.hs b/lib/Graphics/Seangine/Frame.hs
@@ -3,17 +3,21 @@ module Graphics.Seangine.Frame
   ) where
 
 import Graphics.Seangine.Config.Frame
+import Graphics.Seangine.Config.VulkanHandles
+import Graphics.Seangine.Errors
 import Graphics.Seangine.Frame.DescriptorSets
 import Graphics.Seangine.Frame.FramesInFlight
-import Graphics.Seangine.Frame.SwapchainDetails (SwapchainDetails (..), withSwapchainDetails)
+import Graphics.Seangine.Frame.SwapchainDetails
 import Graphics.Seangine.GraphicsPipeline
 import Graphics.Seangine.Monad
 import Graphics.Seangine.Scene
 import Graphics.Seangine.Window
 
 import Control.Monad.Trans.Resource
+import Data.Traversable (for)
 import Data.Vector (Vector)
-import UnliftIO (getMonotonicTime)
+import UnliftIO (getMonotonicTime, throwIO)
+import Vulkan (getSwapchainImagesKHR)
 import Vulkan.Core10
 import Vulkan.Extensions.VK_KHR_surface (SurfaceKHR ())
 
@@ -66,7 +70,15 @@ withVulkanFrame window surface scene = do
       }
 
 withImageViews :: SwapchainDetails -> Vulkan (Vector ImageView)
-withImageViews = undefined
+withImageViews SwapchainDetails {..} = do
+  device <- getDevice
+
+  (res, images) <- getSwapchainImagesKHR device sdSwapchain
+  case res of
+    SUCCESS ->
+      for images $ \image ->
+        withImageView' image sdSurfaceFormat IMAGE_ASPECT_COLOR_BIT
+    _ -> throwIO NoSwapchainImages
 
 withDepthImageView :: SwapchainDetails -> Vulkan ImageView
 withDepthImageView = undefined

diff --git a/lib/Graphics/Seangine/Frame/DescriptorSets.hs b/lib/Graphics/Seangine/Frame/DescriptorSets.hs
@@ -3,14 +3,53 @@ module Graphics.Seangine.Frame.DescriptorSets
     withDescriptorSetLayouts',
   ) where
 
+import Graphics.Seangine.Config.VulkanHandles
 import Graphics.Seangine.Monad
 
+import Control.Monad.Trans.Resource
 import Vulkan.Core10
+import Vulkan.Zero
 
 data DescriptorSetLayouts = DescriptorSetLayouts
   { uniformBufferSetLayout :: DescriptorSetLayout,
     objectBufferSetLayout :: DescriptorSetLayout
   }
 
 withDescriptorSetLayouts' :: Vulkan DescriptorSetLayouts
-withDescriptorSetLayouts' = undefined
+withDescriptorSetLayouts' = do
+  let uniformLayoutCreateInfo =
+        zero
+          { bindings = [uniformLayoutBinding]
+          }
+
+      uniformLayoutBinding =
+        zero
+          { binding = 0,
+            descriptorType = DESCRIPTOR_TYPE_UNIFORM_BUFFER,
+            descriptorCount = 1,
+            stageFlags = SHADER_STAGE_VERTEX_BIT
+          }
+
+      objectLayoutCreateInfo =
+        zero
+          { bindings = [objectLayoutBinding]
+          }
+
+      objectLayoutBinding =
+        zero
+          { binding = 0,
+            descriptorType = DESCRIPTOR_TYPE_STORAGE_BUFFER,
+            descriptorCount = 1,
+            stageFlags = SHADER_STAGE_VERTEX_BIT
+          }
+
+  DescriptorSetLayouts
+    <$> withDescriptorSetLayout' uniformLayoutCreateInfo
+    <*> withDescriptorSetLayout' objectLayoutCreateInfo
+
+withDescriptorSetLayout'
+  :: DescriptorSetLayoutCreateInfo '[]
+  -> Vulkan DescriptorSetLayout
+withDescriptorSetLayout' createInfo = do
+  device <- getDevice
+  snd <$> withDescriptorSetLayout device createInfo Nothing allocate
diff --git a/lib/Graphics/Seangine/Frame/SwapchainDetails.hs b/lib/Graphics/Seangine/Frame/SwapchainDetails.hs
@@ -1,6 +1,7 @@
 module Graphics.Seangine.Frame.SwapchainDetails
   ( SwapchainDetails (..),
     withSwapchainDetails,
+    withImageView',
   ) where
 
 import Graphics.Seangine.Config.VulkanHandles
@@ -91,6 +92,30 @@ withSwapchainDetails window surface = do
         sdDepthFormat = depthFormat
       }
 
+withImageView' :: Image -> Format -> ImageAspectFlags -> Vulkan ImageView
+withImageView' image format flags = do
+  device <- getDevice
+
+  let createInfo =
+        zero
+          { image = image,
+            viewType = IMAGE_VIEW_TYPE_2D,
+            format = format,
+            components = zero,
+            subresourceRange = subresourceRange
+          }
+
+      subresourceRange =
+        zero
+          { aspectMask = flags,
+            baseMipLevel = 0,
+            levelCount = 1,
+            baseArrayLayer = 0,
+            layerCount = 1
+          }
+
+  snd <$> withImageView device createInfo Nothing allocate
+
 chooseSurfaceFormat :: Vector SurfaceFormatKHR -> Vulkan SurfaceFormatKHR
 chooseSurfaceFormat formats = maybe (throwIO NoSurfaceFormatError) pure maybeFormat
   where