{-# LANGUAGE OverloadedLists #-}
module Render.Pass.Compose
( Compose(..)
, allocate
, update
, usePass
) where
import RIO
import Control.Monad.Trans.Resource qualified as Resource
import Data.Bits ((.|.))
import Data.Vector qualified as Vector
import Vulkan.Core10 qualified as Vk
import Vulkan.Utils.Debug qualified as Debug
import Vulkan.Zero (zero)
import Engine.Types.RefCounted (RefCounted, releaseRefCounted, resourceTRefCount)
import Engine.Types.RefCounted qualified as RefCounted
import Engine.Vulkan.Types (HasSwapchain(..), HasRenderPass(..), MonadVulkan, RenderPass(..), getDevice)
import Render.Pass (usePass)
import Resource.Region qualified as Region
data Compose = Compose
{ Compose -> RenderPass
renderPass :: Vk.RenderPass
, Compose -> Vector Framebuffer
frameBuffers :: Vector Vk.Framebuffer
, Compose -> Rect2D
renderArea :: Vk.Rect2D
, Compose -> Vector ClearValue
clear :: Vector Vk.ClearValue
, Compose -> RefCounted
release :: RefCounted
}
instance HasRenderPass Compose where
getRenderPass :: Compose -> RenderPass
getRenderPass = Compose -> RenderPass
renderPass
getFramebuffers :: Compose -> Vector Framebuffer
getFramebuffers = Compose -> Vector Framebuffer
frameBuffers
getClearValues :: Compose -> Vector ClearValue
getClearValues = Compose -> Vector ClearValue
clear
getRenderArea :: Compose -> Rect2D
getRenderArea = Compose -> Rect2D
renderArea
instance RenderPass Compose where
updateRenderpass :: forall env swapchain.
(HasLogFunc env, HasSwapchain swapchain, HasVulkan env,
MonadResource (RIO env)) =>
swapchain -> Compose -> RIO env Compose
updateRenderpass = forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasSwapchain swapchain) =>
swapchain -> Compose -> m Compose
update
refcountRenderpass :: forall env. MonadResource (RIO env) => Compose -> RIO env ()
refcountRenderpass = forall (f :: * -> *). MonadResource f => RefCounted -> f ()
resourceTRefCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose -> RefCounted
release
allocate
:: ( Resource.MonadResource m
, MonadVulkan env m
, HasLogFunc env
, HasSwapchain swapchain
)
=> swapchain
-> m Compose
allocate :: forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
HasSwapchain swapchain) =>
swapchain -> m Compose
allocate swapchain
swapchain = do
RenderPass
renderPass <- forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Format -> m RenderPass
allocateRenderPass Format
format
(RefCounted
refcounted, Vector Framebuffer
framebuffers) <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> m (RefCounted, a)
RefCounted.wrapped forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
Region.run do
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
HasCallStack) =>
Utf8Builder -> Utf8Builder -> ResourceT m ()
Region.logDebug
Utf8Builder
"Allocating Compose resources"
Utf8Builder
"Releasing Compose resources"
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasSwapchain swapchain) =>
swapchain -> RenderPass -> m (Vector Framebuffer)
allocateFramebufferSwapchain swapchain
swapchain RenderPass
renderPass
forall (f :: * -> *) a. Applicative f => a -> f a
pure Compose
{ $sel:renderPass:Compose :: RenderPass
renderPass = RenderPass
renderPass
, $sel:renderArea:Compose :: Rect2D
renderArea = Rect2D
fullSurface
, $sel:clear:Compose :: Vector ClearValue
clear = forall a. Monoid a => a
mempty
, $sel:frameBuffers:Compose :: Vector Framebuffer
frameBuffers = Vector Framebuffer
framebuffers
, $sel:release:Compose :: RefCounted
release = RefCounted
refcounted
}
where
format :: Format
format = forall a. HasSwapchain a => a -> Format
getSurfaceFormat swapchain
swapchain
fullSurface :: Rect2D
fullSurface = Vk.Rect2D
{ $sel:offset:Rect2D :: Offset2D
Vk.offset = forall a. Zero a => a
zero
, $sel:extent:Rect2D :: Extent2D
Vk.extent = forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent swapchain
swapchain
}
update
:: ( Resource.MonadResource m
, MonadVulkan env m
, HasSwapchain swapchain
)
=> swapchain
-> Compose
-> m Compose
update :: forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasSwapchain swapchain) =>
swapchain -> Compose -> m Compose
update swapchain
swapchain old :: Compose
old@Compose{RefCounted
release :: RefCounted
$sel:release:Compose :: Compose -> RefCounted
release, RenderPass
renderPass :: RenderPass
$sel:renderPass:Compose :: Compose -> RenderPass
renderPass} = do
forall (m :: * -> *). MonadIO m => RefCounted -> m ()
releaseRefCounted RefCounted
release
(RefCounted
refcounted, Vector Framebuffer
framebuffers) <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> m (RefCounted, a)
RefCounted.wrapped forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
Region.run do
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasSwapchain swapchain) =>
swapchain -> RenderPass -> m (Vector Framebuffer)
allocateFramebufferSwapchain swapchain
swapchain RenderPass
renderPass
pure Compose
old
{ $sel:frameBuffers:Compose :: Vector Framebuffer
frameBuffers = Vector Framebuffer
framebuffers
, $sel:release:Compose :: RefCounted
release = RefCounted
refcounted
, $sel:renderArea:Compose :: Rect2D
renderArea = Rect2D
fullSurface
}
where
fullSurface :: Rect2D
fullSurface = Vk.Rect2D
{ $sel:offset:Rect2D :: Offset2D
Vk.offset = forall a. Zero a => a
zero
, $sel:extent:Rect2D :: Extent2D
Vk.extent = forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent swapchain
swapchain
}
allocateRenderPass
:: ( MonadVulkan env m
, Resource.MonadResource m
)
=> Vk.Format
-> m Vk.RenderPass
allocateRenderPass :: forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Format -> m RenderPass
allocateRenderPass Format
format = do
Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
(ReleaseKey
_key, RenderPass
rp) <- forall (a :: [*]) (io :: * -> *) r.
(Extendss RenderPassCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> RenderPassCreateInfo a
-> Maybe AllocationCallbacks
-> (io RenderPass -> (RenderPass -> io ()) -> r)
-> r
Vk.withRenderPass Device
device RenderPassCreateInfo '[]
createInfo forall a. Maybe a
Nothing forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
forall a (m :: * -> *).
(HasObjectType a, MonadIO m) =>
Device -> a -> ByteString -> m ()
Debug.nameObject Device
device RenderPass
rp ByteString
"Compose"
pure RenderPass
rp
where
createInfo :: RenderPassCreateInfo '[]
createInfo = forall a. Zero a => a
zero
{ $sel:attachments:RenderPassCreateInfo :: Vector AttachmentDescription
Vk.attachments = [AttachmentDescription
color]
, $sel:subpasses:RenderPassCreateInfo :: Vector SubpassDescription
Vk.subpasses = [SubpassDescription
subpass]
, $sel:dependencies:RenderPassCreateInfo :: Vector SubpassDependency
Vk.dependencies = [SubpassDependency
colorDeps]
}
color :: AttachmentDescription
color = forall a. Zero a => a
zero
{ $sel:format:AttachmentDescription :: Format
Vk.format = Format
format
, $sel:samples:AttachmentDescription :: SampleCountFlagBits
Vk.samples = SampleCountFlagBits
Vk.SAMPLE_COUNT_1_BIT
, $sel:loadOp:AttachmentDescription :: AttachmentLoadOp
Vk.loadOp = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_DONT_CARE
, $sel:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout = ImageLayout
Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
}
subpass :: SubpassDescription
subpass = forall a. Zero a => a
zero
{ $sel:pipelineBindPoint:SubpassDescription :: PipelineBindPoint
Vk.pipelineBindPoint =
PipelineBindPoint
Vk.PIPELINE_BIND_POINT_GRAPHICS
, $sel:colorAttachments:SubpassDescription :: Vector AttachmentReference
Vk.colorAttachments = forall a. a -> Vector a
Vector.singleton forall a. Zero a => a
zero
{ $sel:attachment:AttachmentReference :: Word32
Vk.attachment = Word32
0
, $sel:layout:AttachmentReference :: ImageLayout
Vk.layout = ImageLayout
Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
}
}
colorDeps :: SubpassDependency
colorDeps = forall a. Zero a => a
zero
{ $sel:srcSubpass:SubpassDependency :: Word32
Vk.srcSubpass = Word32
Vk.SUBPASS_EXTERNAL
, $sel:dstSubpass:SubpassDependency :: Word32
Vk.dstSubpass = Word32
0
, $sel:srcStageMask:SubpassDependency :: PipelineStageFlags
Vk.srcStageMask = PipelineStageFlags
colorOut
, $sel:srcAccessMask:SubpassDependency :: AccessFlags
Vk.srcAccessMask = forall a. Zero a => a
zero
, $sel:dstStageMask:SubpassDependency :: PipelineStageFlags
Vk.dstStageMask = PipelineStageFlags
colorOut
, $sel:dstAccessMask:SubpassDependency :: AccessFlags
Vk.dstAccessMask = AccessFlags
colorRW
}
where
colorOut :: PipelineStageFlags
colorOut =
PipelineStageFlags
Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
colorRW :: AccessFlags
colorRW =
AccessFlags
Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT forall a. Bits a => a -> a -> a
.|.
AccessFlags
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT
allocateFramebufferSwapchain
:: ( Resource.MonadResource m
, MonadVulkan env m
, HasSwapchain swapchain
)
=> swapchain
-> Vk.RenderPass
-> m (Vector Vk.Framebuffer)
allocateFramebufferSwapchain :: forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasSwapchain swapchain) =>
swapchain -> RenderPass -> m (Vector Framebuffer)
allocateFramebufferSwapchain swapchain
swapchain RenderPass
renderPass =
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m (Vector b)
Vector.iforM (forall a. HasSwapchain a => a -> Vector ImageView
getSwapchainViews swapchain
swapchain) \Int
ix ImageView
colorView -> do
let
fbCI :: FramebufferCreateInfo '[]
fbCI = forall a. Zero a => a
zero
{ $sel:renderPass:FramebufferCreateInfo :: RenderPass
Vk.renderPass = RenderPass
renderPass
, $sel:width:FramebufferCreateInfo :: Word32
Vk.width = Word32
width
, $sel:height:FramebufferCreateInfo :: Word32
Vk.height = Word32
height
, $sel:attachments:FramebufferCreateInfo :: Vector ImageView
Vk.attachments = [ImageView
colorView]
, $sel:layers:FramebufferCreateInfo :: Word32
Vk.layers = Word32
1
}
Device
device <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. HasVulkan a => a -> Device
getDevice
(ReleaseKey
_key, Framebuffer
fb) <- forall (a :: [*]) (io :: * -> *) r.
(Extendss FramebufferCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> FramebufferCreateInfo a
-> Maybe AllocationCallbacks
-> (io Framebuffer -> (Framebuffer -> io ()) -> r)
-> r
Vk.withFramebuffer Device
device FramebufferCreateInfo '[]
fbCI forall a. Maybe a
Nothing forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
forall a (m :: * -> *).
(HasObjectType a, MonadIO m) =>
Device -> a -> ByteString -> m ()
Debug.nameObject Device
device Framebuffer
fb forall a b. (a -> b) -> a -> b
$
ByteString
"Compose.FB:" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show @Int Int
ix)
pure Framebuffer
fb
where
Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent swapchain
swapchain