9
9
{-# LANGUAGE MonoLocalBinds #-}
10
10
{-# LANGUAGE NamedFieldPuns #-}
11
11
{-# LANGUAGE OverloadedStrings #-}
12
+ {-# LANGUAGE PatternSynonyms #-}
12
13
{-# LANGUAGE RecordWildCards #-}
13
14
{-# LANGUAGE ScopedTypeVariables #-}
14
15
{-# LANGUAGE TypeApplications #-}
@@ -99,6 +100,7 @@ import qualified Data.Vector as Boxed.Vector
99
100
100
101
-- vulkan
101
102
import qualified Vulkan
103
+ import Vulkan.Core10.DeviceInitialization (pattern INSTANCE_CREATE_ENUMERATE_PORTABILITY_BIT_KHR )
102
104
import qualified Vulkan.CStruct.Extends as Vulkan
103
105
import qualified Vulkan.Requirement as Vulkan
104
106
import qualified Vulkan.Zero as Vulkan
@@ -156,9 +158,10 @@ data InstanceType
156
158
157
159
data VulkanRequirements =
158
160
VulkanRequirements
159
- { instanceRequirements :: [ Vulkan. InstanceRequirement ]
160
- , deviceRequirements :: [ Vulkan. DeviceRequirement ]
161
- , queueFlags :: Vulkan. QueueFlags
161
+ { instanceRequirements :: [ Vulkan. InstanceRequirement ]
162
+ , instanceRequirementsOpt :: [ Vulkan. InstanceRequirement ]
163
+ , deviceRequirements :: [ Vulkan. DeviceRequirement ]
164
+ , queueFlags :: Vulkan. QueueFlags
162
165
}
163
166
164
167
data ValidationLayerName
@@ -167,12 +170,12 @@ data ValidationLayerName
167
170
deriving stock ( Eq , Show )
168
171
169
172
initialiseVulkanContext :: MonadVulkan m => InstanceType -> ByteString -> VulkanRequirements -> m VulkanContext
170
- initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequirements, deviceRequirements, queueFlags } ) = do
173
+ initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequirements, instanceRequirementsOpt, deviceRequirements, queueFlags } ) = do
171
174
logDebug " Creating Vulkan instance"
172
175
instanceInfo <- vulkanInstanceInfo appName
173
176
instance' <- case instanceType of
174
- NormalInstance -> Vulkan.Utils. createInstanceFromRequirements instanceRequirements [] instanceInfo
175
- DebugInstance -> Vulkan.Utils. createDebugInstanceFromRequirements instanceRequirements [] instanceInfo
177
+ NormalInstance -> Vulkan.Utils. createInstanceFromRequirements instanceRequirements instanceRequirementsOpt instanceInfo
178
+ DebugInstance -> Vulkan.Utils. createDebugInstanceFromRequirements instanceRequirements instanceRequirementsOpt instanceInfo
176
179
physicalDevice <- logDebug " Creating physical device" *> createPhysicalDevice instance'
177
180
queueFamily <- logDebug " Finding suitable queue family" *> findQueueFamilyIndex physicalDevice queueFlags
178
181
let
@@ -236,7 +239,7 @@ vulkanInstanceInfo appName = do
236
239
createInfo =
237
240
Vulkan. InstanceCreateInfo
238
241
{ Vulkan. next = ()
239
- , Vulkan. flags = Vulkan. zero
242
+ , Vulkan. flags = INSTANCE_CREATE_ENUMERATE_PORTABILITY_BIT_KHR
240
243
, Vulkan. applicationInfo = Just appInfo
241
244
, Vulkan. enabledLayerNames = Boxed.Vector. fromList enabledLayers
242
245
, Vulkan. enabledExtensionNames = mempty
0 commit comments