diff --git a/src/Devices.hs b/src/Devices.hs index 8ebe0c0..865928f 100644 --- a/src/Devices.hs +++ b/src/Devices.hs @@ -9,6 +9,7 @@ import Control.Monad.Trans.Resource import qualified Data.Vector as V import Data.Maybe (fromMaybe, isNothing) import Data.Bits +import Data.Word (Word32) import Foreign.C.Types (CInt) import Linear import qualified Vulkan as Vk @@ -53,6 +54,32 @@ pickPhysicalDevice vkInstance = do return maxMemdiscretePhysDevice +getQueueFamily + :: (MonadResource m) + => Vk.PhysicalDevice + -> Vk.QueueFlagBits + -> m Word32 +getQueueFamily physicalDevice distinctBit = do + + queueFamilyProperties <- Vk.getPhysicalDeviceQueueFamilyProperties physicalDevice + + liftIO $ do + putStrLn "There are currently following queue families available" + print queueFamilyProperties + + let queueFamily = V.foldl + (\acc (index, qFamily) -> + if Vk.queueFlags qFamily .&. distinctBit /= zeroBits && isNothing acc + then Just index + else acc + ) + Nothing + (V.zip (V.fromList [0..]) queueFamilyProperties) + + return $ fromMaybe + (error "getQueueFamilies: The requested queueFamily doesn't seem to exist") + queueFamily + createLogicalDevice :: (MonadResource m) => Vk.PhysicalDevice @@ -60,28 +87,12 @@ createLogicalDevice -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR) createLogicalDevice physDevice surface = do - queueFamiliyProperties <- Vk.getPhysicalDeviceQueueFamilyProperties physDevice - - liftIO $ do - putStrLn "There are currently following queue families available" - print queueFamiliyProperties - - let graphicsQueueFamilies = V.foldl - (\acc (index, queueFamily) -> - if Vk.queueFlags queueFamily .&. Vk.QUEUE_GRAPHICS_BIT /= zeroBits && isNothing acc - then Just index - else acc - ) - Nothing - (V.zip (V.fromList [0..]) queueFamiliyProperties) + graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT let priorities = V.singleton 1 extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME queueCreateInfo = Vk.zero - { Vk.queueFamilyIndex = - fromMaybe - (error "createLogicalDevice: No suitable queu for graphics usage") - graphicsQueueFamilies + { Vk.queueFamilyIndex = graphicsQueueFamily , Vk.queuePriorities = priorities } deviceCreateInfo = Vk.zero diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal index 293589c..d99602b 100644 --- a/vulkan-tutorial.cabal +++ b/vulkan-tutorial.cabal @@ -29,6 +29,7 @@ executable vulkan-tutorial Devices GraphicsPipeline Framebuffers + CommandBuffer -- LANGUAGE extensions used by modules in this package. -- other-extensions: