{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Render.Pass.Offscreen
  ( Settings(..)
  , allocate
  , Offscreen(..)
  , colorTexture
  , colorCube
  , depthTexture
  , depthCube
  ) where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
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.Core11.Promoted_From_VK_KHR_multiview qualified as Khr
import Vulkan.CStruct.Extends (pattern (:&), pattern (::&))
import Vulkan.Utils.Debug qualified as Debug
import Vulkan.Zero (zero)

import Engine.Types.RefCounted (RefCounted)
import Engine.Types.RefCounted qualified as RefCounted
import Engine.Vulkan.Types (HasVulkan(..), HasRenderPass(..), RenderPass(..), MonadVulkan)
import Resource.Image (AllocatedImage)
import Resource.Image qualified as Image
import Resource.Region qualified as Region
import Resource.Texture (CubeMap, Flat, Texture(..))
import Resource.Vulkan.Named qualified as Named

{- XXX: Consider spec wrt. parameters and intended use!

https://www.khronos.org/registry/vulkan/specs/1.2-extensions/man/html/vkCmdBlitImage.html
-}
data Settings = Settings
  { Settings -> Text
sLabel       :: Text
  , Settings -> Extent2D
sExtent      :: Vk.Extent2D
  , Settings -> Format
sFormat      :: Vk.Format
  , Settings -> Maybe ImageLayout
sColorLayout :: Maybe Vk.ImageLayout -- ^ Target color format when used for export.
  , Settings -> Format
sDepthFormat :: Vk.Format
  , Settings -> Maybe ImageLayout
sDepthLayout :: Maybe Vk.ImageLayout -- ^ Target depth format when used for export.
  , Settings -> Word32
sLayers      :: Word32
  , Settings -> Bool
sMultiView   :: Bool -- ^ Makes sense only for multiple layers.
  , Settings -> SampleCountFlagBits
sSamples     :: Vk.SampleCountFlagBits -- ^ Multisample prevents mipmapping and cubes.
  , Settings -> Bool
sMipMap      :: Bool
  }
  deriving (Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
/= :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show)

data Offscreen = Offscreen
  { Offscreen -> RenderPass
oRenderPass  :: Vk.RenderPass
  , Offscreen -> Extent2D
oExtent      :: Vk.Extent2D
  , Offscreen -> AllocatedImage
oColor       :: AllocatedImage
  , Offscreen -> AllocatedImage
oDepth       :: AllocatedImage
  , Offscreen -> Word32
oLayers      :: Word32
  , Offscreen -> Word32
oMipLevels   :: Word32

  , Offscreen -> Framebuffer
oFrameBuffer :: Vk.Framebuffer
  , Offscreen -> Rect2D
oRenderArea  :: Vk.Rect2D
  , Offscreen -> Vector ClearValue
oClear       :: Vector Vk.ClearValue
  , Offscreen -> RefCounted
oRelease     :: RefCounted
  }

instance HasRenderPass Offscreen where
  getRenderPass :: Offscreen -> RenderPass
getRenderPass   = Offscreen -> RenderPass
oRenderPass
  getFramebuffers :: Offscreen -> Vector Framebuffer
getFramebuffers = Int -> Framebuffer -> Vector Framebuffer
forall a. Int -> a -> Vector a
Vector.replicate Int
10 (Framebuffer -> Vector Framebuffer)
-> (Offscreen -> Framebuffer) -> Offscreen -> Vector Framebuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offscreen -> Framebuffer
oFrameBuffer
  getClearValues :: Offscreen -> Vector ClearValue
getClearValues  = Offscreen -> Vector ClearValue
oClear
  getRenderArea :: Offscreen -> Rect2D
getRenderArea   = Offscreen -> Rect2D
oRenderArea

instance RenderPass Offscreen where
  refcountRenderpass :: forall env. MonadResource (RIO env) => Offscreen -> RIO env ()
refcountRenderpass = RefCounted -> RIO env ()
forall (f :: * -> *). MonadResource f => RefCounted -> f ()
RefCounted.resourceTRefCount (RefCounted -> RIO env ())
-> (Offscreen -> RefCounted) -> Offscreen -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offscreen -> RefCounted
oRelease

colorTexture :: Offscreen -> Texture Flat
colorTexture :: Offscreen -> Texture Flat
colorTexture Offscreen{Word32
Vector ClearValue
Rect2D
Extent2D
RenderPass
Framebuffer
RefCounted
AllocatedImage
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
oRenderPass :: RenderPass
oExtent :: Extent2D
oColor :: AllocatedImage
oDepth :: AllocatedImage
oLayers :: Word32
oMipLevels :: Word32
oFrameBuffer :: Framebuffer
oRenderArea :: Rect2D
oClear :: Vector ClearValue
oRelease :: RefCounted
..} = Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage
oColor.aiFormat
  , $sel:tMipLevels:Texture :: Word32
tMipLevels      = Word32
oMipLevels
  , $sel:tLayers:Texture :: Word32
tLayers         = Word32
oLayers
  , $sel:tAllocatedImage:Texture :: AllocatedImage
tAllocatedImage = AllocatedImage
oColor
  }

