{-# LANGUAGE OverloadedLists #-}

module Render.Pass.Offscreen
  ( Settings(..)
  , allocate
  , Offscreen(..)
  , colorTexture
  , colorCube
  , depthTexture
  , depthCube
  ) 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.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, newRefCounted, resourceTRefCount)
import Engine.Vulkan.Types (HasVulkan(..), HasRenderPass(..), RenderPass(..), MonadVulkan)
import Resource.Image (AllocatedImage)
import Resource.Image qualified as Image
import Resource.Texture (CubeMap, Flat, Texture(..))

{- 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 -> Format
sDepthFormat :: Vk.Format
  , 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
/= :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c== :: 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
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> 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 ()
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
Extent2D
Rect2D
Framebuffer
RenderPass
RefCounted
AllocatedImage
oRelease :: RefCounted
oClear :: Vector ClearValue
oRenderArea :: Rect2D
oFrameBuffer :: Framebuffer
oMipLevels :: Word32
oLayers :: Word32
oDepth :: AllocatedImage
oColor :: AllocatedImage
oExtent :: Extent2D
oRenderPass :: RenderPass
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
..} = Texture :: forall a. Format -> Word32 -> Word32 -> AllocatedImage -> Texture a
Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage -> Format
Image.aiFormat AllocatedImage
oColor
  , $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
Extent2D
Rect2D
Framebuffer
RenderPass
RefCounted
AllocatedImage
oRelease :: RefCounted
oClear :: Vector ClearValue
oRenderArea :: Rect2D
oFrameBuffer :: Framebuffer
oMipLevels :: Word32
oLayers :: Word32
oDepth :: AllocatedImage
oColor :: AllocatedImage
oExtent :: Extent2D
oRenderPass :: RenderPass
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
..} = Texture :: forall a. Format -> Word32 -> Word32 -> AllocatedImage -> Texture a
Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage -> Format
Image.aiFormat AllocatedImage
oColor
  , $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
Extent2D
Rect2D
Framebuffer
RenderPass
RefCounted
AllocatedImage
oRelease :: RefCounted
oClear :: Vector ClearValue
oRenderArea :: Rect2D
oFrameBuffer :: Framebuffer
oMipLevels :: Word32
oLayers :: Word32
oDepth :: AllocatedImage
oColor :: AllocatedImage
oExtent :: Extent2D
oRenderPass :: RenderPass
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
..} = Texture :: forall a. Format -> Word32 -> Word32 -> AllocatedImage -> Texture a
Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage -> Format
Image.aiFormat AllocatedImage
oDepth
  , $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
Extent2D
Rect2D
Framebuffer
RenderPass
RefCounted
AllocatedImage
oRelease :: RefCounted
oClear :: Vector ClearValue
oRenderArea :: Rect2D
oFrameBuffer :: Framebuffer
oMipLevels :: Word32
oLayers :: Word32
oDepth :: AllocatedImage
oColor :: AllocatedImage
oExtent :: Extent2D
oRenderPass :: RenderPass
$sel:oRelease:Offscreen :: Offscreen -> RefCounted
$sel:oClear:Offscreen :: Offscreen -> Vector ClearValue
$sel:oRenderArea:Offscreen :: Offscreen -> Rect2D
$sel:oFrameBuffer:Offscreen :: Offscreen -> Framebuffer
$sel:oMipLevels:Offscreen :: Offscreen -> Word32
$sel:oLayers:Offscreen :: Offscreen -> Word32
$sel:oDepth:Offscreen :: Offscreen -> AllocatedImage
$sel:oColor:Offscreen :: Offscreen -> AllocatedImage
$sel:oExtent:Offscreen :: Offscreen -> Extent2D
$sel:oRenderPass:Offscreen :: Offscreen -> RenderPass
..} = Texture :: forall a. Format -> Word32 -> Word32 -> AllocatedImage -> Texture a
Texture
  { $sel:tFormat:Texture :: Format
tFormat         = AllocatedImage -> Format
Image.aiFormat AllocatedImage
oDepth
  , $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
Word32
Text
Format
SampleCountFlagBits
Extent2D
sMipMap :: Bool
sSamples :: SampleCountFlagBits
sMultiView :: Bool
sLayers :: Word32
sDepthFormat :: Format
sFormat :: Format
sExtent :: Extent2D
sLabel :: Text
$sel:sMipMap:Settings :: Settings -> Bool
$sel:sSamples:Settings :: Settings -> SampleCountFlagBits
$sel:sMultiView:Settings :: Settings -> Bool
$sel:sLayers:Settings :: Settings -> Word32
$sel:sDepthFormat:Settings :: Settings -> Format
$sel:sFormat:Settings :: Settings -> Format
$sel:sExtent:Settings :: Settings -> Extent2D
$sel:sLabel:Settings :: Settings -> Text
..} = do
  Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ 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

  (ReleaseKey
_rpKey, RenderPass
renderPass) <- Settings -> m (ReleaseKey, RenderPass)
forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Settings -> m (ReleaseKey, RenderPass)
allocateRenderPass Settings
settings

  (RefCounted
refcounted, AllocatedImage
color, AllocatedImage
depth, Framebuffer
framebuffer) <- Settings
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage, Framebuffer)
forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
Settings
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage, Framebuffer)
allocateFramebuffer Settings
settings RenderPass
renderPass

  pure Offscreen :: RenderPass
