module Resource.Vulkan.DescriptorPool
( allocate
, allocateSetsFrom
) where
import RIO
import Data.Vector qualified as Vector
import UnliftIO.Resource (MonadResource, ReleaseKey)
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (zero)
import Engine.Vulkan.Types (MonadVulkan, getDevice)
import Resource.Vulkan.Named qualified as Named
allocate
:: ( MonadVulkan env m
, MonadResource m
)
=> Maybe Text
-> Word32
-> [(Vk.DescriptorType, Word32)]
-> m (ReleaseKey, Vk.DescriptorPool)
allocate :: forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Maybe Text
-> Word32
-> [(DescriptorType, Word32)]
-> m (ReleaseKey, DescriptorPool)
allocate Maybe Text
name Word32
maxSets [(DescriptorType, Word32)]
sizes = do
Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
(ReleaseKey, DescriptorPool)
res <- forall (a :: [*]) (io :: * -> *) r.
(Extendss DescriptorPoolCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> DescriptorPoolCreateInfo a
-> Maybe AllocationCallbacks
-> (io DescriptorPool -> (DescriptorPool -> io ()) -> r)
-> r
Vk.withDescriptorPool
Device
device
DescriptorPoolCreateInfo '[]
poolCI
forall a. Maybe a
Nothing
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
name forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
Named.object (forall a b. (a, b) -> b
snd (ReleaseKey, DescriptorPool)
res)
pure (ReleaseKey, DescriptorPool)
res
where
poolCI :: DescriptorPoolCreateInfo '[]
poolCI = forall a. Zero a => a
zero
{ $sel:maxSets:DescriptorPoolCreateInfo :: Word32
Vk.maxSets =
Word32
maxSets
, $sel:poolSizes:DescriptorPoolCreateInfo :: Vector DescriptorPoolSize
Vk.poolSizes =
forall a. [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DescriptorType -> Word32 -> DescriptorPoolSize
Vk.DescriptorPoolSize) [(DescriptorType, Word32)]
sizes
}
allocateSetsFrom
:: MonadVulkan env m
=> Vk.DescriptorPool
-> Maybe Text
-> Vector Vk.DescriptorSetLayout
-> m (Vector Vk.DescriptorSet)
allocateSetsFrom :: forall env (m :: * -> *).
MonadVulkan env m =>
DescriptorPool
-> Maybe Text
-> Vector DescriptorSetLayout
-> m (Vector DescriptorSet)
allocateSetsFrom DescriptorPool
pool Maybe Text
name Vector DescriptorSetLayout
layouts = do
Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
Vector DescriptorSet
descSets <- forall (a :: [*]) (io :: * -> *).
(Extendss DescriptorSetAllocateInfo a, PokeChain a, MonadIO io) =>
Device -> DescriptorSetAllocateInfo a -> io (Vector DescriptorSet)
Vk.allocateDescriptorSets Device
device forall a. Zero a => a
zero
{ $sel:descriptorPool:DescriptorSetAllocateInfo :: DescriptorPool
Vk.descriptorPool = DescriptorPool
pool
, $sel:setLayouts:DescriptorSetAllocateInfo :: Vector DescriptorSetLayout
Vk.setLayouts = Vector DescriptorSetLayout
layouts
}
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
name \Text
prefix ->
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
Vector.iforM_ Vector DescriptorSet
descSets \Int
ix DescriptorSet
ds ->
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
Named.object DescriptorSet
ds forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Text
prefix
, Text
"(set=", forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
ix), Text
")"
]
pure Vector DescriptorSet
descSets