{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}
{-# LANGUAGE OverloadedLists #-}
module Render.DescSets.Set0
( Scene(..)
, emptyScene
, allocate
, allocateEmpty
, updateSet0Ds
, mkBindings
, FrameResource(..)
, extendResourceDS
, Buffer
, Process
, observe
, withBoundSet0
) where
import RIO
import Control.Monad.Trans.Resource (ResourceT)
import Control.Monad.Trans.Resource qualified as ResourceT
import Data.Bits ((.|.))
import Data.Kind (Type)
import Data.Tagged (Tagged(..))
import Data.Vector qualified as Vector
import Data.Vector.Storable qualified as VectorS
import Foreign.Storable.Generic (GStorable)
import Geomancy (Vec3, Vec4, vec3)
import Geomancy.Transform (Transform)
import Vulkan.Core10 qualified as Vk
import Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing qualified as Vk12
import Vulkan.CStruct.Extends (SomeStruct(..))
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))
import Engine.Vulkan.DescSets (Bound, Extend, extendDS, withBoundDescriptorSets0)
import Engine.Vulkan.Pipeline (Pipeline)
import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Types (DsLayoutBindings, MonadVulkan, HasVulkan(..))
import Engine.Worker qualified as Worker
import Global.Resource.CubeMap.Base qualified as BaseCubeMap
import Global.Resource.Texture.Base qualified as BaseTexture
import Render.DescSets.Sun (Sun)
import Render.Lit.Material (Material)
import Resource.Buffer qualified as Buffer
import Resource.Collection qualified as Collection
import Resource.Image qualified as Image
import Resource.Region qualified as Region
import Resource.Texture qualified as Texture
import Resource.Vulkan.DescriptorPool qualified as DescriptorPool
import Resource.Vulkan.Named qualified as Named
data Scene = Scene
{ Scene -> Transform
sceneProjection :: Transform
, Scene -> Transform
sceneInvProjection :: Transform
, Scene -> Transform
sceneView :: Transform
, Scene -> Transform
sceneInvView :: Transform
, Scene -> Vec3
sceneViewPos :: Vec3
, Scene -> Vec3
sceneViewDir :: Vec3
, Scene -> Vec4
sceneTweaks :: Vec4
, Scene -> Vec4
sceneFog :: Vec4
, Scene -> Int32
sceneEnvCube :: Int32
, Scene -> Word32
sceneNumLights :: Word32
}
deriving (Int -> Scene -> ShowS
[Scene] -> ShowS
Scene -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scene] -> ShowS
$cshowList :: [Scene] -> ShowS
show :: Scene -> String
$cshow :: Scene -> String
showsPrec :: Int -> Scene -> ShowS
$cshowsPrec :: Int -> Scene -> ShowS
Show, forall x. Rep Scene x -> Scene
forall x. Scene -> Rep Scene x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scene x -> Scene
$cfrom :: forall x. Scene -> Rep Scene x
Generic)
instance GStorable Scene
emptyScene :: Scene
emptyScene :: Scene
emptyScene = Scene
{ $sel:sceneProjection:Scene :: Transform
sceneProjection = forall a. Monoid a => a
mempty
, $sel:sceneInvProjection:Scene :: Transform
sceneInvProjection = forall a. Monoid a => a
mempty
, $sel:sceneView:Scene :: Transform
sceneView = forall a. Monoid a => a
mempty
, $sel:sceneInvView:Scene :: Transform
sceneInvView = forall a. Monoid a => a
mempty
, $sel:sceneViewPos:Scene :: Vec3
sceneViewPos = Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 Float
0
, $sel:sceneViewDir:Scene :: Vec3
sceneViewDir = Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 Float
1
, $sel:sceneFog:Scene :: Vec4
sceneFog = Vec4
0
, $sel:sceneEnvCube:Scene :: Int32
sceneEnvCube = forall a. Bounded a => a
minBound
, $sel:sceneNumLights:Scene :: Word32
sceneNumLights = Word32
0
, $sel:sceneTweaks:Scene :: Vec4
sceneTweaks = Vec4
0
}
mkBindings
:: ( Foldable samplers
, Foldable textures
, Foldable cubemaps
)
=> samplers Vk.Sampler
-> textures a
-> cubemaps b
-> Word32
-> Tagged Scene DsLayoutBindings
mkBindings :: forall (samplers :: * -> *) (textures :: * -> *)
(cubemaps :: * -> *) a b.
(Foldable samplers, Foldable textures, Foldable cubemaps) =>
samplers Sampler
-> textures a
-> cubemaps b
-> Word32
-> Tagged Scene DsLayoutBindings
mkBindings samplers Sampler
samplers textures a
textures cubemaps b
cubes Word32
shadows = forall {k} (s :: k) b. b -> Tagged s b
Tagged
[ (DescriptorSetLayoutBinding
set0bind0, forall a. Zero a => a
zero)
, (forall (samplers :: * -> *).
Foldable samplers =>
samplers Sampler -> DescriptorSetLayoutBinding
set0bind1 samplers Sampler
samplers, forall a. Zero a => a
zero)
, (forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind2 textures a
textures, DescriptorBindingFlags
partialBinding)
, (forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind3 cubemaps b
cubes, DescriptorBindingFlags
partialBinding)
, (DescriptorSetLayoutBinding
set0bind4, forall a. Zero a => a
zero)
, (Word32 -> DescriptorSetLayoutBinding
set0bind5 Word32
shadows, DescriptorBindingFlags
partialBinding)
, (DescriptorSetLayoutBinding
set0bind6, forall a. Zero a => a
zero)
]
where
partialBinding :: DescriptorBindingFlags
partialBinding =
DescriptorBindingFlags
Vk12.DESCRIPTOR_BINDING_PARTIALLY_BOUND_BIT
_partialVariable :: DescriptorBindingFlags
_partialVariable =
DescriptorBindingFlags
partialBinding forall a. Bits a => a -> a -> a
.|.
DescriptorBindingFlags
Vk12.DESCRIPTOR_BINDING_VARIABLE_DESCRIPTOR_COUNT_BIT
set0bind0 :: Vk.DescriptorSetLayoutBinding
set0bind0 :: DescriptorSetLayoutBinding
set0bind0 = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
0
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = Word32
1
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_ALL
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
set0bind1
:: Foldable samplers
=> samplers Vk.Sampler
-> Vk.DescriptorSetLayoutBinding
set0bind1 :: forall (samplers :: * -> *).
Foldable samplers =>
samplers Sampler -> DescriptorSetLayoutBinding
set0bind1 samplers Sampler
samplers = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
Vk.binding = Word32
1
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
Vk.stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLER
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
Vk.descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
Vector.length Vector Sampler
linearSamplers
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
Vk.immutableSamplers = Vector Sampler
linearSamplers
}
where
linearSamplers :: Vector Sampler
linearSamplers = forall (collection :: * -> *) a.
Foldable collection =>
collection a -> Vector a
Collection.toVector samplers Sampler
samplers
set0bind2
:: Foldable textures
=> textures a
-> Vk.DescriptorSetLayoutBinding
set0bind2 :: forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind2 textures a
textures = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
2
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
baseTextures Int
textureCount
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
where
baseTextures :: Int
baseTextures = forall (t :: * -> *) a. Foldable t => t a -> Int
length Collection Source
BaseTexture.sources
textureCount :: Int
textureCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length textures a
textures
set0bind3
:: Foldable cubes
=> cubes a
-> Vk.DescriptorSetLayoutBinding
set0bind3 :: forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind3 cubes a
cubes = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
3
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
baseCubes Int
cubeCount
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
where
baseCubes :: Int
baseCubes = forall (t :: * -> *) a. Foldable t => t a -> Int
length Collection Source
BaseCubeMap.sources
cubeCount :: Int
cubeCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length cubes a
cubes
set0bind4 :: Vk.DescriptorSetLayoutBinding
set0bind4 :: DescriptorSetLayoutBinding
set0bind4 = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
4
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = Word32
1
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
set0bind5 :: Word32 -> Vk.DescriptorSetLayoutBinding
set0bind5 :: Word32 -> DescriptorSetLayoutBinding
set0bind5 Word32
shadows = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
5
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = forall a. Ord a => a -> a -> a
max Word32
1 Word32
shadows
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
set0bind6 :: Vk.DescriptorSetLayoutBinding
set0bind6 :: DescriptorSetLayoutBinding
set0bind6 = Vk.DescriptorSetLayoutBinding
{ $sel:binding:DescriptorSetLayoutBinding :: Word32
binding = Word32
6
, $sel:descriptorType:DescriptorSetLayoutBinding :: DescriptorType
descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:stageFlags:DescriptorSetLayoutBinding :: ShaderStageFlags
stageFlags = ShaderStageFlags
Vk.SHADER_STAGE_FRAGMENT_BIT
, $sel:descriptorCount:DescriptorSetLayoutBinding :: Word32
descriptorCount = Word32
1
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = forall a. Monoid a => a
mempty
}
allocate
:: ( Traversable textures
, Traversable cubes
, MonadVulkan env m
, ResourceT.MonadResource m
)
=> Tagged '[Scene] Vk.DescriptorSetLayout
-> textures (Texture.Texture Texture.Flat)
-> cubes (Texture.Texture Texture.CubeMap)
-> Maybe (Buffer.Allocated 'Buffer.Coherent Sun)
-> "shadow maps" ::: Vector Vk.ImageView
-> Maybe (Buffer.Allocated 'Buffer.Coherent Material)
-> ResourceT m (FrameResource '[Scene])
allocate :: forall (textures :: * -> *) (cubes :: * -> *) env (m :: * -> *).
(Traversable textures, Traversable cubes, MonadVulkan env m,
MonadResource m) =>
Tagged '[Scene] DescriptorSetLayout
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> ("shadow maps" ::: Vector ImageView)
-> Maybe (Allocated 'Coherent Material)
-> ResourceT m (FrameResource '[Scene])
allocate (Tagged DescriptorSetLayout
set0layout) textures (Texture Flat)
textures cubes (Texture CubeMap)
cubes Maybe (Allocated 'Coherent Sun)
lightsData "shadow maps" ::: Vector ImageView
shadowViews Maybe (Allocated 'Coherent Material)
materialsData = do
DescriptorPool
descPool <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Maybe Text
-> Word32
-> [(DescriptorType, Word32)]
-> m (ReleaseKey, DescriptorPool)
DescriptorPool.allocate (forall a. a -> Maybe a
Just Text
"Basic") Word32
1 [(DescriptorType, Word32)]
dpSizes
Vector DescriptorSet
descSets <- forall env (m :: * -> *).
MonadVulkan env m =>
DescriptorPool
-> Maybe Text
-> Vector DescriptorSetLayout
-> m (Vector DescriptorSet)
DescriptorPool.allocateSetsFrom DescriptorPool
descPool (forall a. a -> Maybe a
Just Text
"Basic") [DescriptorSetLayout
set0layout]
Allocated 'Coherent Scene
sceneData <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *) a.
(MonadVulkan env m, MonadResource m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (ReleaseKey, Allocated 'Coherent a)
Buffer.allocateCoherent
(forall a. a -> Maybe a
Just Text
"Basic.Data")
BufferUsageFlagBits
Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
Int
1
[Scene
emptyScene]
let
shadowFilter :: Filter
shadowFilter = Filter
Vk.FILTER_LINEAR
shadowCI :: SamplerCreateInfo '[]
shadowCI = forall a. Zero a => a
zero
{ $sel:addressModeU:SamplerCreateInfo :: SamplerAddressMode
Vk.addressModeU = SamplerAddressMode
Vk.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE
, $sel:addressModeV:SamplerCreateInfo :: SamplerAddressMode
Vk.addressModeV = SamplerAddressMode
Vk.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE
, $sel:addressModeW:SamplerCreateInfo :: SamplerAddressMode
Vk.addressModeW = SamplerAddressMode
Vk.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE
, $sel:borderColor:SamplerCreateInfo :: BorderColor
Vk.borderColor = BorderColor
Vk.BORDER_COLOR_FLOAT_OPAQUE_WHITE
, $sel:magFilter:SamplerCreateInfo :: Filter
Vk.magFilter = Filter
shadowFilter
, $sel:minFilter:SamplerCreateInfo :: Filter
Vk.minFilter = Filter
shadowFilter
, $sel:compareEnable:SamplerCreateInfo :: Bool
Vk.compareEnable = Bool
True
, $sel:compareOp:SamplerCreateInfo :: CompareOp
Vk.compareOp = CompareOp
Vk.COMPARE_OP_LESS
}
let ifor :: Vector a -> (Int -> a -> ResourceT m b) -> ResourceT m (Vector b)
ifor = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
Vector.imapM
Vector (Sampler, ImageView)
shadowMaps <- forall {a} {b}.
Vector a -> (Int -> a -> ResourceT m b) -> ResourceT m (Vector b)
ifor "shadow maps" ::: Vector ImageView
shadowViews \Int
ix ImageView
depthView -> do
Sampler
shadowSampler <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local do
Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
forall (a :: [*]) (io :: * -> *) r.
(Extendss SamplerCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SamplerCreateInfo a
-> Maybe AllocationCallbacks
-> (io Sampler -> (Sampler -> io ()) -> r)
-> r
Vk.withSampler Device
device SamplerCreateInfo '[]
shadowCI forall a. Maybe a
Nothing forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
ResourceT.allocate
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
Named.object Sampler
shadowSampler forall a b. (a -> b) -> a -> b
$
Text
"Basic.ShadowSampler." forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
ix)
pure (Sampler
shadowSampler, ImageView
depthView)
env
context <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall context (textures :: * -> *) (cubes :: * -> *)
(m :: * -> *).
(HasVulkan context, Traversable textures, Traversable cubes,
MonadIO m) =>
context
-> Tagged '[Scene] (Vector DescriptorSet)
-> Allocated 'Coherent Scene
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> Vector (Sampler, ImageView)
-> Maybe (Allocated 'Coherent Material)
-> m ()
updateSet0Ds
env
context
(forall {k} (s :: k) b. b -> Tagged s b
Tagged Vector DescriptorSet
descSets)
Allocated 'Coherent Scene
sceneData
textures (Texture Flat)
textures
cubes (Texture CubeMap)
cubes
Maybe (Allocated 'Coherent Sun)
lightsData
Vector (Sampler, ImageView)
shadowMaps
Maybe (Allocated 'Coherent Material)
materialsData
ObserverIO Scene
observer <- forall (m :: * -> *) a. MonadIO m => a -> m (ObserverIO a)
Worker.newObserverIO Scene
emptyScene
pure FrameResource
{ $sel:frDescSets:FrameResource :: Tagged '[Scene] (Vector DescriptorSet)
frDescSets = forall {k} (s :: k) b. b -> Tagged s b
Tagged Vector DescriptorSet
descSets
, $sel:frBuffer:FrameResource :: Allocated 'Coherent Scene
frBuffer = Allocated 'Coherent Scene
sceneData
, $sel:frObserver:FrameResource :: ObserverIO Scene
frObserver = ObserverIO Scene
observer
}
dpSizes :: [(Vk.DescriptorType, Word32)]
dpSizes :: [(DescriptorType, Word32)]
dpSizes =
[ ( DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, Word32
uniformBuffers
)
, ( DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, Word32
sampledImages
)
, ( DescriptorType
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
, Word32
sampledImages forall a. Num a => a -> a -> a
+ Word32
shadowMaps
)
, ( DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLER
, Word32
staticSamplers
)
]
where
uniformBuffers :: Word32
uniformBuffers = Word32
3
sampledImages :: Word32
sampledImages = Word32
128
staticSamplers :: Word32
staticSamplers = Word32
8
shadowMaps :: Word32
shadowMaps = Word32
2
allocateEmpty
:: ( MonadVulkan env m
, ResourceT.MonadResource m
)
=> Tagged '[Scene] Vk.DescriptorSetLayout
-> ResourceT m (FrameResource '[Scene])
allocateEmpty :: forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Tagged '[Scene] DescriptorSetLayout
-> ResourceT m (FrameResource '[Scene])
allocateEmpty Tagged '[Scene] DescriptorSetLayout
taggedLayout =
forall (textures :: * -> *) (cubes :: * -> *) env (m :: * -> *).
(Traversable textures, Traversable cubes, MonadVulkan env m,
MonadResource m) =>
Tagged '[Scene] DescriptorSetLayout
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> ("shadow maps" ::: Vector ImageView)
-> Maybe (Allocated 'Coherent Material)
-> ResourceT m (FrameResource '[Scene])
allocate Tagged '[Scene] DescriptorSetLayout
taggedLayout forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
updateSet0Ds
:: ( HasVulkan context
, Traversable textures
, Traversable cubes
, MonadIO m
)
=> context
-> Tagged '[Scene] (Vector Vk.DescriptorSet)
-> Buffer.Allocated 'Buffer.Coherent Scene
-> textures (Texture.Texture Texture.Flat)
-> cubes (Texture.Texture Texture.CubeMap)
-> Maybe (Buffer.Allocated 'Buffer.Coherent Sun)
-> Vector (Vk.Sampler, Vk.ImageView)
-> Maybe (Buffer.Allocated 'Buffer.Coherent Material)
-> m ()
updateSet0Ds :: forall context (textures :: * -> *) (cubes :: * -> *)
(m :: * -> *).
(HasVulkan context, Traversable textures, Traversable cubes,
MonadIO m) =>
context
-> Tagged '[Scene] (Vector DescriptorSet)
-> Allocated 'Coherent Scene
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> Vector (Sampler, ImageView)
-> Maybe (Allocated 'Coherent Material)
-> m ()
updateSet0Ds context
context (Tagged Vector DescriptorSet
ds) Allocated 'Coherent Scene
sceneData textures (Texture Flat)
textures cubes (Texture CubeMap)
cubes Maybe (Allocated 'Coherent Sun)
lightsData Vector (Sampler, ImageView)
shadowMaps Maybe (Allocated 'Coherent Material)
materialsData =
forall (io :: * -> *).
MonadIO io =>
Device
-> Vector (SomeStruct WriteDescriptorSet)
-> ("descriptorCopies" ::: Vector CopyDescriptorSet)
-> io ()
Vk.updateDescriptorSets (forall a. HasVulkan a => a -> Device
getDevice context
context) Vector (SomeStruct WriteDescriptorSet)
writeSets forall a. Monoid a => a
mempty
where
linearTextures :: Vector (Texture Flat)
linearTextures = forall (collection :: * -> *) a.
Foldable collection =>
collection a -> Vector a
Collection.toVector textures (Texture Flat)
textures
linearCubes :: Vector (Texture CubeMap)
linearCubes = forall (collection :: * -> *) a.
Foldable collection =>
collection a -> Vector a
Collection.toVector cubes (Texture CubeMap)
cubes
destSet0 :: DescriptorSet
destSet0 = case forall (m :: * -> *) a. Monad m => Vector a -> m a
Vector.headM Vector DescriptorSet
ds of
Maybe DescriptorSet
Nothing ->
forall a. HasCallStack => String -> a
error String
"assert: descriptor sets promised to contain [Scene]"
Just DescriptorSet
one ->
DescriptorSet
one
writeSet0b0 :: SomeStruct WriteDescriptorSet
writeSet0b0 = forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
0
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = Word32
1
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:bufferInfo:WriteDescriptorSet :: Vector DescriptorBufferInfo
Vk.bufferInfo = forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind0I
}
where
set0bind0I :: DescriptorBufferInfo
set0bind0I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = forall (s :: Store) a. Allocated s a -> Buffer
Buffer.aBuffer Allocated 'Coherent Scene
sceneData
, $sel:offset:DescriptorBufferInfo :: DeviceSize
Vk.offset = DeviceSize
0
, $sel:range:DescriptorBufferInfo :: DeviceSize
Vk.range = DeviceSize
Vk.WHOLE_SIZE
}
writeSet0b2 :: SomeStruct WriteDescriptorSet
writeSet0b2 = forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
2
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
Vector.length Vector (Texture Flat)
linearTextures
, $sel:imageInfo:WriteDescriptorSet :: Vector DescriptorImageInfo
Vk.imageInfo = Vector DescriptorImageInfo
textureInfos
}
where
textureInfos :: Vector DescriptorImageInfo
textureInfos = do
Texture Flat
texture <- Vector (Texture Flat)
linearTextures
pure Vk.DescriptorImageInfo
{ $sel:sampler:DescriptorImageInfo :: Sampler
sampler = forall a. Zero a => a
zero
, $sel:imageView:DescriptorImageInfo :: ImageView
imageView = AllocatedImage -> ImageView
Image.aiImageView forall a b. (a -> b) -> a -> b
$ forall tag. Texture tag -> AllocatedImage
Texture.tAllocatedImage Texture Flat
texture
, $sel:imageLayout:DescriptorImageInfo :: ImageLayout
imageLayout = ImageLayout
Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
}
writeSet0b3 :: SomeStruct WriteDescriptorSet
writeSet0b3 = forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
3
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
Vector.length Vector (Texture CubeMap)
linearCubes
, $sel:imageInfo:WriteDescriptorSet :: Vector DescriptorImageInfo
Vk.imageInfo = Vector DescriptorImageInfo
cubeInfos
}
where
cubeInfos :: Vector DescriptorImageInfo
cubeInfos = do
Texture CubeMap
cube <- Vector (Texture CubeMap)
linearCubes
pure Vk.DescriptorImageInfo
{ $sel:sampler:DescriptorImageInfo :: Sampler
sampler = forall a. Zero a => a
zero
, $sel:imageView:DescriptorImageInfo :: ImageView
imageView = AllocatedImage -> ImageView
Image.aiImageView forall a b. (a -> b) -> a -> b
$ forall tag. Texture tag -> AllocatedImage
Texture.tAllocatedImage Texture CubeMap
cube
, $sel:imageLayout:DescriptorImageInfo :: ImageLayout
imageLayout = ImageLayout
Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
}
writeSet0b4M :: Vector (SomeStruct WriteDescriptorSet)
writeSet0b4M =
case Maybe (Allocated 'Coherent Sun)
lightsData of
Maybe (Allocated 'Coherent Sun)
Nothing ->
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Allocated 'Coherent Sun
someLights ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
4
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = Word32
1
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:bufferInfo:WriteDescriptorSet :: Vector DescriptorBufferInfo
Vk.bufferInfo = forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind4I
}
where
set0bind4I :: DescriptorBufferInfo
set0bind4I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = forall (s :: Store) a. Allocated s a -> Buffer
Buffer.aBuffer Allocated 'Coherent Sun
someLights
, $sel:offset:DescriptorBufferInfo :: DeviceSize
Vk.offset = DeviceSize
0
, $sel:range:DescriptorBufferInfo :: DeviceSize
Vk.range = DeviceSize
Vk.WHOLE_SIZE
}
writeSet0b5 :: SomeStruct WriteDescriptorSet
writeSet0b5 = forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
5
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
Vector.length Vector (Sampler, ImageView)
shadowMaps
, $sel:imageInfo:WriteDescriptorSet :: Vector DescriptorImageInfo
Vk.imageInfo = Vector DescriptorImageInfo
shadowInfos
}
where
shadowInfos :: Vector DescriptorImageInfo
shadowInfos = do
(Sampler
shadowSampler, ImageView
shadowImageView) <- Vector (Sampler, ImageView)
shadowMaps
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vk.DescriptorImageInfo
{ $sel:sampler:DescriptorImageInfo :: Sampler
sampler = Sampler
shadowSampler
, $sel:imageView:DescriptorImageInfo :: ImageView
imageView = ImageView
shadowImageView
, $sel:imageLayout:DescriptorImageInfo :: ImageLayout
imageLayout = ImageLayout
Vk.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL
}
writeSet0b6M :: Vector (SomeStruct WriteDescriptorSet)
writeSet0b6M =
case Maybe (Allocated 'Coherent Material)
materialsData of
Maybe (Allocated 'Coherent Material)
Nothing ->
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Allocated 'Coherent Material
someMaterials ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct forall a. Zero a => a
zero
{ $sel:dstSet:WriteDescriptorSet :: DescriptorSet
Vk.dstSet = DescriptorSet
destSet0
, $sel:dstBinding:WriteDescriptorSet :: Word32
Vk.dstBinding = Word32
6
, $sel:dstArrayElement:WriteDescriptorSet :: Word32
Vk.dstArrayElement = Word32
0
, $sel:descriptorCount:WriteDescriptorSet :: Word32
Vk.descriptorCount = Word32
1
, $sel:descriptorType:WriteDescriptorSet :: DescriptorType
Vk.descriptorType = DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, $sel:bufferInfo:WriteDescriptorSet :: Vector DescriptorBufferInfo
Vk.bufferInfo = forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind6I
}
where
set0bind6I :: DescriptorBufferInfo
set0bind6I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = forall (s :: Store) a. Allocated s a -> Buffer
Buffer.aBuffer Allocated 'Coherent Material
someMaterials
, $sel:offset:DescriptorBufferInfo :: DeviceSize
Vk.offset = DeviceSize
0
, $sel:range:DescriptorBufferInfo :: DeviceSize
Vk.range = DeviceSize
Vk.WHOLE_SIZE
}
writeSets :: Vector (SomeStruct WriteDescriptorSet)
writeSets = forall a. [Vector a] -> Vector a
Vector.concat
[ forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeStruct WriteDescriptorSet
writeSet0b0
, forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Texture Flat)
linearTextures SomeStruct WriteDescriptorSet
writeSet0b2
, forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Texture CubeMap)
linearCubes SomeStruct WriteDescriptorSet
writeSet0b3
, Vector (SomeStruct WriteDescriptorSet)
writeSet0b4M
, forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Sampler, ImageView)
shadowMaps SomeStruct WriteDescriptorSet
writeSet0b5
, Vector (SomeStruct WriteDescriptorSet)
writeSet0b6M
]
where
skipEmpty :: Vector a -> a -> f a
skipEmpty Vector a
items a
writer
| forall a. Vector a -> Bool
Vector.null Vector a
items = forall a. Monoid a => a
mempty
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
writer
extendResourceDS
:: FrameResource ds
-> Tagged ext Vk.DescriptorSet
-> FrameResource (Extend ds ext)
extendResourceDS :: forall (ds :: [*]) ext.
FrameResource ds
-> Tagged ext DescriptorSet -> FrameResource (Extend ds ext)
extendResourceDS FrameResource{ObserverIO Scene
Tagged ds (Vector DescriptorSet)
Allocated 'Coherent Scene
frObserver :: ObserverIO Scene
frBuffer :: Allocated 'Coherent Scene
frDescSets :: Tagged ds (Vector DescriptorSet)
$sel:frObserver:FrameResource :: forall (ds :: [*]). FrameResource ds -> ObserverIO Scene
$sel:frBuffer:FrameResource :: forall (ds :: [*]). FrameResource ds -> Allocated 'Coherent Scene
$sel:frDescSets:FrameResource :: forall (ds :: [*]).
FrameResource ds -> Tagged ds (Vector DescriptorSet)
..} Tagged ext DescriptorSet
ext = FrameResource
{ $sel:frDescSets:FrameResource :: Tagged (Extend ds ext) (Vector DescriptorSet)
frDescSets = forall (as :: [*]) b.
Tagged as (Vector DescriptorSet)
-> Tagged b DescriptorSet
-> Tagged (Extend as b) (Vector DescriptorSet)
extendDS Tagged ds (Vector DescriptorSet)
frDescSets Tagged ext DescriptorSet
ext
, ObserverIO Scene
Allocated 'Coherent Scene
frObserver :: ObserverIO Scene
frBuffer :: Allocated 'Coherent Scene
$sel:frObserver:FrameResource :: ObserverIO Scene
$sel:frBuffer:FrameResource :: Allocated 'Coherent Scene
..
}
data FrameResource (ds :: [Type]) = FrameResource
{ forall (ds :: [*]).
FrameResource ds -> Tagged ds (Vector DescriptorSet)
frDescSets :: Tagged ds (Vector Vk.DescriptorSet)
, forall (ds :: [*]). FrameResource ds -> Allocated 'Coherent Scene
frBuffer :: Buffer
, forall (ds :: [*]). FrameResource ds -> ObserverIO Scene
frObserver :: Worker.ObserverIO Scene
}
type Buffer = Buffer.Allocated 'Buffer.Coherent Scene
type Process = Worker.Merge Scene
observe
:: (MonadUnliftIO m)
=> Process -> FrameResource ds -> m ()
observe :: forall (m :: * -> *) (ds :: [*]).
MonadUnliftIO m =>
Process -> FrameResource ds -> m ()
observe Process
process FrameResource{Allocated 'Coherent Scene
frBuffer :: Allocated 'Coherent Scene
$sel:frBuffer:FrameResource :: forall (ds :: [*]). FrameResource ds -> Allocated 'Coherent Scene
frBuffer, ObserverIO Scene
frObserver :: ObserverIO Scene
$sel:frObserver:FrameResource :: forall (ds :: [*]). FrameResource ds -> ObserverIO Scene
frObserver}=
forall (m :: * -> *) output a.
(MonadUnliftIO m, HasOutput output) =>
output -> ObserverIO a -> (a -> GetOutput output -> m a) -> m ()
Worker.observeIO_ Process
process ObserverIO Scene
frObserver \Scene
_old GetOutput Process
new -> do
Allocated 'Coherent Scene
_same <- forall (io :: * -> *) a.
(MonadUnliftIO io, Storable a) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
Buffer.updateCoherent (forall a. Storable a => a -> Vector a
VectorS.singleton GetOutput Process
new) Allocated 'Coherent Scene
frBuffer
pure GetOutput Process
new
withBoundSet0
:: MonadIO m
=> FrameResource ds
-> Pipeline ds vertices instances
-> Vk.CommandBuffer
-> Bound ds Void Void m b
-> m b
withBoundSet0 :: forall (m :: * -> *) (ds :: [*]) vertices instances b.
MonadIO m =>
FrameResource ds
-> Pipeline ds vertices instances
-> CommandBuffer
-> Bound ds Void Void m b
-> m b
withBoundSet0 FrameResource{Tagged ds (Vector DescriptorSet)
frDescSets :: Tagged ds (Vector DescriptorSet)
$sel:frDescSets:FrameResource :: forall (ds :: [*]).
FrameResource ds -> Tagged ds (Vector DescriptorSet)
frDescSets} Pipeline ds vertices instances
refPipeline CommandBuffer
cb =
forall (m :: * -> *) (dsl :: [*]) b.
MonadIO m =>
CommandBuffer
-> PipelineBindPoint
-> Tagged dsl PipelineLayout
-> Tagged dsl (Vector DescriptorSet)
-> Bound dsl Void Void m b
-> m b
withBoundDescriptorSets0
CommandBuffer
cb
PipelineBindPoint
Vk.PIPELINE_BIND_POINT_GRAPHICS
(forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
Pipeline.pLayout Pipeline ds vertices instances
refPipeline)
Tagged ds (Vector DescriptorSet)
frDescSets