colorCube :: Offscreen -> Texture CubeMap
colorCube :: Offscreen -> Texture CubeMap
colorCube Offscreen{Word32
Vector ClearValue
Rect2D
Extent2D
RenderPass
Framebuffer
RefCounted
AllocatedImage
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
oRenderPass :: RenderPass
oExtent :: Extent2D
oColor :: AllocatedImage
oDepth :: AllocatedImage
oLayers :: Word32
oMipLevels :: Word32
oFrameBuffer :: Framebuffer
oRenderArea :: Rect2D
oClear :: Vector ClearValue
oRelease :: RefCounted
..} = Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage
oColor.aiFormat
  , $sel:tMipLevels:Texture :: Word32
tMipLevels      = Word32
oMipLevels
  , $sel:tLayers:Texture :: Word32
tLayers         = Word32
oLayers -- TODO: get from type param
  , $sel:tAllocatedImage:Texture :: AllocatedImage
tAllocatedImage = AllocatedImage
oColor
  }

depthTexture :: Offscreen -> Texture Flat
depthTexture :: Offscreen -> Texture Flat
depthTexture Offscreen{Word32
Vector ClearValue
Rect2D
Extent2D
RenderPass
Framebuffer
RefCounted
AllocatedImage
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
oRenderPass :: RenderPass
oExtent :: Extent2D
oColor :: AllocatedImage
oDepth :: AllocatedImage
oLayers :: Word32
oMipLevels :: Word32
oFrameBuffer :: Framebuffer
oRenderArea :: Rect2D
oClear :: Vector ClearValue
oRelease :: RefCounted
..} = Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage
oDepth.aiFormat
  , $sel:tMipLevels:Texture :: Word32
tMipLevels      = Word32
oMipLevels
  , $sel:tLayers:Texture :: Word32
tLayers         = Word32
oLayers
  , $sel:tAllocatedImage:Texture :: AllocatedImage
tAllocatedImage = AllocatedImage
oDepth
  }

depthCube :: Offscreen -> Texture CubeMap
depthCube :: Offscreen -> Texture CubeMap
depthCube Offscreen{Word32
Vector ClearValue
Rect2D
Extent2D
RenderPass
Framebuffer
RefCounted
AllocatedImage
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
oRenderPass :: RenderPass
oExtent :: Extent2D
oColor :: AllocatedImage
oDepth :: AllocatedImage
oLayers :: Word32
oMipLevels :: Word32
oFrameBuffer :: Framebuffer
oRenderArea :: Rect2D
oClear :: Vector ClearValue
oRelease :: RefCounted
..} = Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage
oDepth.aiFormat
  , $sel:tMipLevels:Texture :: Word32
tMipLevels      = Word32
oMipLevels
  , $sel:tLayers:Texture :: Word32
tLayers         = Word32
oLayers -- TODO: get from type param
  , $sel:tAllocatedImage:Texture :: AllocatedImage
tAllocatedImage = AllocatedImage
oDepth
  }

allocate
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     )
  => Settings
  -> m Offscreen
