{-# LANGUAGE CPP #-}

module Engine.Setup where

import RIO

import UnliftIO.Resource (MonadResource)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.Extensions.VK_EXT_debug_utils qualified as Ext
import Vulkan.Extensions.VK_KHR_get_physical_device_properties2 qualified as Khr
import Vulkan.Extensions.VK_KHR_surface qualified as Khr
import Vulkan.Requirement (InstanceRequirement(..))
import Vulkan.Utils.Initialization (createInstanceFromRequirements)
import Vulkan.Utils.QueueAssignment (QueueFamilyIndex(..))
import Vulkan.Zero (zero)
import VulkanMemoryAllocator qualified as VMA

#if MIN_VERSION_vulkan(3,15,0)
import Foreign.Ptr (castFunPtr)
import Vulkan.Dynamic qualified as VkDynamic
#endif

import Engine.Setup.Device (allocatePhysical, allocateLogical)
import Engine.Setup.Window qualified as Window
import Engine.Types (GlobalHandles(..))
import Engine.Types.Options (Options(..))
import Engine.Vulkan.Swapchain (SwapchainResources)
import Engine.Vulkan.Types (PhysicalDeviceInfo(..), Queues)
import Engine.Worker qualified as Worker
import Engine.StageSwitch (newStageSwitchVar)

setup
  :: ( HasLogFunc env
     , MonadResource (RIO env)
     )
  => Options -> RIO env (GlobalHandles, Maybe SwapchainResources)
setup :: forall env.
(HasLogFunc env, MonadResource (RIO env)) =>
Options -> RIO env (GlobalHandles, Maybe SwapchainResources)
setup Options
ghOptions = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Options -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Options
ghOptions

  ([InstanceRequirement]
windowReqs, Window
ghWindow) <- Bool
-> Natural
-> SizePicker
-> Text
-> RIO env ([InstanceRequirement], Window)
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 MonadResource m) =>
Bool
-> Natural
-> SizePicker
-> Text
-> m ([InstanceRequirement], Window)
Window.allocate
    (Options -> Bool
optionsFullscreen Options
ghOptions)
    (Options -> Natural
optionsDisplay Options
ghOptions)
    SizePicker
Window.pickLargest
    Text
"Keid Engine"

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating instance"
  Instance
ghInstance <- [InstanceRequirement]
-> [InstanceRequirement]
-> InstanceCreateInfo '[]
-> RIO env Instance
forall (m :: * -> *) (es :: [*]).
(MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) =>
[InstanceRequirement]
-> [InstanceRequirement] -> InstanceCreateInfo es -> m Instance
createInstanceFromRequirements
    (InstanceRequirement
deviceProps InstanceRequirement
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. a -> [a] -> [a]
: InstanceRequirement
debugUtils InstanceRequirement
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. a -> [a] -> [a]
: [InstanceRequirement]
windowReqs)
    [InstanceRequirement]
forall a. Monoid a => a
mempty
    InstanceCreateInfo '[]
forall a. Zero a => a
zero

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating surface"
  (ReleaseKey
_surfaceKey, SurfaceKHR
ghSurface) <- Window -> Instance -> RIO env (ReleaseKey, SurfaceKHR)
forall (m :: * -> *).
MonadResource m =>
Window -> Instance -> m (ReleaseKey, SurfaceKHR)
Window.allocateSurface Window
ghWindow Instance
ghInstance

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating physical device"
  (PhysicalDeviceInfo
ghPhysicalDeviceInfo, PhysicalDevice
ghPhysicalDevice) <- Instance
-> Maybe SurfaceKHR
-> (PhysicalDeviceInfo -> Word64)
-> RIO env (PhysicalDeviceInfo, PhysicalDevice)
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadThrow m, MonadReader env m, HasLogFunc env,
 MonadResource m) =>
Instance
-> Maybe SurfaceKHR
-> (PhysicalDeviceInfo -> Word64)
-> m (PhysicalDeviceInfo, PhysicalDevice)
allocatePhysical
    Instance
