module Render.ForwardMsaa where

import RIO

import Control.Monad.Trans.Resource qualified as Resource
import Data.Bits ((.|.))
import Data.Vector qualified as Vector
import RIO.Vector.Partial ((!))
import Vulkan.Core10 qualified as Vk
import Vulkan.Utils.Debug qualified as Debug
import Vulkan.Zero (zero)

import Engine.Types.RefCounted (RefCounted, newRefCounted, releaseRefCounted, resourceTRefCount)
import Engine.Vulkan.Types (HasVulkan(..), HasSwapchain(..), HasRenderPass(..), RenderPass(..), MonadVulkan)
import Resource.Image (AllocatedImage)
import Resource.Image qualified as Image

-- * Simple MSAA-enabled pass

data ForwardMsaa = ForwardMsaa
  { ForwardMsaa -> RenderPass
fmRenderPass   :: Vk.RenderPass
  , ForwardMsaa -> AllocatedImage
fmColor        :: AllocatedImage
  , ForwardMsaa -> AllocatedImage
fmDepth        :: AllocatedImage
  , ForwardMsaa -> Vector Framebuffer
fmFrameBuffers :: Vector Vk.Framebuffer
  , ForwardMsaa -> Rect2D
fmRenderArea   :: Vk.Rect2D
  , ForwardMsaa -> Vector ClearValue
fmClear        :: Vector Vk.ClearValue
  , ForwardMsaa -> RefCounted
fmRelease      :: RefCounted
  }

instance HasRenderPass ForwardMsaa where
  getRenderPass :: ForwardMsaa -> RenderPass
getRenderPass          = ForwardMsaa -> RenderPass
fmRenderPass
  getFramebuffers :: ForwardMsaa -> Vector Framebuffer
getFramebuffers        = ForwardMsaa -> Vector Framebuffer
fmFrameBuffers
  getClearValues :: ForwardMsaa -> Vector ClearValue
getClearValues         = ForwardMsaa -> Vector ClearValue
fmClear
  getRenderArea :: ForwardMsaa -> Rect2D
getRenderArea          = ForwardMsaa -> Rect2D
fmRenderArea

instance RenderPass ForwardMsaa where
  allocateRenderpass_ :: context -> ResourceT (RIO env) ForwardMsaa
allocateRenderpass_ = context -> ResourceT (RIO env) ForwardMsaa
forall (m :: * -> *) env context.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain context) =>
context -> m ForwardMsaa
allocateMsaa -- error "Thou shalt allocateMsaa instead"

  updateRenderpass :: context -> ForwardMsaa -> RIO env ForwardMsaa
updateRenderpass = context -> ForwardMsaa -> RIO env ForwardMsaa
forall (m :: * -> *) env context.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain context) =>
context -> ForwardMsaa -> m ForwardMsaa
updateMsaa

  refcountRenderpass :: ForwardMsaa -> RIO env ()
refcountRenderpass = RefCounted -> RIO env ()
forall (f :: * -> *). MonadResource f => RefCounted -> f ()
resourceTRefCount (RefCounted -> RIO env ())
-> (ForwardMsaa -> RefCounted) -> ForwardMsaa -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForwardMsaa -> RefCounted
fmRelease

allocateMsaa
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     , HasSwapchain context
     )
  => context
  -> m ForwardMsaa
allocateMsaa :: context -> m ForwardMsaa
allocateMsaa context
context = do
  Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Allocating ForwardMsaa resources"
  (ReleaseKey
_rpKey, RenderPass
renderPass) <- context -> m (ReleaseKey, RenderPass)
forall env (m :: * -> *) context.
(MonadVulkan env m, MonadResource m, HasSwapchain context) =>
context -> m (ReleaseKey, RenderPass)
allocateRenderPassMsaa context
context
  (RefCounted
refcounted, AllocatedImage
color, AllocatedImage
depth, Vector Framebuffer
framebuffers) <- context
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage,
      Vector Framebuffer)
forall (m :: * -> *) env context.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain context) =>
context
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage,
      Vector Framebuffer)