allocate :: forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
Settings -> m Offscreen
allocate settings :: Settings
settings@Settings{Bool
Maybe ImageLayout
Word32
Text
Extent2D
SampleCountFlagBits
Format
$sel:sLabel:Settings :: Settings -> Text
$sel:sExtent:Settings :: Settings -> Extent2D
$sel:sFormat:Settings :: Settings -> Format
$sel:sColorLayout:Settings :: Settings -> Maybe ImageLayout
$sel:sDepthFormat:Settings :: Settings -> Format
$sel:sDepthLayout:Settings :: Settings -> Maybe ImageLayout
$sel:sLayers:Settings :: Settings -> Word32
$sel:sMultiView:Settings :: Settings -> Bool
$sel:sSamples:Settings :: Settings -> SampleCountFlagBits
$sel:sMipMap:Settings :: Settings -> Bool
sLabel :: Text
sExtent :: Extent2D
sFormat :: Format
sColorLayout :: Maybe ImageLayout
sDepthFormat :: Format
sDepthLayout :: Maybe ImageLayout
sLayers :: Word32
sMultiView :: Bool
sSamples :: SampleCountFlagBits
sMipMap :: Bool
..} = do
  (ReleaseKey
_passKey, RenderPass
renderPass) <- Settings -> m (ReleaseKey, RenderPass)
forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Settings -> m (ReleaseKey, RenderPass)
allocateRenderPass Settings
settings

  (RefCounted
release, FramebufferOffscreen
resources) <- m (ReleaseKey, FramebufferOffscreen)
-> m (RefCounted, FramebufferOffscreen)
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> m (RefCounted, a)
RefCounted.wrapped (m (ReleaseKey, FramebufferOffscreen)
 -> m (RefCounted, FramebufferOffscreen))
-> m (ReleaseKey, FramebufferOffscreen)
-> m (RefCounted, FramebufferOffscreen)
forall a b. (a -> b) -> a -> b
$ ResourceT m FramebufferOffscreen
-> m (ReleaseKey, FramebufferOffscreen)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
Region.run do
    Utf8Builder -> Utf8Builder -> ResourceT m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasCallStack) =>
Utf8Builder -> Utf8Builder -> ResourceT m ()
Region.logDebug
      (Utf8Builder
"Allocating Offscreen resources for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
sLabel)
      (Utf8Builder
"Releasing Offscreen resources for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
sLabel)
    Settings -> RenderPass -> ResourceT m FramebufferOffscreen
forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
Settings -> RenderPass -> ResourceT m FramebufferOffscreen
allocateFramebuffer Settings
settings RenderPass
renderPass
  let (AllocatedImage
color, AllocatedImage
depth, Framebuffer
framebuffer) = FramebufferOffscreen
resources

  Offscreen -> m Offscreen
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offscreen
    { $sel:oRenderPass:Offscreen :: RenderPass
oRenderPass  = RenderPass
renderPass
    , $sel:oRenderArea:Offscreen :: Rect2D
oRenderArea  = Rect2D
fullSurface
    , $sel:oExtent:Offscreen :: Extent2D
oExtent      = Extent2D
sExtent
    , $sel:oMipLevels:Offscreen :: Word32
oMipLevels   = Word32
1
    , $sel:oLayers:Offscreen :: Word32
oLayers      = Word32
sLayers
    , $sel:oClear:Offscreen :: Vector ClearValue
oClear       = Vector ClearValue
clear
    , $sel:oColor:Offscreen :: AllocatedImage
oColor       = AllocatedImage
color
    , $sel:oDepth:Offscreen :: AllocatedImage
oDepth       = AllocatedImage
depth
    , $sel:oFrameBuffer:Offscreen :: Framebuffer
oFrameBuffer = Framebuffer
framebuffer
    , $sel:oRelease:Offscreen :: RefCounted
oRelease     = RefCounted
release
    }
  where
    fullSurface :: Rect2D
fullSurface = Vk.Rect2D
      { $sel:offset:Rect2D :: Offset2D
Vk.offset = Offset2D
forall a. Zero a => a
zero
      , $sel:extent:Rect2D :: Extent2D
Vk.extent = Extent2D
sExtent
      }

    clear :: Vector ClearValue
