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