allocateFramebufferMsaa context
context RenderPass
renderPass

  pure ForwardMsaa :: RenderPass
-> AllocatedImage
-> AllocatedImage
-> Vector Framebuffer
-> Rect2D
-> Vector ClearValue
-> RefCounted
-> ForwardMsaa
ForwardMsaa
    { $sel:fmRenderPass:ForwardMsaa :: RenderPass
fmRenderPass   = RenderPass
renderPass
    , $sel:fmRenderArea:ForwardMsaa :: Rect2D
fmRenderArea   = Rect2D
fullSurface
    , $sel:fmClear:ForwardMsaa :: Vector ClearValue
fmClear        = Vector ClearValue
clear
    , $sel:fmColor:ForwardMsaa :: AllocatedImage
fmColor        = AllocatedImage
color
    , $sel:fmDepth:ForwardMsaa :: AllocatedImage
fmDepth        = AllocatedImage
depth
    , $sel:fmFrameBuffers:ForwardMsaa :: Vector Framebuffer
fmFrameBuffers = Vector Framebuffer
framebuffers
    , $sel:fmRelease:ForwardMsaa :: RefCounted
fmRelease      = RefCounted
refcounted
    }
  where
    fullSurface :: Rect2D
fullSurface = Rect2D :: Offset2D -> Extent2D -> Rect2D
Vk.Rect2D
      { $sel:offset:Rect2D :: Offset2D
Vk.offset = Offset2D
forall a. Zero a => a
zero
      , $sel:extent:Rect2D :: Extent2D
Vk.extent = context -> Extent2D
forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent context
context
      }
    clear :: Vector ClearValue
clear = [ClearValue] -> Vector ClearValue
forall a. [a] -> Vector a
Vector.fromList
      [ ClearValue
clearColor
      , ClearDepthStencilValue -> ClearValue
Vk.DepthStencil (Float -> Word32 -> ClearDepthStencilValue
Vk.ClearDepthStencilValue Float
1.0 Word32
0)
      , ClearValue
clearColor
      ]
    clearColor :: ClearValue
clearColor = ClearColorValue -> ClearValue
Vk.Color ClearColorValue
forall a. Zero a => a
zero

updateMsaa
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     , HasSwapchain context
     )
  => context
  -> ForwardMsaa
  -> m ForwardMsaa
updateMsaa :: context -> ForwardMsaa -> m ForwardMsaa
updateMsaa context
context old :: ForwardMsaa
old@ForwardMsaa{RefCounted
fmRelease :: RefCounted
$sel:fmRelease:ForwardMsaa :: ForwardMsaa -> RefCounted
fmRelease, RenderPass
fmRenderPass :: RenderPass
$sel:fmRenderPass:ForwardMsaa :: ForwardMsaa -> RenderPass
fmRenderPass} = do
  RefCounted -> m ()
forall (m :: * -> *). MonadIO m => RefCounted -> m ()
releaseRefCounted RefCounted
fmRelease
  (RefCounted
refcounted, AllocatedImage
color, AllocatedImage
depth, Vector Framebuffer
framebuffers) <- context
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage,
      Vector Framebuffer)
forall (m :: * -> *) env context.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain context) =>
context
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage,
      Vector Framebuffer)
allocateFramebufferMsaa context
context RenderPass
fmRenderPass
  pure ForwardMsaa
old
    { $sel:fmColor:ForwardMsaa :: AllocatedImage
fmColor        = AllocatedImage
color
    , $sel:fmDepth:ForwardMsaa :: AllocatedImage
fmDepth        = AllocatedImage
depth
    , $sel:fmFrameBuffers:ForwardMsaa :: Vector Framebuffer
fmFrameBuffers = Vector Framebuffer
framebuffers
    , $sel:fmRelease:ForwardMsaa :: RefCounted
fmRelease      = RefCounted
refcounted
    , $sel:fmRenderArea:ForwardMsaa :: Rect2D
fmRenderArea   = Rect2D
fullSurface
    }
  where
    fullSurface :: Rect2D