clear = [ClearValue] -> Vector ClearValue
forall a. [a] -> Vector a
Vector.fromList
      [ ClearColorValue -> ClearValue
Vk.Color (ClearColorValue -> ClearValue) -> ClearColorValue -> ClearValue
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> ClearColorValue
Vk.Float32 Float
0 Float
0 Float
0 Float
1
      , ClearDepthStencilValue -> ClearValue
Vk.DepthStencil (Float -> Word32 -> ClearDepthStencilValue
Vk.ClearDepthStencilValue Float
1.0 Word32
0)
      ]

-- ** Render pass

allocateRenderPass
  :: ( MonadVulkan env m
     , Resource.MonadResource m
     )
  => Settings
  -> m (Resource.ReleaseKey, Vk.RenderPass)
allocateRenderPass :: forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Settings -> m (ReleaseKey, RenderPass)
allocateRenderPass Settings
settings = do
  Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice

  (ReleaseKey, RenderPass)
res <-
    if Settings -> Bool
sMultiView Settings
settings then
      Device
-> RenderPassCreateInfo '[RenderPassMultiviewCreateInfo]
-> 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 RenderPassCreateInfo '[RenderPassMultiviewCreateInfo]
createInfoMulti 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
    else
      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 RenderPassCreateInfo '[]
createInfo 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 ((ReleaseKey, RenderPass) -> RenderPass
forall a b. (a, b) -> b
snd (ReleaseKey, RenderPass)
res) (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString
"Offscreen:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (Settings -> Text
sLabel Settings
settings)
  pure (ReleaseKey, RenderPass)
res
  where
    createInfo :: RenderPassCreateInfo '[]
createInfo =
      RenderPassCreateInfo '[]
forall a. Zero a => a
zero
        { $sel:attachments:RenderPassCreateInfo :: Vector AttachmentDescription
Vk.attachments  = [AttachmentDescription] -> Vector AttachmentDescription
forall a. [a] -> Vector a
Vector.fromList [Item [AttachmentDescription]
AttachmentDescription
color, Item [AttachmentDescription]
AttachmentDescription
depth]
        , $sel:subpasses:RenderPassCreateInfo :: Vector SubpassDescription
Vk.subpasses    = [SubpassDescription] -> Vector SubpassDescription
forall a. [a] -> Vector a
Vector.fromList [Item [SubpassDescription]
SubpassDescription
subpass]
        , $sel:dependencies:RenderPassCreateInfo :: Vector SubpassDependency
Vk.dependencies = Vector SubpassDependency
deps
        }

    createInfoMulti :: RenderPassCreateInfo '[RenderPassMultiviewCreateInfo]
createInfoMulti =
      RenderPassCreateInfo '[]
createInfo
        RenderPassCreateInfo '[]