-> Extent2D
-> AllocatedImage
-> AllocatedImage
-> Word32
-> Word32
-> Framebuffer
-> Rect2D
-> Vector ClearValue
-> RefCounted
-> Offscreen
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
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 = 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
::& RenderPassMultiviewCreateInfo :: Vector Word32
-> Vector Int32 -> Vector Word32 -> RenderPassMultiviewCreateInfo
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 = [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
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_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
Vk.IMAGE_LAYOUT_DEPTH_STENCIL_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
      }

    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 :: PipelineStageFlagBits
Vk.srcStageMask    = PipelineStageFlagBits
Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
          , $sel:dstStageMask:SubpassDependency :: PipelineStageFlagBits
Vk.dstStageMask    = PipelineStageFlagBits
Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT PipelineStageFlagBits
-> PipelineStageFlagBits -> PipelineStageFlagBits
forall a. Bits a => a -> a -> a
.|. PipelineStageFlagBits
Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT PipelineStageFlagBits
-> PipelineStageFlagBits -> PipelineStageFlagBits
forall a. Bits a => a -> a -> a
.|. PipelineStageFlagBits
Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT
          , $sel:srcAccessMask:SubpassDependency :: AccessFlagBits
Vk.srcAccessMask   = AccessFlagBits
Vk.ACCESS_SHADER_READ_BIT AccessFlagBits -> AccessFlagBits -> AccessFlagBits
forall a. Bits a => a -> a -> a
.|. AccessFlagBits
Vk.ACCESS_SHADER_WRITE_BIT
          , $sel:dstAccessMask:SubpassDependency :: AccessFlagBits
Vk.dstAccessMask   = AccessFlagBits
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT AccessFlagBits -> AccessFlagBits -> AccessFlagBits
forall a. Bits a => a -> a -> a
.|. AccessFlagBits
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 :: PipelineStageFlagBits
Vk.srcStageMask    = PipelineStageFlagBits
Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT PipelineStageFlagBits
-> PipelineStageFlagBits -> PipelineStageFlagBits
forall a. Bits a => a -> a -> a
.|. PipelineStageFlagBits
Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT PipelineStageFlagBits
-> PipelineStageFlagBits -> PipelineStageFlagBits
forall a. Bits a => a -> a -> a
.|. PipelineStageFlagBits
Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT
          , $sel:dstStageMask:SubpassDependency :: PipelineStageFlagBits
Vk.dstStageMask    = PipelineStageFlagBits
Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
          , $sel:srcAccessMask:SubpassDependency :: AccessFlagBits
Vk.srcAccessMask   = AccessFlagBits
Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT AccessFlagBits -> AccessFlagBits -> AccessFlagBits
forall a. Bits a => a -> a -> a
.|. AccessFlagBits
Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT
          , $sel:dstAccessMask:SubpassDependency :: AccessFlagBits
Vk.dstAccessMask   = AccessFlagBits
Vk.ACCESS_SHADER_READ_BIT
          }
      ]

-- ** Framebuffer

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

allocateFramebuffer
  :: ( Resource.MonadResource m
     , MonadVulkan env m
     , HasLogFunc env
     )
  => Settings
  -> Vk.RenderPass
  -> m FramebufferOffscreen