fullSurface = Rect2D :: Offset2D -> Extent2D -> Rect2D
Vk.Rect2D
      { $sel:offset:Rect2D :: Offset2D
Vk.offset = Offset2D
forall a. Zero a => a
zero
      , $sel:extent:Rect2D :: Extent2D
Vk.extent = context -> Extent2D
forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent context
context
      }

-- ** Render pass

allocateRenderPassMsaa
  :: ( MonadVulkan env m
     , Resource.MonadResource m
     , HasSwapchain context
     )
  => context
  -> m (Resource.ReleaseKey, Vk.RenderPass)
allocateRenderPassMsaa :: context -> m (ReleaseKey, RenderPass)
allocateRenderPassMsaa context
context = 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
  let
    format :: Format
format = context -> Format
forall a. HasSwapchain a => a -> Format
getSurfaceFormat context
context
    depthFormat :: Format
depthFormat = context -> Format
forall a. HasSwapchain a => a -> Format
getDepthFormat context
context
    msaa :: SampleCountFlagBits
msaa = context -> SampleCountFlagBits
forall a. HasSwapchain a => a -> SampleCountFlagBits
getMultisample context
context

    attachments :: [AttachmentDescription]
attachments =
      [ Format -> SampleCountFlagBits -> AttachmentDescription
color Format
format SampleCountFlagBits
msaa
      , Format -> SampleCountFlagBits -> AttachmentDescription
depth Format
depthFormat SampleCountFlagBits
msaa
      , Format -> AttachmentDescription
colorResolve Format
format
      ]

  res :: (ReleaseKey, RenderPass)
res@(ReleaseKey
_key, RenderPass
object) <- Device
-> RenderPassCreateInfo '[]
-> Maybe AllocationCallbacks
-> (IO RenderPass
    -> (RenderPass -> IO ()) -> m (ReleaseKey, RenderPass))
-> m (ReleaseKey, RenderPass)
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 ([AttachmentDescription] -> RenderPassCreateInfo '[]
createInfo [AttachmentDescription]
attachments) Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO RenderPass
-> (RenderPass -> IO ()) -> m (ReleaseKey, RenderPass)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
  Device -> RenderPass -> ByteString -> m ()
forall a (m :: * -> *).
(HasObjectType a, MonadIO m) =>
Device -> a -> ByteString -> m ()
Debug.nameObject Device
device RenderPass
object ByteString
"ForwardMSAA"
  pure (ReleaseKey, RenderPass)
res
  where
    createInfo :: [AttachmentDescription] -> RenderPassCreateInfo '[]
createInfo [AttachmentDescription]
attachments = RenderPassCreateInfo '[]
forall a. Zero a => a
zero
      { $sel:attachments:RenderPassCreateInfo :: Vector AttachmentDescription
Vk.attachments  = [AttachmentDescription] -> Vector AttachmentDescription
forall a. [a] -> Vector a
Vector.fromList [AttachmentDescription]
attachments
      , $sel:subpasses:RenderPassCreateInfo :: Vector SubpassDescription
Vk.subpasses    = [SubpassDescription] -> Vector SubpassDescription
forall a. [a] -> Vector a
Vector.fromList [SubpassDescription
subpass]
      , $sel:dependencies:RenderPassCreateInfo :: Vector SubpassDependency
Vk.dependencies = [SubpassDependency] -> Vector SubpassDependency
forall a. [a] -> Vector a
Vector.fromList [SubpassDependency
colorDeps, SubpassDependency
depthDeps]
      }

    color :: Format -> SampleCountFlagBits -> AttachmentDescription