ghInstance
    (SurfaceKHR -> Maybe SurfaceKHR
forall a. a -> Maybe a
Just SurfaceKHR
ghSurface)
    PhysicalDeviceInfo -> Word64
pdiTotalMemory

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating logical device"
  Device
ghDevice <- PhysicalDeviceInfo -> PhysicalDevice -> RIO env Device
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 MonadResource m) =>
PhysicalDeviceInfo -> PhysicalDevice -> m Device
allocateLogical PhysicalDeviceInfo
ghPhysicalDeviceInfo PhysicalDevice
ghPhysicalDevice

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating VMA"
  let
    allocatorCI :: VMA.AllocatorCreateInfo
    allocatorCI :: AllocatorCreateInfo
allocatorCI = AllocatorCreateInfo
forall a. Zero a => a
zero
      { $sel:physicalDevice:AllocatorCreateInfo :: Ptr PhysicalDevice_T
VMA.physicalDevice  = PhysicalDevice -> Ptr PhysicalDevice_T
Vk.physicalDeviceHandle PhysicalDevice
ghPhysicalDevice
      , $sel:device:AllocatorCreateInfo :: Ptr Device_T
VMA.device          = Device -> Ptr Device_T
Vk.deviceHandle Device
ghDevice
      , $sel:instance':AllocatorCreateInfo :: Ptr Instance_T
VMA.instance'       = Instance -> Ptr Instance_T
Vk.instanceHandle Instance
ghInstance
      , $sel:vulkanFunctions:AllocatorCreateInfo :: Maybe VulkanFunctions
VMA.vulkanFunctions = VulkanFunctions -> Maybe VulkanFunctions
forall a. a -> Maybe a
Just (VulkanFunctions -> Maybe VulkanFunctions)
-> VulkanFunctions -> Maybe VulkanFunctions
forall a b. (a -> b) -> a -> b
$ Device -> Instance -> VulkanFunctions
vmaVulkanFunctions Device
ghDevice Instance
ghInstance
      }
  (ReleaseKey
_vmaKey, Allocator
ghAllocator) <- AllocatorCreateInfo
-> (IO Allocator
    -> (Allocator -> IO ()) -> RIO env (ReleaseKey, Allocator))
-> RIO env (ReleaseKey, Allocator)
forall (io :: * -> *) r.
MonadIO io =>
AllocatorCreateInfo
-> (io Allocator -> (Allocator -> io ()) -> r) -> r
VMA.withAllocator AllocatorCreateInfo
allocatorCI IO Allocator
-> (Allocator -> IO ()) -> RIO env (ReleaseKey, Allocator)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
  RIO env () -> RIO env (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Releasing VMA") RIO env (IO ())
-> (IO () -> RIO env ReleaseKey) -> RIO env ReleaseKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> RIO env ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register

  Queues (QueueFamilyIndex, Queue)
ghQueues <- IO (Queues (QueueFamilyIndex, Queue))
-> RIO env (Queues (QueueFamilyIndex, Queue))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Queues (QueueFamilyIndex, Queue))
 -> RIO env (Queues (QueueFamilyIndex, Queue)))
-> IO (Queues (QueueFamilyIndex, Queue))
-> RIO env (Queues (QueueFamilyIndex, Queue))
forall a b. (a -> b) -> a -> b
$ PhysicalDeviceInfo
-> Device -> IO (Queues (QueueFamilyIndex, Queue))
pdiGetQueues PhysicalDeviceInfo
ghPhysicalDeviceInfo Device
ghDevice
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Got command queues: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Queues Word32 -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (((QueueFamilyIndex, Queue) -> Word32)
-> Queues (QueueFamilyIndex, Queue) -> Queues Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueueFamilyIndex -> Word32
unQueueFamilyIndex (QueueFamilyIndex -> Word32)
-> ((QueueFamilyIndex, Queue) -> QueueFamilyIndex)
-> (QueueFamilyIndex, Queue)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueueFamilyIndex, Queue) -> QueueFamilyIndex
forall a b. (a, b) -> a
fst) Queues (QueueFamilyIndex, Queue)
ghQueues)

  Extent2D