-> Chain '[RenderPassMultiviewCreateInfo]
-> RenderPassCreateInfo '[RenderPassMultiviewCreateInfo]
forall (a :: [*] -> *) (es :: [*]) (es' :: [*]).
Extensible a =>
a es' -> Chain es -> a es
::& Khr.RenderPassMultiviewCreateInfo
          { $sel:viewMasks:RenderPassMultiviewCreateInfo :: Vector Word32
Khr.viewMasks        = [Word32
2 Word32 -> Word32 -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Settings -> Word32
sLayers Settings
settings Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1]
          , $sel:viewOffsets:RenderPassMultiviewCreateInfo :: Vector Int32
Khr.viewOffsets      = []
          , $sel:correlationMasks:RenderPassMultiviewCreateInfo :: Vector Word32
Khr.correlationMasks = [Word32
Item (Vector Word32)
0]
          }
        RenderPassMultiviewCreateInfo
-> Chain '[] -> Chain '[RenderPassMultiviewCreateInfo]
forall e (es :: [*]). e -> Chain es -> Chain (e : es)
:& ()

    color :: AttachmentDescription
color = AttachmentDescription
forall a. Zero a => a
zero
      { $sel:format:AttachmentDescription :: Format
Vk.format         = Settings -> Format
sFormat Settings
settings
      , $sel:samples:AttachmentDescription :: SampleCountFlagBits
Vk.samples        = Settings -> SampleCountFlagBits
sSamples Settings
settings
      , $sel:initialLayout:AttachmentDescription :: ImageLayout
Vk.initialLayout  = ImageLayout
Vk.IMAGE_LAYOUT_UNDEFINED
      , $sel:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout    = ImageLayout -> Maybe ImageLayout -> ImageLayout
forall a. a -> Maybe a -> a
fromMaybe ImageLayout
Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL (Settings -> Maybe ImageLayout
sColorLayout Settings
settings)
      , $sel:loadOp:AttachmentDescription :: AttachmentLoadOp
Vk.loadOp         = AttachmentLoadOp
Vk.ATTACHMENT_LOAD_OP_CLEAR
      , $sel:storeOp:AttachmentDescription :: AttachmentStoreOp
Vk.storeOp        = AttachmentStoreOp
Vk.ATTACHMENT_STORE_OP_STORE
      , $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
      }

    depth :: AttachmentDescription
depth = AttachmentDescription
forall a. Zero a => a
zero
      { $sel:format:AttachmentDescription :: Format
Vk.format         = Settings -> Format
sDepthFormat Settings
settings
      , $sel:samples:AttachmentDescription :: SampleCountFlagBits
Vk.samples        = Settings -> SampleCountFlagBits
sSamples Settings
settings
      , $sel:initialLayout:AttachmentDescription :: ImageLayout
Vk.initialLayout  = ImageLayout
Vk.IMAGE_LAYOUT_UNDEFINED
      , $sel:finalLayout:AttachmentDescription :: ImageLayout
Vk.finalLayout    = ImageLayout -> Maybe ImageLayout -> ImageLayout
forall a. a -> Maybe a -> a
fromMaybe ImageLayout
Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL (Settings -> Maybe ImageLayout
sDepthLayout Settings
settings)
      , $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
      }

    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
          }
      }

    {- BUG: Validation Error: [ SYNC-HAZARD-READ_AFTER_WRITE ]

      vkCmdDraw: Hazard READ_AFTER_WRITE for VkImageView 0x2c0a7b0[],
        in VkCommandBuffer 0x3297680[],
        and VkPipeline 0x3203390[Global.Render.EnvCube.Pipeline],
        VkDescriptorSet 0x3248050[],
        type: VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE,
        imageLayout: VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL,
        binding #3, index 5.
      Access info (
        usage: SYNC_FRAGMENT_SHADER_SHADER_STORAGE_READ,
        prior_usage: SYNC_COLOR_ATTACHMENT_OUTPUT_COLOR_ATTACHMENT_WRITE,
        write_barriers: 0,
        command: vkCmdBeginRenderPass,
        seq_no: 26,
        reset_no: 1
      ).
    -}
    deps :: Vector SubpassDependency
deps =
      [ SubpassDependency
forall a. Zero a => a
zero
          { $sel:dependencyFlags:SubpassDependency :: DependencyFlags
Vk.dependencyFlags = DependencyFlags
Vk.DEPENDENCY_BY_REGION_BIT
          , $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
Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
          , $sel:dstStageMask:SubpassDependency :: PipelineStageFlags
Vk.dstStageMask    = PipelineStageFlags
Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT PipelineStageFlags -> PipelineStageFlags -> PipelineStageFlags
forall a. Bits a => a -> a -> a
.|. 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
          , $sel:srcAccessMask:SubpassDependency :: AccessFlags
Vk.srcAccessMask   = AccessFlags
Vk.ACCESS_SHADER_READ_BIT AccessFlags -> AccessFlags -> AccessFlags
forall a. Bits a => a -> a -> a
.|. AccessFlags
Vk.ACCESS_SHADER_WRITE_BIT
          , $sel:dstAccessMask:SubpassDependency :: AccessFlags
Vk.dstAccessMask   = AccessFlags
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT AccessFlags -> AccessFlags -> AccessFlags
forall a. Bits a => a -> a -> a
.|. AccessFlags
Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT
          }
      , SubpassDependency
forall a. Zero a => a
zero
          { $sel:dependencyFlags:SubpassDependency :: DependencyFlags
Vk.dependencyFlags = DependencyFlags
Vk.DEPENDENCY_BY_REGION_BIT
          , $sel:srcSubpass:SubpassDependency :: Word32
Vk.srcSubpass      = Word32
0
          , $sel:dstSubpass:SubpassDependency :: Word32
Vk.dstSubpass      = Word32
Vk.SUBPASS_EXTERNAL
          , $sel:srcStageMask:SubpassDependency :: PipelineStageFlags
Vk.srcStageMask    = PipelineStageFlags
Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT PipelineStageFlags -> PipelineStageFlags -> PipelineStageFlags
forall a. Bits a => a -> a -> a
.|. 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
          , $sel:dstStageMask:SubpassDependency :: PipelineStageFlags
Vk.dstStageMask    = PipelineStageFlags
Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
          , $sel:srcAccessMask:SubpassDependency :: AccessFlags
Vk.srcAccessMask   = AccessFlags
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT AccessFlags -> AccessFlags -> AccessFlags
forall a. Bits a => a -> a -> a
.|. AccessFlags
Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT
          , $sel:dstAccessMask:SubpassDependency :: AccessFlags
Vk.dstAccessMask   = AccessFlags
Vk.ACCESS_SHADER_READ_BIT
          }
      ]

