{-# 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
(Int -> Scene -> ShowS)
-> (Scene -> String) -> ([Scene] -> ShowS) -> Show Scene
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scene -> ShowS
showsPrec :: Int -> Scene -> ShowS
$cshow :: Scene -> String
show :: Scene -> String
$cshowList :: [Scene] -> ShowS
showList :: [Scene] -> ShowS
Show, (forall x. Scene -> Rep Scene x)
-> (forall x. Rep Scene x -> Scene) -> Generic Scene
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
$cfrom :: forall x. Scene -> Rep Scene x
from :: forall x. Scene -> Rep Scene x
$cto :: forall x. Rep Scene x -> Scene
to :: forall x. Rep Scene x -> Scene
Generic)
instance GStorable Scene
emptyScene :: Scene
emptyScene :: Scene
emptyScene = Scene
{ $sel:sceneProjection:Scene :: Transform
sceneProjection = Transform
forall a. Monoid a => a
mempty
, $sel:sceneInvProjection:Scene :: Transform
sceneInvProjection = Transform
forall a. Monoid a => a
mempty
, $sel:sceneView:Scene :: Transform
sceneView = Transform
forall a. Monoid a => a
mempty
, $sel:sceneInvView:Scene :: Transform
sceneInvView = Transform
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 = Int32
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 = DsLayoutBindings -> Tagged Scene DsLayoutBindings
forall {k} (s :: k) b. b -> Tagged s b
Tagged
[ (DescriptorSetLayoutBinding
set0bind0, DescriptorBindingFlags
forall a. Zero a => a
zero)
, (samplers Sampler -> DescriptorSetLayoutBinding
forall (samplers :: * -> *).
Foldable samplers =>
samplers Sampler -> DescriptorSetLayoutBinding
set0bind1 samplers Sampler
samplers, DescriptorBindingFlags
forall a. Zero a => a
zero)
, (textures a -> DescriptorSetLayoutBinding
forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind2 textures a
textures, DescriptorBindingFlags
partialBinding)
, (cubemaps b -> DescriptorSetLayoutBinding
forall (textures :: * -> *) a.
Foldable textures =>
textures a -> DescriptorSetLayoutBinding
set0bind3 cubemaps b
cubes, DescriptorBindingFlags
partialBinding)
, (DescriptorSetLayoutBinding
set0bind4, DescriptorBindingFlags
forall a. Zero a => a
zero)
, (Word32 -> DescriptorSetLayoutBinding
set0bind5 Word32
shadows, DescriptorBindingFlags
partialBinding)
, (DescriptorSetLayoutBinding
set0bind6, DescriptorBindingFlags
forall a. Zero a => a
zero)
]
where
partialBinding :: DescriptorBindingFlags
partialBinding =
DescriptorBindingFlags
Vk12.DESCRIPTOR_BINDING_PARTIALLY_BOUND_BIT
_partialVariable :: DescriptorBindingFlags
_partialVariable =
DescriptorBindingFlags
partialBinding DescriptorBindingFlags
-> DescriptorBindingFlags -> DescriptorBindingFlags
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 = Vector Sampler
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Sampler -> Int
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 = samplers Sampler -> Vector Sampler
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
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 = Vector Sampler
forall a. Monoid a => a
mempty
}
where
baseTextures :: Int
baseTextures = Collection Source -> Int
forall a. Collection a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Collection Source
BaseTexture.sources
textureCount :: Int
textureCount = textures a -> Int
forall a. textures a -> Int
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
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 = Vector Sampler
forall a. Monoid a => a
mempty
}
where
baseCubes :: Int
baseCubes = Collection Source -> Int
forall a. Collection a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Collection Source
BaseCubeMap.sources
cubeCount :: Int
cubeCount = cubes a -> Int
forall a. cubes a -> Int
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 = Vector Sampler
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 = Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max Word32
1 Word32
shadows
, $sel:immutableSamplers:DescriptorSetLayoutBinding :: Vector Sampler
immutableSamplers = Vector Sampler
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 = Vector Sampler
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 <- m (ReleaseKey, DescriptorPool) -> ResourceT m DescriptorPool
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (m (ReleaseKey, DescriptorPool) -> ResourceT m DescriptorPool)
-> m (ReleaseKey, DescriptorPool) -> ResourceT m DescriptorPool
forall a b. (a -> b) -> a -> b
$
Maybe Text
-> Word32
-> [(DescriptorType, Word32)]
-> m (ReleaseKey, DescriptorPool)
forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Maybe Text
-> Word32
-> [(DescriptorType, Word32)]
-> m (ReleaseKey, DescriptorPool)
DescriptorPool.allocate (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Basic") Word32
1 [(DescriptorType, Word32)]
dpSizes
Vector DescriptorSet
descSets <- DescriptorPool
-> Maybe Text
-> Vector DescriptorSetLayout
-> ResourceT m (Vector DescriptorSet)
forall env (m :: * -> *).
MonadVulkan env m =>
DescriptorPool
-> Maybe Text
-> Vector DescriptorSetLayout
-> m (Vector DescriptorSet)
DescriptorPool.allocateSetsFrom DescriptorPool
descPool (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Basic") [Item (Vector DescriptorSetLayout)
DescriptorSetLayout
set0layout]
Allocated 'Coherent Scene
sceneData <- m (ReleaseKey, Allocated 'Coherent Scene)
-> ResourceT m (Allocated 'Coherent Scene)
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (m (ReleaseKey, Allocated 'Coherent Scene)
-> ResourceT m (Allocated 'Coherent Scene))
-> m (ReleaseKey, Allocated 'Coherent Scene)
-> ResourceT m (Allocated 'Coherent Scene)
forall a b. (a -> b) -> a -> b
$
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector Scene
-> m (ReleaseKey, Allocated 'Coherent Scene)
forall env (m :: * -> *) a.
(MonadVulkan env m, MonadResource m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (ReleaseKey, Allocated 'Coherent a)
Buffer.allocateCoherent
(Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Basic.Data")
BufferUsageFlagBits
Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
Int
1
[Item (Vector Scene)
Scene
emptyScene]
let
shadowFilter :: Filter
shadowFilter = Filter
Vk.FILTER_LINEAR
shadowCI :: SamplerCreateInfo '[]
shadowCI = SamplerCreateInfo '[]
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 = ((Int -> a -> ResourceT m b) -> Vector a -> ResourceT m (Vector b))
-> Vector a
-> (Int -> a -> ResourceT m b)
-> ResourceT m (Vector b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> ResourceT m b) -> Vector a -> ResourceT m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
Vector.imapM
Vector (Sampler, ImageView)
shadowMaps <- ("shadow maps" ::: Vector ImageView)
-> (Int -> ImageView -> ResourceT m (Sampler, ImageView))
-> ResourceT m (Vector (Sampler, ImageView))
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 <- m (ReleaseKey, Sampler) -> ResourceT m Sampler
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local 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
Device
-> SamplerCreateInfo '[]
-> Maybe AllocationCallbacks
-> (IO Sampler -> (Sampler -> IO ()) -> m (ReleaseKey, Sampler))
-> m (ReleaseKey, Sampler)
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 Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO Sampler -> (Sampler -> IO ()) -> m (ReleaseKey, Sampler)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
ResourceT.allocate
Sampler -> Text -> ResourceT m ()
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
Named.object Sampler
shadowSampler (Text -> ResourceT m ()) -> Text -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$
Text
"Basic.ShadowSampler." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
ix)
pure (Sampler
shadowSampler, ImageView
depthView)
env
context <- ResourceT m env
forall r (m :: * -> *). MonadReader r m => m r
ask
env
-> Tagged '[Scene] (Vector DescriptorSet)
-> Allocated 'Coherent Scene
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> Vector (Sampler, ImageView)
-> Maybe (Allocated 'Coherent Material)
-> ResourceT m ()
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
(Vector DescriptorSet -> Tagged '[Scene] (Vector DescriptorSet)
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 <- Scene -> ResourceT m (ObserverIO Scene)
forall (m :: * -> *) a. MonadIO m => a -> m (ObserverIO a)
Worker.newObserverIO Scene
emptyScene
pure FrameResource
{ $sel:frDescSets:FrameResource :: Tagged '[Scene] (Vector DescriptorSet)
frDescSets = Vector DescriptorSet -> Tagged '[Scene] (Vector DescriptorSet)
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 Word32 -> Word32 -> Word32
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 =
Tagged '[Scene] DescriptorSetLayout
-> Maybe (Texture Flat)
-> Maybe (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> ("shadow maps" ::: Vector ImageView)
-> Maybe (Allocated 'Coherent Material)
-> ResourceT m (FrameResource '[Scene])
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 Maybe (Texture Flat)
forall a. Maybe a
Nothing Maybe (Texture CubeMap)
forall a. Maybe a
Nothing Maybe (Allocated 'Coherent Sun)
forall a. Maybe a
Nothing "shadow maps" ::: Vector ImageView
forall a. Monoid a => a
mempty Maybe (Allocated 'Coherent Material)
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 =
Device
-> Vector (SomeStruct WriteDescriptorSet)
-> Vector CopyDescriptorSet
-> m ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Vector (SomeStruct WriteDescriptorSet)
-> Vector CopyDescriptorSet
-> io ()
Vk.updateDescriptorSets (context -> Device
forall a. HasVulkan a => a -> Device
getDevice context
context) Vector (SomeStruct WriteDescriptorSet)
writeSets Vector CopyDescriptorSet
forall a. Monoid a => a
mempty
where
linearTextures :: Vector (Texture Flat)
linearTextures = textures (Texture Flat) -> Vector (Texture Flat)
forall (collection :: * -> *) a.
Foldable collection =>
collection a -> Vector a
Collection.toVector textures (Texture Flat)
textures
linearCubes :: Vector (Texture CubeMap)
linearCubes = cubes (Texture CubeMap) -> Vector (Texture CubeMap)
forall (collection :: * -> *) a.
Foldable collection =>
collection a -> Vector a
Collection.toVector cubes (Texture CubeMap)
cubes
destSet0 :: DescriptorSet
destSet0 = case Vector DescriptorSet -> Maybe DescriptorSet
forall (m :: * -> *) a. Monad m => Vector a -> m a
Vector.headM Vector DescriptorSet
ds of
Maybe DescriptorSet
Nothing ->
String -> DescriptorSet
forall a. HasCallStack => String -> a
error String
"assert: descriptor sets promised to contain [Scene]"
Just DescriptorSet
one ->
DescriptorSet
one
writeSet0b0 :: SomeStruct WriteDescriptorSet
writeSet0b0 = WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = DescriptorBufferInfo -> Vector DescriptorBufferInfo
forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind0I
}
where
set0bind0I :: DescriptorBufferInfo
set0bind0I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = Allocated 'Coherent Scene -> Buffer
forall {k} (s :: Store) (a :: k). 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 = WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector (Texture Flat) -> Int
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 = Sampler
forall a. Zero a => a
zero
, $sel:imageView:DescriptorImageInfo :: ImageView
imageView = AllocatedImage -> ImageView
Image.aiImageView (AllocatedImage -> ImageView) -> AllocatedImage -> ImageView
forall a b. (a -> b) -> a -> b
$ Texture Flat -> AllocatedImage
forall {k} (tag :: k). 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 = WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector (Texture CubeMap) -> Int
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 = Sampler
forall a. Zero a => a
zero
, $sel:imageView:DescriptorImageInfo :: ImageView
imageView = AllocatedImage -> ImageView
Image.aiImageView (AllocatedImage -> ImageView) -> AllocatedImage -> ImageView
forall a b. (a -> b) -> a -> b
$ Texture CubeMap -> AllocatedImage
forall {k} (tag :: k). 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 ->
Vector (SomeStruct WriteDescriptorSet)
forall a. Vector a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Allocated 'Coherent Sun
someLights ->
SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet))
-> SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall a b. (a -> b) -> a -> b
$ WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = DescriptorBufferInfo -> Vector DescriptorBufferInfo
forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind4I
}
where
set0bind4I :: DescriptorBufferInfo
set0bind4I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = Allocated 'Coherent Sun -> Buffer
forall {k} (s :: Store) (a :: k). 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 = WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector (Sampler, ImageView) -> Int
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
DescriptorImageInfo -> Vector DescriptorImageInfo
forall a. a -> Vector a
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 ->
Vector (SomeStruct WriteDescriptorSet)
forall a. Vector a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Allocated 'Coherent Material
someMaterials ->
SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet))
-> SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall a b. (a -> b) -> a -> b
$ WriteDescriptorSet '[] -> SomeStruct WriteDescriptorSet
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct WriteDescriptorSet '[]
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 = DescriptorBufferInfo -> Vector DescriptorBufferInfo
forall a. a -> Vector a
Vector.singleton DescriptorBufferInfo
set0bind6I
}
where
set0bind6I :: DescriptorBufferInfo
set0bind6I = Vk.DescriptorBufferInfo
{ $sel:buffer:DescriptorBufferInfo :: Buffer
Vk.buffer = Allocated 'Coherent Material -> Buffer
forall {k} (s :: Store) (a :: k). 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 = [Vector (SomeStruct WriteDescriptorSet)]
-> Vector (SomeStruct WriteDescriptorSet)
forall a. [Vector a] -> Vector a
Vector.concat
[ SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeStruct WriteDescriptorSet
writeSet0b0
, Vector (Texture Flat)
-> SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Texture Flat)
linearTextures SomeStruct WriteDescriptorSet
writeSet0b2
, Vector (Texture CubeMap)
-> SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Texture CubeMap)
linearCubes SomeStruct WriteDescriptorSet
writeSet0b3
, Item [Vector (SomeStruct WriteDescriptorSet)]
Vector (SomeStruct WriteDescriptorSet)
writeSet0b4M
, Vector (Sampler, ImageView)
-> SomeStruct WriteDescriptorSet
-> Vector (SomeStruct WriteDescriptorSet)
forall {f :: * -> *} {a} {a}.
(Monoid (f a), Applicative f) =>
Vector a -> a -> f a
skipEmpty Vector (Sampler, ImageView)
shadowMaps SomeStruct WriteDescriptorSet
writeSet0b5
, Item [Vector (SomeStruct WriteDescriptorSet)]
Vector (SomeStruct WriteDescriptorSet)
writeSet0b6M
]
where
skipEmpty :: Vector a -> a -> f a
skipEmpty Vector a
items a
writer
| Vector a -> Bool
forall a. Vector a -> Bool
Vector.null Vector a
items = f a
forall a. Monoid a => a
mempty
| Bool
otherwise = a -> f a
forall a. a -> f a
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
$sel:frDescSets:FrameResource :: forall (ds :: [*]).
FrameResource ds -> Tagged ds (Vector DescriptorSet)
$sel:frBuffer:FrameResource :: forall (ds :: [*]). FrameResource ds -> Allocated 'Coherent Scene
$sel:frObserver:FrameResource :: forall (ds :: [*]). FrameResource ds -> ObserverIO Scene
frDescSets :: Tagged ds (Vector DescriptorSet)
frBuffer :: Allocated 'Coherent Scene
frObserver :: ObserverIO Scene
..} Tagged ext DescriptorSet
ext = FrameResource
{ $sel:frDescSets:FrameResource :: Tagged (Extend ds ext) (Vector DescriptorSet)
frDescSets = Tagged ds (Vector DescriptorSet)
-> Tagged ext DescriptorSet
-> Tagged (Extend ds ext) (Vector DescriptorSet)
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
$sel:frBuffer:FrameResource :: Allocated 'Coherent Scene
$sel:frObserver:FrameResource :: ObserverIO Scene
frBuffer :: Allocated 'Coherent Scene
frObserver :: ObserverIO 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
$sel:frBuffer:FrameResource :: forall (ds :: [*]). FrameResource ds -> Allocated 'Coherent Scene
frBuffer :: Allocated 'Coherent Scene
frBuffer, ObserverIO Scene
$sel:frObserver:FrameResource :: forall (ds :: [*]). FrameResource ds -> ObserverIO Scene
frObserver :: ObserverIO Scene
frObserver}=
Process
-> ObserverIO Scene
-> (Scene -> GetOutput Process -> m Scene)
-> m ()
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 <- Vector Scene
-> Allocated 'Coherent Scene -> m (Allocated 'Coherent Scene)
forall (io :: * -> *) a.
(MonadUnliftIO io, Storable a) =>
Vector a -> Allocated 'Coherent a -> io (Allocated 'Coherent a)
Buffer.updateCoherent (Scene -> Vector Scene
forall a. Storable a => a -> Vector a
VectorS.singleton GetOutput Process
Scene
new) Allocated 'Coherent Scene
frBuffer
pure GetOutput Process
Scene
new
withBoundSet0
:: MonadIO m
=> FrameResource ds
-> Pipeline ds vertices instances
-> Vk.CommandBuffer
-> Bound ds Void Void m b
-> m b
withBoundSet0 :: forall {k} {k1} (m :: * -> *) (ds :: [*]) (vertices :: k)
(instances :: k1) b.
MonadIO m =>
FrameResource ds
-> Pipeline ds vertices instances
-> CommandBuffer
-> Bound ds Void Void m b
-> m b
withBoundSet0 FrameResource{Tagged ds (Vector DescriptorSet)
$sel:frDescSets:FrameResource :: forall (ds :: [*]).
FrameResource ds -> Tagged ds (Vector DescriptorSet)
frDescSets :: Tagged ds (Vector DescriptorSet)
frDescSets} Pipeline ds vertices instances
refPipeline CommandBuffer
cb =
CommandBuffer
-> PipelineBindPoint
-> Tagged ds PipelineLayout
-> Tagged ds (Vector DescriptorSet)
-> Bound ds Void Void m b
-> m b
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
(Pipeline ds vertices instances -> Tagged ds PipelineLayout
forall {k1} {k2} (dsl :: [*]) (vertices :: k1) (instances :: k2).
Pipeline dsl vertices instances -> Tagged dsl PipelineLayout
Pipeline.pLayout Pipeline ds vertices instances
refPipeline)
Tagged ds (Vector DescriptorSet)
frDescSets