screen <- IO Extent2D -> RIO env Extent2D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Extent2D -> RIO env Extent2D)
-> IO Extent2D -> RIO env Extent2D
forall a b. (a -> b) -> a -> b
$ Window -> IO Extent2D
Window.getExtent2D Window
ghWindow
  Var Extent2D
ghScreenVar <- Extent2D -> RIO env (Var Extent2D)
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Extent2D
screen

  StageSwitchVar
ghStageSwitch <- RIO env StageSwitchVar
forall (m :: * -> *). MonadIO m => m StageSwitchVar
newStageSwitchVar

  pure (GlobalHandles :: Options
-> Window
-> SurfaceKHR
-> Instance
-> PhysicalDevice
-> PhysicalDeviceInfo
-> Device
-> Allocator
-> Queues (QueueFamilyIndex, Queue)
-> Var Extent2D
-> StageSwitchVar
-> GlobalHandles
GlobalHandles{Var Extent2D
StageSwitchVar
Window
Device
Instance
PhysicalDevice
SurfaceKHR
Allocator
PhysicalDeviceInfo
Queues (QueueFamilyIndex, Queue)
Options
$sel:ghStageSwitch:GlobalHandles :: StageSwitchVar
$sel:ghScreenVar:GlobalHandles :: Var Extent2D
$sel:ghQueues:GlobalHandles :: Queues (QueueFamilyIndex, Queue)
$sel:ghAllocator:GlobalHandles :: Allocator
$sel:ghDevice:GlobalHandles :: Device
$sel:ghPhysicalDeviceInfo:GlobalHandles :: PhysicalDeviceInfo
$sel:ghPhysicalDevice:GlobalHandles :: PhysicalDevice
$sel:ghInstance:GlobalHandles :: Instance
$sel:ghSurface:GlobalHandles :: SurfaceKHR
$sel:ghWindow:GlobalHandles :: Window
$sel:ghOptions:GlobalHandles :: Options
ghStageSwitch :: StageSwitchVar
ghScreenVar :: Var Extent2D
ghQueues :: Queues (QueueFamilyIndex, Queue)
ghAllocator :: Allocator
ghDevice :: Device
ghPhysicalDevice :: PhysicalDevice
ghPhysicalDeviceInfo :: PhysicalDeviceInfo
ghSurface :: SurfaceKHR
ghInstance :: Instance
ghWindow :: Window
ghOptions :: Options
..}, Maybe SwapchainResources
forall a. Maybe a
Nothing)

vmaVulkanFunctions
  :: Vk.Device
  -> Vk.Instance
  -> VMA.VulkanFunctions
#if MIN_VERSION_vulkan(3,15,0)
vmaVulkanFunctions :: Device -> Instance -> VulkanFunctions
vmaVulkanFunctions Vk.Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} Vk.Instance{InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} =
  VulkanFunctions