-- ** Framebuffer

type FramebufferOffscreen =
  ( Image.AllocatedImage
  , Image.AllocatedImage
  , Vk.Framebuffer
  )

allocateFramebuffer
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     )
  => Settings
  -> Vk.RenderPass
  -> ResourceT m FramebufferOffscreen
allocateFramebuffer :: forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
Settings -> RenderPass -> ResourceT m FramebufferOffscreen
allocateFramebuffer Settings{Bool
Maybe ImageLayout
Word32
Text
Extent2D
SampleCountFlagBits
Format
$sel:sLabel:Settings :: Settings -> Text
$sel:sExtent:Settings :: Settings -> Extent2D
$sel:sFormat:Settings :: Settings -> Format
$sel:sColorLayout:Settings :: Settings -> Maybe ImageLayout
$sel:sDepthFormat:Settings :: Settings -> Format
$sel:sDepthLayout:Settings :: Settings -> Maybe ImageLayout
$sel:sLayers:Settings :: Settings -> Word32
$sel:sMultiView:Settings :: Settings -> Bool
$sel:sSamples:Settings :: Settings -> SampleCountFlagBits
$sel:sMipMap:Settings :: Settings -> Bool
sLabel :: Text
sExtent :: Extent2D
sFormat :: Format
sColorLayout :: Maybe ImageLayout
sDepthFormat :: Format
sDepthLayout :: Maybe ImageLayout
sLayers :: Word32
sMultiView :: Bool
sSamples :: SampleCountFlagBits
sMipMap :: Bool
..} RenderPass
renderPass = do
  Utf8Builder -> Utf8Builder -> ResourceT m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasCallStack) =>
Utf8Builder -> Utf8Builder -> ResourceT m ()
Region.logDebug
    (Utf8Builder
"Allocating Offscreen resources for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
sLabel)
    (Utf8Builder
"Releasing Offscreen resources for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
sLabel)

  AllocatedImage
color <- Maybe Text
-> ImageAspectFlags
-> ("image dimensions" ::: Extent3D)
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlags
-> ResourceT m AllocatedImage
forall env (io :: * -> *).
(MonadVulkan env io, MonadResource io) =>
Maybe Text
-> ImageAspectFlags
-> ("image dimensions" ::: Extent3D)
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlags
-> io AllocatedImage
Image.allocate
    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
sLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".color")
    ImageAspectFlags
Vk.IMAGE_ASPECT_COLOR_BIT
    (Extent2D -> Word32 -> "image dimensions" ::: Extent3D
Image.inflateExtent Extent2D
sExtent Word32
1)
    (if Bool
sMipMap then Word32
mipLevels else Word32
1)
    Word32
sLayers
    SampleCountFlagBits
sSamples
    Format
sFormat
    ( ImageUsageFlags
Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT ImageUsageFlags -> ImageUsageFlags -> ImageUsageFlags
forall a. Bits a => a -> a -> a
.|.
      ImageUsageFlags
Vk.IMAGE_USAGE_SAMPLED_BIT ImageUsageFlags -> ImageUsageFlags -> ImageUsageFlags
forall a. Bits a => a -> a -> a
.|.
      ImageUsageFlags
Vk.IMAGE_USAGE_TRANSFER_SRC_BIT
    )

  AllocatedImage
