From 1ad7f8fbb4dcc4899665bbe49c1c4f732ea59587 Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 11 Jul 2022 13:14:59 +0200 Subject: [PATCH] trying to make implementation a little more flexible --- src/Devices.hs | 48 ++++++++++++++++++++++++++++++++++++++---------- src/Init.hs | 14 +++++++------- 2 files changed, 45 insertions(+), 17 deletions(-) diff --git a/src/Devices.hs b/src/Devices.hs index 91cd212..4ee20aa 100644 --- a/src/Devices.hs +++ b/src/Devices.hs @@ -4,6 +4,7 @@ module Devices where import Control.Monad +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import qualified Data.Vector as V import Foreign.C.Types (CInt) @@ -33,7 +34,7 @@ pickPhysicalDevice vkInstance = do Vk.geometryShader devFeatures ) devicesWithPropsAndFeatures - maxMemdiscretePhysDevice = (\(x, _, _) -> x) $ V.foldl + (maxMemdiscretePhysDevice, props,_ ) = V.foldl (\acc@(_, devProp1, _) ndev@(_, devProp2, _) -> let dimension = Vk.maxImageDimension2D . Vk.limits in @@ -44,13 +45,18 @@ pickPhysicalDevice vkInstance = do (V.head discretePhysDevices) discretePhysDevices + liftIO $ do + print ("picked the following device:" :: String) + print (Vk.deviceName props) + return maxMemdiscretePhysDevice createLogicalDevice :: (MonadResource m) => Vk.PhysicalDevice - -> m Vk.Device -createLogicalDevice physDevice = do + -> Vk.SurfaceKHR + -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR) +createLogicalDevice physDevice surface = do let priorities = V.singleton 1 extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME queueCreateInfo = Vk.zero @@ -69,15 +75,25 @@ createLogicalDevice physDevice = do Vk.destroyDevice logDevice Nothing ) - return logDevice + (result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface + unless (result == Vk.SUCCESS) $ + error "Failed retrieving surface image formats" + + return (logDevice, formats) createSwapchain :: (MonadResource m) => Vk.SurfaceKHR + -> V.Vector Vk.SurfaceFormatKHR -> V2 CInt -> Vk.Device -> m Vk.SwapchainKHR -createSwapchain surface windowDimension logicalDevice = do +createSwapchain surface surfaceFormats windowDimension logicalDevice = do + + liftIO $ do + print ("available formats:" :: String) + print surfaceFormats + let createInfo = Vk.zero { Vk.surface = surface , Vk.minImageCount = 4 @@ -89,7 +105,8 @@ createSwapchain surface windowDimension logicalDevice = do , Vk.imageUsage = Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT , Vk.presentMode = Vk.PRESENT_MODE_MAILBOX_KHR , Vk.preTransform = Vk.SURFACE_TRANSFORM_IDENTITY_BIT_KHR - , Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_INHERIT_BIT_KHR + , Vk.compositeAlpha = Vk.COMPOSITE_ALPHA_OPAQUE_BIT_KHR + , Vk.clipped = True } snd <$> allocate @@ -99,13 +116,24 @@ createSwapchain surface windowDimension logicalDevice = do Vk.destroySwapchainKHR logicalDevice swapchain Nothing ) -getImageHandles +getImageViewHandles :: (MonadResource m) => Vk.SwapchainKHR -> Vk.Device - -> m (V.Vector Vk.Image) -getImageHandles swapchain logicalDevice = do + -> m (V.Vector Vk.ImageView) +getImageViewHandles swapchain logicalDevice = do (result, handles) <- Vk.getSwapchainImagesKHR logicalDevice swapchain when (result /= Vk.SUCCESS) $ error "getImageHandles: Failed acquiring images from swapchain" - return handles + + imageViews <- V.mapM + (\image -> do + let createInfo = Vk.zero + { Vk.image = image + , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D + } + return () + ) + V.empty + + error "getImageHandles: Not yet implemented" diff --git a/src/Init.hs b/src/Init.hs index 4849ec9..f0aa3a7 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -28,7 +28,7 @@ import Devices initEngine :: MonadResource m - => m (SDL.Window, Vk.Instance, Vk.SurfaceKHR, Vk.SwapchainKHR, V.Vector Vk.Image) + => m (SDL.Window, Vk.Instance, Vk.SurfaceKHR, Vk.SwapchainKHR, V.Vector Vk.ImageView) initEngine = do -- initialize SDL2 with all subsystems void $ allocate_ @@ -62,14 +62,11 @@ initEngine = do initVulkan :: MonadResource m => SDL.Window - -> m (Vk.SurfaceKHR, Vk.Instance, Vk.SwapchainKHR, V.Vector Vk.Image) + -> m (Vk.SurfaceKHR, Vk.Instance, Vk.SwapchainKHR, V.Vector Vk.ImageView) initVulkan window = do vulkanInstance <- createInstance window - vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance - vulkanLogicalDevice <- createLogicalDevice vulkanPhysicalDevice - (_, vulkanSurface) <- allocate (Vk.SurfaceKHR <$> SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance)) @@ -79,8 +76,11 @@ initVulkan window = do Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing ) + vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance + (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface + dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window - swapchain <- createSwapchain vulkanSurface dimensions vulkanLogicalDevice - images <- getImageHandles swapchain vulkanLogicalDevice + swapchain <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice + images <- getImageViewHandles swapchain vulkanLogicalDevice return (vulkanSurface, vulkanInstance, swapchain, images)