allocateFramebuffer :: forall (m :: * -> *) env.
(MonadResource m, MonadVulkan env m, HasLogFunc env) =>
Settings
-> RenderPass
-> m (RefCounted, AllocatedImage, AllocatedImage, Framebuffer)
allocateFramebuffer Settings{Bool
Word32
Text
Format
SampleCountFlagBits
Extent2D
sMipMap :: Bool
sSamples :: SampleCountFlagBits
sMultiView :: Bool
sLayers :: Word32
sDepthFormat :: Format
sFormat :: Format
sExtent :: Extent2D
sLabel :: Text
$sel:sMipMap:Settings :: Settings -> Bool
$sel:sSamples:Settings :: Settings -> SampleCountFlagBits
$sel:sMultiView:Settings :: Settings -> Bool
$sel:sLayers:Settings :: Settings -> Word32
$sel:sDepthFormat:Settings :: Settings -> Format
$sel:sFormat:Settings :: Settings -> Format
$sel:sExtent:Settings :: Settings -> Extent2D
$sel:sLabel:Settings :: Settings -> Text
..} RenderPass
renderPass = do
  env
context <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let device :: Device
device = env -> Device
forall a. HasVulkan a => a -> Device
getDevice env
context
  let
    Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = Extent2D
sExtent
    mipLevels :: Word32
mipLevels = Extent2D -> Word32
forall t. Num t => Extent2D -> t
extentMips Extent2D
sExtent

  (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
-> Maybe Text
-> ImageAspectFlags
-> Extent2D
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlagBits
-> IO AllocatedImage
forall (io :: * -> *) ctx.
(MonadIO io, HasVulkan ctx) =>
ctx
-> Maybe Text
-> ImageAspectFlags
-> Extent2D
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlagBits
-> io AllocatedImage
Image.create
        env
context
        (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
sExtent
        (if Bool
sMipMap then Word32
mipLevels else Word32
1)
        Word32
sLayers
        SampleCountFlagBits
sSamples
        Format
sFormat
        ( ImageUsageFlagBits
Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT ImageUsageFlagBits -> ImageUsageFlagBits -> ImageUsageFlagBits
forall a. Bits a => a -> a -> a
.|.
          ImageUsageFlagBits
Vk.IMAGE_USAGE_SAMPLED_BIT ImageUsageFlagBits -> ImageUsageFlagBits -> ImageUsageFlagBits
forall a. Bits a => a -> a -> a
.|.
          ImageUsageFlagBits
Vk.IMAGE_USAGE_TRANSFER_SRC_BIT
        )
    )
    (env -> AllocatedImage -> IO ()
forall (io :: * -> *) context.
(MonadIO io, HasVulkan context) =>
context -> AllocatedImage -> io ()
Image.destroy env
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
-> Maybe Text
-> ImageAspectFlags
-> Extent2D
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlagBits
-> IO AllocatedImage
forall (io :: * -> *) ctx.
(MonadIO io, HasVulkan ctx) =>
ctx
-> Maybe Text
-> ImageAspectFlags
-> Extent2D
-> Word32
-> Word32
-> SampleCountFlagBits
-> Format
-> ImageUsageFlagBits
-> io AllocatedImage
Image.create
        env
context
        (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
sExtent
        (if Bool
sMipMap then Word32
mipLevels else Word32
1)
        Word32
sLayers
        SampleCountFlagBits
sSamples
        Format
sDepthFormat
        (ImageUsageFlagBits
Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT ImageUsageFlagBits -> ImageUsageFlagBits -> ImageUsageFlagBits
forall a. Bits a => a -> a -> a
.|. ImageUsageFlagBits
Vk.IMAGE_USAGE_SAMPLED_BIT)
    )
    (env -> AllocatedImage -> IO ()
forall (io :: * -> *) context.
(MonadIO io, HasVulkan context) =>
context -> AllocatedImage -> io ()
Image.destroy env
context)

  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
      }

  (ReleaseKey
framebufferKey, Framebuffer
framebuffer) <- 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
  Device -> Framebuffer -> ByteString -> m ()
forall a (m :: * -> *).
(HasObjectType a, MonadIO m) =>
Device -> a -> ByteString -> m ()
Debug.nameObject Device
device Framebuffer
framebuffer (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
sLabel ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".FB"

  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 Offscreen 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 ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release ReleaseKey
framebufferKey

  pure (RefCounted
release, AllocatedImage
color, AllocatedImage
depth, Framebuffer
framebuffer)

extentMips :: Num t => Vk.Extent2D -> t
extentMips :: forall t. Num t => Extent2D -> t
extentMips Vk.Extent2D{Word32
width :: Word32
$sel:width:Extent2D :: Extent2D -> Word32
width, Word32
height :: Word32
$sel:height:Extent2D :: Extent2D -> 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)