color Format
format SampleCountFlagBits
msaa = AttachmentDescription
forall a. Zero a => a
zero
      { $sel:format:AttachmentDescription :: Format
Vk.format         = Format
format
      , $sel:samples:AttachmentDescription :: SampleCountFlagBits
Vk.samples        = SampleCountFlagBits
msaa
      , $sel:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout    = ImageLayout
Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
      , $sel:loadOp:AttachmentDescription :: AttachmentLoadOp
Vk.loadOp         = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_CLEAR
      , $sel:storeOp:AttachmentDescription :: AttachmentStoreOp
Vk.storeOp        = AttachmentStoreOp
Vk.ATTACHMENT_STORE_OP_DONT_CARE
      , $sel:stencilLoadOp:AttachmentDescription :: AttachmentLoadOp
Vk.stencilLoadOp  = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_DONT_CARE
      , $sel:stencilStoreOp:AttachmentDescription :: AttachmentStoreOp
Vk.stencilStoreOp = AttachmentStoreOp
Vk.ATTACHMENT_STORE_OP_DONT_CARE
      , $sel:initialLayout:AttachmentDescription :: ImageLayout
Vk.initialLayout  = ImageLayout
Vk.IMAGE_LAYOUT_UNDEFINED
      }

    depth :: Format -> SampleCountFlagBits -> AttachmentDescription
depth Format
format SampleCountFlagBits
msaa = AttachmentDescription
forall a. Zero a => a
zero
      { $sel:format:AttachmentDescription :: Format
Vk.format         = Format
format
      , $sel:samples:AttachmentDescription :: SampleCountFlagBits
Vk.samples        = SampleCountFlagBits
msaa
      , $sel:loadOp:AttachmentDescription :: AttachmentLoadOp
Vk.loadOp         = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_CLEAR
      , $sel:storeOp:AttachmentDescription :: AttachmentStoreOp
Vk.storeOp        = AttachmentStoreOp
Vk.ATTACHMENT_STORE_OP_DONT_CARE
      , $sel:stencilLoadOp:AttachmentDescription :: AttachmentLoadOp
Vk.stencilLoadOp  = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_DONT_CARE
      , $sel:stencilStoreOp:AttachmentDescription :: AttachmentStoreOp
Vk.stencilStoreOp = AttachmentStoreOp
Vk.ATTACHMENT_STORE_OP_DONT_CARE
      , $sel:initialLayout:AttachmentDescription :: ImageLayout
Vk.initialLayout  = ImageLayout
Vk.IMAGE_LAYOUT_UNDEFINED
      , $sel:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout    = ImageLayout
Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL
      }

    colorResolve :: Format -> AttachmentDescription
colorResolve Format
format = AttachmentDescription
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:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout = ImageLayout
Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
      , $sel:loadOp:AttachmentDescription :: AttachmentLoadOp
Vk.loadOp      = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_DONT_CARE
      }

    subpass :: SubpassDescription
subpass = SubpassDescription
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 = AttachmentReference -> Vector AttachmentReference
forall a. a -> Vector a
Vector.singleton AttachmentReference
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
          }
      , $sel:depthStencilAttachment:SubpassDescription :: Maybe AttachmentReference
Vk.depthStencilAttachment = AttachmentReference -> Maybe AttachmentReference
forall a. a -> Maybe a
Just AttachmentReference
forall a. Zero a => a
zero
          { $sel:attachment:AttachmentReference :: Word32
Vk.attachment = Word32
1
          , $sel:layout:AttachmentReference :: ImageLayout
Vk.layout     = ImageLayout
Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL
          }
      , $sel:resolveAttachments:SubpassDescription :: Vector AttachmentReference
Vk.resolveAttachments = AttachmentReference -> Vector AttachmentReference
forall a. a -> Vector a
Vector.singleton AttachmentReference
forall a. Zero a => a
zero
          { $sel:attachment:AttachmentReference :: Word32
Vk.attachment = Word32
2
          , $sel:layout:AttachmentReference :: ImageLayout
Vk.layout     = ImageLayout
Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
          }
      }

    colorDeps :: SubpassDependency
colorDeps = SubpassDependency
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 = AccessFlags
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 AccessFlags -> AccessFlags -> AccessFlags
forall a. Bits a => a -> a -> a
.|.
          AccessFlags
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT

    depthDeps :: SubpassDependency
depthDeps = SubpassDependency
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
fragTests
      , $sel:srcAccessMask:SubpassDependency :: AccessFlags