depth <- Maybe Text
-> ImageAspectFlags
-> ("image dimensions" ::: Extent3D)
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlags
-> ResourceT m AllocatedImage
forall env (io :: * -> *).
(MonadVulkan env io, MonadResource io) =>
Maybe Text
-> ImageAspectFlags
-> ("image dimensions" ::: Extent3D)
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlags
-> io AllocatedImage
Image.allocate
    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
sLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".depth")
    ImageAspectFlags
Vk.IMAGE_ASPECT_DEPTH_BIT
    (Extent2D -> Word32 -> "image dimensions" ::: Extent3D
Image.inflateExtent Extent2D
sExtent Word32
1)
    (if Bool
sMipMap then Word32
mipLevels else Word32
1)
    Word32
sLayers
    SampleCountFlagBits
sSamples
    Format
sDepthFormat
    ( ImageUsageFlags
Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT ImageUsageFlags -> ImageUsageFlags -> ImageUsageFlags
forall a. Bits a => a -> a -> a
.|.
      ImageUsageFlags
Vk.IMAGE_USAGE_SAMPLED_BIT
    )

  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
      ]

    {- XXX:
      If the render pass uses multiview, then layers must be one and each attachment
      requires a number of layers that is greater than the maximum bit index set in
      the view mask in the subpasses in which it is used.
    -}
    fbNumLayers :: Word32
fbNumLayers =
      if Bool
sMultiView then
        Word32
1
      else
        Word32
sLayers

    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
fbNumLayers
      }

  Device
device <- (env -> Device) -> ResourceT m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
  Framebuffer
framebuffer <- Device
-> FramebufferCreateInfo '[]
-> Maybe AllocationCallbacks
-> ResourceT m Framebuffer
forall (a :: [*]) (io :: * -> *).
(Extendss FramebufferCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> FramebufferCreateInfo a
-> Maybe AllocationCallbacks
-> io Framebuffer
Vk.createFramebuffer Device
device FramebufferCreateInfo '[]
fbCI Maybe AllocationCallbacks
forall a. Maybe a
Nothing
  ResourceT m ReleaseKey -> ResourceT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT m ReleaseKey -> ResourceT m ())
-> ResourceT m ReleaseKey -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$! IO () -> ResourceT m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO () -> ResourceT m ReleaseKey)
-> IO () -> ResourceT m ReleaseKey
forall a b. (a -> b) -> a -> b
$ Device -> Framebuffer -> Maybe AllocationCallbacks -> IO ()
forall (io :: * -> *).
MonadIO io =>
Device -> Framebuffer -> Maybe AllocationCallbacks -> io ()
Vk.destroyFramebuffer Device
device Framebuffer
framebuffer Maybe AllocationCallbacks
forall a. Maybe a
Nothing
  Framebuffer -> Text -> ResourceT m ()
forall env (m :: * -> *) a.
(MonadVulkan env m, HasObjectType a) =>
a -> Text -> m ()
Named.object Framebuffer
framebuffer (Text -> ResourceT m ()) -> Text -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$ Text
sLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".FB"

  pure (AllocatedImage
color, AllocatedImage
depth, Framebuffer
framebuffer)
  where
    Vk.Extent2D{Word32
width :: Word32
$sel:width:Extent2D :: Extent2D -> Word32
width, Word32
height :: Word32
$sel:height:Extent2D :: Extent2D -> Word32
height} = Extent2D
sExtent
    mipLevels :: Word32
mipLevels = Extent2D -> Word32
forall t. Num t => Extent2D -> t
extentMips Extent2D
sExtent

extentMips :: Num t => Vk.Extent2D -> t
extentMips :: forall t. Num t => Extent2D -> t
extentMips Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = t -> Word32 -> t
forall {t} {t}. (Num t, Integral t) => t -> t -> t
go t
1 (Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
width Word32
height)
  where
    go :: t -> t -> t
go t
levels = \case
      t
0 ->
        t
levels
      t
1 ->
        t
levels
      t
side ->
        t -> t -> t
go (t
levels t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
side t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)