I'm getting closer to actually draw…

This commit is contained in:
nek0 2022-07-13 19:25:10 +02:00
parent cf53129c2f
commit 216879b97a
2 changed files with 30 additions and 18 deletions

View file

@ -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

View file

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