Vk.srcAccessMask = AccessFlags
depthW
      , $sel:dstStageMask:SubpassDependency :: PipelineStageFlags
Vk.dstStageMask  = PipelineStageFlags
fragTests
      , $sel:dstAccessMask:SubpassDependency :: AccessFlags
Vk.dstAccessMask = AccessFlags
depthRW
      }
      where
        fragTests :: PipelineStageFlags
fragTests =
          PipelineStageFlags
Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT PipelineStageFlags -> PipelineStageFlags -> PipelineStageFlags
forall a. Bits a => a -> a -> a
.|.
          PipelineStageFlags
Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT

        depthW :: AccessFlags
depthW =
          AccessFlags
Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT

        depthRW :: AccessFlags
depthRW =
          AccessFlags
Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_READ_BIT AccessFlags -> AccessFlags -> AccessFlags
forall a. Bits a => a -> a -> a
.|.
          AccessFlags
depthW

-- ** Framebuffer

type FramebuffersMsaa =
  ( RefCounted
  , Image.AllocatedImage
  , Image.AllocatedImage
  , Vector Vk.Framebuffer
  )

allocateFramebufferMsaa
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     , HasSwapchain context
     )
  => context
  -> Vk.RenderPass
  -> m FramebuffersMsaa
allocateFramebufferMsaa :: context
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage,
      Vector Framebuffer)
allocateFramebufferMsaa context
context RenderPass
renderPass = 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
  (env, context)
context' <- (env -> (env, context)) -> m (env, context)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (, context
context)
  let extent :: Extent2D