forall a. Zero a => a
zero
    { $sel:vkGetInstanceProcAddr:VulkanFunctions :: PFN_vkGetInstanceProcAddr
VMA.vkGetInstanceProcAddr =
        FunPtr
  (Ptr Instance_T
   -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> PFN_vkGetInstanceProcAddr
forall a b. FunPtr a -> FunPtr b
castFunPtr (FunPtr
   (Ptr Instance_T
    -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
 -> PFN_vkGetInstanceProcAddr)
-> FunPtr
     (Ptr Instance_T
      -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> PFN_vkGetInstanceProcAddr
forall a b. (a -> b) -> a -> b
$ InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
VkDynamic.pVkGetInstanceProcAddr InstanceCmds
instanceCmds
    , $sel:vkGetDeviceProcAddr:VulkanFunctions :: PFN_vkGetDeviceProcAddr
VMA.vkGetDeviceProcAddr =
        FunPtr
  (Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> PFN_vkGetDeviceProcAddr
forall a b. FunPtr a -> FunPtr b
castFunPtr (FunPtr
   (Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
 -> PFN_vkGetDeviceProcAddr)
-> FunPtr
     (Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> PFN_vkGetDeviceProcAddr
forall a b. (a -> b) -> a -> b
$ DeviceCmds
-> FunPtr
     (Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
VkDynamic.pVkGetDeviceProcAddr DeviceCmds
deviceCmds
    }
#else
vmaVulkanFunctions _device _instance = zero
#endif

setupHeadless
  :: ( HasLogFunc env
     , MonadResource (RIO env)
     )
  => Options
  -> RIO env Headless
setupHeadless :: forall env.
(HasLogFunc env, MonadResource (RIO env)) =>
Options -> RIO env Headless
setupHeadless Options
opts = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Options -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Options
opts

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating instance"
  Instance
ghInstance <- [InstanceRequirement]
-> [InstanceRequirement]
-> InstanceCreateInfo '[]
-> RIO env Instance
forall (m :: * -> *) (es :: [*]).
(MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) =>
[InstanceRequirement]
-> [InstanceRequirement] -> InstanceCreateInfo es -> m Instance
createInstanceFromRequirements
    (InstanceRequirement
deviceProps InstanceRequirement
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. a -> [a] -> [a]
: InstanceRequirement
debugUtils InstanceRequirement
-> [InstanceRequirement] -> [InstanceRequirement]
forall a. a -> [a] -> [a]
: [InstanceRequirement]
headlessReqs)
    [InstanceRequirement]
forall a. Monoid a => a
mempty
    InstanceCreateInfo '[]
forall a. Zero a => a
zero

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating physical device"
  (PhysicalDeviceInfo
ghPhysicalDeviceInfo, PhysicalDevice
ghPhysicalDevice) <- Instance
-> Maybe SurfaceKHR
-> (PhysicalDeviceInfo -> Word64)
-> RIO env (PhysicalDeviceInfo, PhysicalDevice)
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadThrow m, MonadReader env m, HasLogFunc env,
 MonadResource m) =>
Instance
-> Maybe SurfaceKHR
-> (PhysicalDeviceInfo -> Word64)
-> m (PhysicalDeviceInfo, PhysicalDevice)
allocatePhysical
    Instance
ghInstance
    Maybe SurfaceKHR
forall a. Maybe a
Nothing
    PhysicalDeviceInfo -> Word64
pdiTotalMemory

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating logical device"
  Device
ghDevice <- PhysicalDeviceInfo -> PhysicalDevice -> RIO env Device
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 MonadResource m) =>
PhysicalDeviceInfo -> PhysicalDevice -> m Device
allocateLogical PhysicalDeviceInfo
ghPhysicalDeviceInfo PhysicalDevice
ghPhysicalDevice

  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating VMA"
  let
    allocatorCI :: VMA.AllocatorCreateInfo
    allocatorCI :: AllocatorCreateInfo
allocatorCI = AllocatorCreateInfo
forall a. Zero a => a
zero
      { $sel:physicalDevice:AllocatorCreateInfo :: Ptr PhysicalDevice_T
VMA.physicalDevice  = PhysicalDevice -> Ptr PhysicalDevice_T
Vk.physicalDeviceHandle PhysicalDevice
ghPhysicalDevice
      , $sel:device:AllocatorCreateInfo :: Ptr Device_T
VMA.device          = Device -> Ptr Device_T
Vk.deviceHandle Device
ghDevice
      , $sel:instance':AllocatorCreateInfo :: Ptr Instance_T
VMA.instance'       = Instance -> Ptr Instance_T
Vk.instanceHandle Instance
ghInstance
      , $sel:vulkanFunctions:AllocatorCreateInfo :: Maybe VulkanFunctions
VMA.vulkanFunctions = VulkanFunctions -> Maybe VulkanFunctions
forall a. a -> Maybe a
Just (VulkanFunctions -> Maybe VulkanFunctions)
-> VulkanFunctions -> Maybe VulkanFunctions
forall a b. (a -> b) -> a -> b
$ Device -> Instance -> VulkanFunctions
vmaVulkanFunctions Device
ghDevice Instance
ghInstance
      }
  (ReleaseKey
_vmaKey, Allocator
ghAllocator) <- AllocatorCreateInfo
-> (IO Allocator
    -> (Allocator -> IO ()) -> RIO env (ReleaseKey, Allocator))
-> RIO env (ReleaseKey, Allocator)
forall (io :: * -> *) r.
MonadIO io =>
AllocatorCreateInfo
-> (io Allocator -> (Allocator -> io ()) -> r) -> r
VMA.withAllocator AllocatorCreateInfo
allocatorCI IO Allocator
-> (Allocator -> IO ()) -> RIO env (ReleaseKey, Allocator)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
  RIO env () -> RIO env (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Releasing VMA") RIO env (IO ())
-> (IO () -> RIO env ReleaseKey) -> RIO env ReleaseKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> RIO env ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register

  Queues (QueueFamilyIndex, Queue)
ghQueues <- IO (Queues (QueueFamilyIndex, Queue))
-> RIO env (Queues (QueueFamilyIndex, Queue))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Queues (QueueFamilyIndex, Queue))
 -> RIO env (Queues (QueueFamilyIndex, Queue)))
-> IO (Queues (QueueFamilyIndex, Queue))
-> RIO env (Queues (QueueFamilyIndex, Queue))
forall a b. (a -> b) -> a -> b
$ PhysicalDeviceInfo
-> Device -> IO (Queues (QueueFamilyIndex, Queue))
pdiGetQueues PhysicalDeviceInfo
ghPhysicalDeviceInfo Device
ghDevice
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Got command queues: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Queues Word32 -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (((QueueFamilyIndex, Queue) -> Word32)
-> Queues (QueueFamilyIndex, Queue) -> Queues Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueueFamilyIndex -> Word32
unQueueFamilyIndex (QueueFamilyIndex -> Word32)
-> ((QueueFamilyIndex, Queue) -> QueueFamilyIndex)
-> (QueueFamilyIndex, Queue)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueueFamilyIndex, Queue) -> QueueFamilyIndex
forall a b. (a, b) -> a
fst) Queues (QueueFamilyIndex, Queue)
ghQueues)

  pure (Instance
ghInstance, PhysicalDeviceInfo
ghPhysicalDeviceInfo, PhysicalDevice
ghPhysicalDevice, Device
ghDevice, Allocator
ghAllocator, Queues (QueueFamilyIndex, Queue)
ghQueues)

type Headless =
  ( Vk.Instance
  , PhysicalDeviceInfo
  , Vk.PhysicalDevice
  , Vk.Device
  , VMA.Allocator
  , Queues (QueueFamilyIndex, Vk.Queue)
  )

deviceProps :: InstanceRequirement
deviceProps :: InstanceRequirement
deviceProps = Maybe ByteString -> ByteString -> Word32 -> InstanceRequirement
RequireInstanceExtension
  Maybe ByteString
forall a. Maybe a
Nothing
  ByteString
forall a. (Eq a, IsString a) => a
Khr.KHR_GET_PHYSICAL_DEVICE_PROPERTIES_2_EXTENSION_NAME
  Word32
forall a. Bounded a => a
minBound

debugUtils :: InstanceRequirement
debugUtils :: InstanceRequirement
debugUtils = Maybe ByteString -> ByteString -> Word32 -> InstanceRequirement
RequireInstanceExtension
  Maybe ByteString
forall a. Maybe a
Nothing
  ByteString
forall a. (Eq a, IsString a) => a
Ext.EXT_DEBUG_UTILS_EXTENSION_NAME
  Word32
forall a. Bounded a => a
minBound

headlessReqs :: [InstanceRequirement]
headlessReqs :: [InstanceRequirement]
headlessReqs =
  [ Maybe ByteString -> ByteString -> Word32 -> InstanceRequirement
RequireInstanceExtension
      Maybe ByteString
forall a. Maybe a
Nothing
      ByteString
forall a. (Eq a, IsString a) => a
Khr.KHR_SURFACE_EXTENSION_NAME
      Word32
forall a. Bounded a => a
minBound
  ]