I'm getting closer to actually draw…
This commit is contained in:
parent
cf53129c2f
commit
216879b97a
2 changed files with 30 additions and 18 deletions
|
@ -9,6 +9,7 @@ import Control.Monad.Trans.Resource
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Data.Maybe (fromMaybe, isNothing)
|
import Data.Maybe (fromMaybe, isNothing)
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
import Data.Word (Word32)
|
||||||
import Foreign.C.Types (CInt)
|
import Foreign.C.Types (CInt)
|
||||||
import Linear
|
import Linear
|
||||||
import qualified Vulkan as Vk
|
import qualified Vulkan as Vk
|
||||||
|
@ -53,6 +54,32 @@ pickPhysicalDevice vkInstance = do
|
||||||
|
|
||||||
return maxMemdiscretePhysDevice
|
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
|
createLogicalDevice
|
||||||
:: (MonadResource m)
|
:: (MonadResource m)
|
||||||
=> Vk.PhysicalDevice
|
=> Vk.PhysicalDevice
|
||||||
|
@ -60,28 +87,12 @@ createLogicalDevice
|
||||||
-> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR)
|
-> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR)
|
||||||
createLogicalDevice physDevice surface = do
|
createLogicalDevice physDevice surface = do
|
||||||
|
|
||||||
queueFamiliyProperties <- Vk.getPhysicalDeviceQueueFamilyProperties physDevice
|
graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
let priorities = V.singleton 1
|
let priorities = V.singleton 1
|
||||||
extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME
|
extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME
|
||||||
queueCreateInfo = Vk.zero
|
queueCreateInfo = Vk.zero
|
||||||
{ Vk.queueFamilyIndex =
|
{ Vk.queueFamilyIndex = graphicsQueueFamily
|
||||||
fromMaybe
|
|
||||||
(error "createLogicalDevice: No suitable queu for graphics usage")
|
|
||||||
graphicsQueueFamilies
|
|
||||||
, Vk.queuePriorities = priorities
|
, Vk.queuePriorities = priorities
|
||||||
}
|
}
|
||||||
deviceCreateInfo = Vk.zero
|
deviceCreateInfo = Vk.zero
|
||||||
|
|
|
@ -29,6 +29,7 @@ executable vulkan-tutorial
|
||||||
Devices
|
Devices
|
||||||
GraphicsPipeline
|
GraphicsPipeline
|
||||||
Framebuffers
|
Framebuffers
|
||||||
|
CommandBuffer
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
Loading…
Reference in a new issue