extent@Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = context -> Extent2D
forall a. HasSwapchain a => a -> Extent2D
getSurfaceExtent context
context

  (ReleaseKey
colorKey, AllocatedImage
color) <- IO AllocatedImage
-> (AllocatedImage -> IO ()) -> m (ReleaseKey, AllocatedImage)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
    ((env, context) -> Extent2D -> IO AllocatedImage
forall (io :: * -> *) ctx.
(MonadIO io, HasVulkan ctx, HasSwapchain ctx) =>
ctx -> Extent2D -> io AllocatedImage
Image.createColorResource (env, context)
context' Extent2D
extent)
    ((env, context) -> AllocatedImage -> IO ()
forall (io :: * -> *) context.
(MonadIO io, HasVulkan context) =>
context -> AllocatedImage -> io ()
Image.destroyAllocatedImage (env, context)
context')

  (ReleaseKey
depthKey, AllocatedImage
depth) <- IO AllocatedImage
-> (AllocatedImage -> IO ()) -> m (ReleaseKey, AllocatedImage)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate
    ((env, context)
-> Extent2D
-> ("shadowmap layers" ::: Maybe Word32)
-> IO AllocatedImage
forall (io :: * -> *) context.
(MonadIO io, HasVulkan context, HasSwapchain context) =>
context
-> Extent2D
-> ("shadowmap layers" ::: Maybe Word32)
-> io AllocatedImage
Image.createDepthResource (env, context)
context' Extent2D
extent "shadowmap layers" ::: Maybe Word32
forall a. Maybe a
Nothing)
    ((env, context) -> AllocatedImage -> IO ()
forall (io :: * -> *) context.
(MonadIO io, HasVulkan context) =>
context -> AllocatedImage -> io ()
Image.destroyAllocatedImage (env, context)
context')

  Vector (ReleaseKey, Framebuffer)
perView <- Vector ImageView
-> (ImageView -> m (ReleaseKey, Framebuffer))
-> m (Vector (ReleaseKey, Framebuffer))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (context -> Vector ImageView
forall a. HasSwapchain a => a -> Vector ImageView
getSwapchainViews context
context) \ImageView
colorResolve -> do
    let
      attachments :: Vector ImageView
attachments = [ImageView] -> Vector ImageView
forall a. [a] -> Vector a
Vector.fromList
        [ AllocatedImage -> ImageView
Image.aiImageView AllocatedImage
color
        , AllocatedImage -> ImageView
Image.aiImageView AllocatedImage
depth
        , ImageView
colorResolve
        ]

      fbCI :: FramebufferCreateInfo '[]
fbCI = FramebufferCreateInfo '[]
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 = Vector ImageView
attachments
        , $sel:layers:FramebufferCreateInfo :: Word32
Vk.layers      = Word32
1
        }

    Device
-> FramebufferCreateInfo '[]
-> Maybe AllocationCallbacks
-> (IO Framebuffer
    -> (Framebuffer -> IO ()) -> m (ReleaseKey, Framebuffer))
-> m (ReleaseKey, Framebuffer)
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 Maybe AllocationCallbacks
forall a. Maybe a
Nothing IO Framebuffer
-> (Framebuffer -> IO ()) -> m (ReleaseKey, Framebuffer)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
Resource.allocate

  let (Vector ReleaseKey
framebufferKeys, Vector Framebuffer
framebuffers) = Vector (ReleaseKey, Framebuffer)
-> (Vector ReleaseKey, Vector Framebuffer)
forall a b. Vector (a, b) -> (Vector a, Vector b)
Vector.unzip Vector (ReleaseKey, Framebuffer)
perView
  IO ()
releaseDebug <- m () -> m (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (m () -> m (IO ())) -> m () -> m (IO ())
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Releasing ForwardMsaa resources"
  RefCounted
release <- IO () -> m RefCounted
forall (m :: * -> *). MonadIO m => IO () -> m RefCounted
newRefCounted do
    IO ()
releaseDebug
    ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
colorKey
    ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
depthKey
    (ReleaseKey -> IO ()) -> Vector ReleaseKey -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release Vector ReleaseKey
framebufferKeys

  pure (RefCounted
release, AllocatedImage
color, AllocatedImage
depth, Vector Framebuffer
framebuffers)

usePass :: (MonadIO io, HasRenderPass a) => a -> Word32 -> Vk.CommandBuffer -> io r -> io r
usePass :: a -> Word32 -> CommandBuffer -> io r -> io r
usePass a
render Word32
imageIndex CommandBuffer
cb =
  CommandBuffer
-> RenderPassBeginInfo '[] -> SubpassContents -> io r -> io r
forall (a :: [*]) (io :: * -> *) r.
(Extendss RenderPassBeginInfo a, PokeChain a, MonadIO io) =>
CommandBuffer
-> RenderPassBeginInfo a -> SubpassContents -> io r -> io r
Vk.cmdUseRenderPass
    CommandBuffer
cb
    (a -> Word32 -> RenderPassBeginInfo '[]
forall a. HasRenderPass a => a -> Word32 -> RenderPassBeginInfo '[]
beginInfo a
render Word32
imageIndex)
    SubpassContents
Vk.SUBPASS_CONTENTS_INLINE

beginInfo :: HasRenderPass a => a -> Word32 -> Vk.RenderPassBeginInfo '[]
beginInfo :: a -> Word32 -> RenderPassBeginInfo '[]
beginInfo a
rp Word32
imageIndex = RenderPassBeginInfo '[]
forall a. Zero a => a
zero
  { $sel:renderPass:RenderPassBeginInfo :: RenderPass
Vk.renderPass  = a -> RenderPass
forall a. HasRenderPass a => a -> RenderPass
getRenderPass a
rp
  , $sel:framebuffer:RenderPassBeginInfo :: Framebuffer
Vk.framebuffer = a -> Vector Framebuffer
forall a. HasRenderPass a => a -> Vector Framebuffer
getFramebuffers a
rp Vector Framebuffer -> Int -> Framebuffer
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
imageIndex
  , $sel:renderArea:RenderPassBeginInfo :: Rect2D
Vk.renderArea  = a -> Rect2D
forall a. HasRenderPass a => a -> Rect2D
getRenderArea a
rp
  , $sel:clearValues:RenderPassBeginInfo :: Vector ClearValue
Vk.clearValues = a -> Vector ClearValue
forall a. HasRenderPass a => a -> Vector ClearValue
getClearValues a
rp
  }