{- |
  All the provided render passes and pipelines packaged and delivered.
-}

module Render.Basic where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Data.Tagged (Tagged(..))
import RIO.Vector.Partial as Vector (headM)
import Vulkan.Core10 qualified as Vk

-- keid-core

import Engine.Types qualified as Engine
import Engine.Types (StageRIO)
import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Types (DsBindings, HasSwapchain(getMultisample), RenderPass(..))

-- keid-render-basic

import Render.Debug.Pipeline qualified as Debug
import Render.DescSets.Set0 (Scene)
import Render.DescSets.Set0 qualified as Scene
import Render.DescSets.Sun (Sun)
import Render.DescSets.Sun qualified as Sun
import Render.Font.EvanwSdf.Pipeline qualified as EvanwSdf
import Render.ForwardMsaa (ForwardMsaa)
import Render.ForwardMsaa qualified as ForwardMsaa
import Render.Lit.Colored.Pipeline qualified as LitColored
import Render.Lit.Material.Pipeline qualified as LitMaterial
import Render.Lit.Textured.Pipeline qualified as LitTextured
import Render.Samplers qualified as Samplers
import Render.ShadowMap.Pipeline qualified as ShadowPipe
import Render.ShadowMap.RenderPass (ShadowMap)
import Render.ShadowMap.RenderPass qualified as ShadowPass
import Render.Skybox.Pipeline qualified as Skybox
import Render.Unlit.Colored.Pipeline qualified as UnlitColored
import Render.Unlit.Textured.Pipeline qualified as UnlitTextured

type Stage = Engine.Stage RenderPasses Pipelines
type Frame = Engine.Frame RenderPasses Pipelines
type StageFrameRIO r s a = Engine.StageFrameRIO RenderPasses Pipelines r s a

data RenderPasses = RenderPasses
  { RenderPasses -> ForwardMsaa
rpForwardMsaa :: ForwardMsaa
  , RenderPasses -> ShadowMap
rpShadowPass  :: ShadowMap
  }

instance RenderPass RenderPasses where
  allocateRenderpass_ :: context -> ResourceT (RIO env) RenderPasses
allocateRenderpass_ context
context = do
    ForwardMsaa
rpForwardMsaa <- context -> ResourceT (RIO env) ForwardMsaa
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain swapchain) =>
swapchain -> m ForwardMsaa
ForwardMsaa.allocateMsaa context
context

    -- TODO: get from config
    let
      size :: Word32
size      = Word32
4096 -- XXX: 2048 is kinda minimum, even with PCF enabled
      numLayers :: Word32
numLayers = Word32
2    -- XXX: no-cascade sun + moon
    ShadowMap
rpShadowPass <- context -> Word32 -> Word32 -> ResourceT (RIO env) ShadowMap
forall (m :: * -> *) env context.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain context) =>
context -> Word32 -> Word32 -> m ShadowMap
ShadowPass.allocate context
context Word32
size Word32
numLayers

    pure RenderPasses :: ForwardMsaa -> ShadowMap -> RenderPasses
RenderPasses{ForwardMsaa
ShadowMap
rpShadowPass :: ShadowMap
rpForwardMsaa :: ForwardMsaa
$sel:rpShadowPass:RenderPasses :: ShadowMap
$sel:rpForwardMsaa:RenderPasses :: ForwardMsaa
..}

  updateRenderpass :: context -> RenderPasses -> RIO env RenderPasses
updateRenderpass context
context RenderPasses{ForwardMsaa
ShadowMap
rpShadowPass :: ShadowMap
rpForwardMsaa :: ForwardMsaa
$sel:rpShadowPass:RenderPasses :: RenderPasses -> ShadowMap
$sel:rpForwardMsaa:RenderPasses :: RenderPasses -> ForwardMsaa
..} = ForwardMsaa -> ShadowMap -> RenderPasses
RenderPasses
    (ForwardMsaa -> ShadowMap -> RenderPasses)
-> RIO env ForwardMsaa -> RIO env (ShadowMap -> RenderPasses)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> context -> ForwardMsaa -> RIO env ForwardMsaa
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain swapchain) =>
swapchain -> ForwardMsaa -> m ForwardMsaa
ForwardMsaa.updateMsaa context
context ForwardMsaa
rpForwardMsaa
    RIO env (ShadowMap -> RenderPasses)
-> RIO env ShadowMap -> RIO env RenderPasses
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShadowMap -> RIO env ShadowMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShadowMap
rpShadowPass -- XXX: not a screen pass

  refcountRenderpass :: RenderPasses -> RIO env ()
refcountRenderpass RenderPasses{ForwardMsaa
ShadowMap
rpShadowPass :: ShadowMap
rpForwardMsaa :: ForwardMsaa
$sel:rpShadowPass:RenderPasses :: RenderPasses -> ShadowMap
$sel:rpForwardMsaa:RenderPasses :: RenderPasses -> ForwardMsaa
..} = do
    ForwardMsaa -> RIO env ()
forall a env.
(RenderPass a, MonadResource (RIO env)) =>
a -> RIO env ()
refcountRenderpass ForwardMsaa
rpForwardMsaa
    ShadowMap -> RIO env ()
forall a env.
(RenderPass a, MonadResource (RIO env)) =>
a -> RIO env ()
refcountRenderpass ShadowMap
rpShadowPass

data Pipelines = Pipelines
  { Pipelines -> Pipeline
pEvanwSdf :: EvanwSdf.Pipeline
  , Pipelines -> Pipeline
pSkybox   :: Skybox.Pipeline
  , Pipelines -> Pipeline
pDebug    :: Debug.Pipeline

  , Pipelines -> Pipeline
pLitColored       :: LitColored.Pipeline
  , Pipelines -> Pipeline
pLitColoredBlend  :: LitColored.Pipeline
  , Pipelines -> Pipeline
pLitMaterial      :: LitMaterial.Pipeline
  , Pipelines -> Pipeline
pLitMaterialBlend :: LitMaterial.Pipeline
  , Pipelines -> Pipeline
pLitTextured      :: LitTextured.Pipeline
  , Pipelines -> Pipeline
pLitTexturedBlend :: LitTextured.Pipeline

  , Pipelines -> Pipeline
pUnlitColored        :: UnlitColored.Pipeline
  , Pipelines -> Pipeline
pUnlitColoredNoDepth :: UnlitColored.Pipeline
  , Pipelines -> Pipeline
pUnlitTextured       :: UnlitTextured.Pipeline
  , Pipelines -> Pipeline
pUnlitTexturedBlend  :: UnlitTextured.Pipeline
  , Pipelines -> Pipeline
pWireframe           :: UnlitColored.Pipeline
  , Pipelines -> Pipeline
pWireframeNoDepth    :: UnlitColored.Pipeline

  , Pipelines -> Pipeline
pShadowCast :: ShadowPipe.Pipeline
  }

allocatePipelines_
  :: HasSwapchain swapchain
  => swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ :: swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ swapchain
swapchain RenderPasses
renderpasses = do
  (ReleaseKey
_, Collection Sampler
samplers) <- swapchain
-> ResourceT (StageRIO st) (ReleaseKey, Collection Sampler)
forall env (m :: * -> *) a.
(MonadVulkan env m, MonadResource m, HasSwapchain a) =>
a -> m (ReleaseKey, Collection Sampler)
Samplers.allocate swapchain
swapchain
  Tagged Scene DsBindings
-> swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
forall swapchain st.
HasSwapchain swapchain =>
Tagged Scene DsBindings
-> swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
allocatePipelines
    (Collection Sampler
-> Maybe Any -> Maybe Any -> Word32 -> Tagged Scene DsBindings
forall (samplers :: * -> *) (textures :: * -> *)
       (cubemaps :: * -> *) a b.
(Foldable samplers, Foldable textures, Foldable cubemaps) =>
samplers Sampler
-> textures a -> cubemaps b -> Word32 -> Tagged Scene DsBindings
Scene.mkBindings Collection Sampler
samplers Maybe Any
forall a. Maybe a
Nothing Maybe Any
forall a. Maybe a
Nothing Word32
0)
    swapchain
swapchain
    RenderPasses
renderpasses

allocatePipelines
  :: HasSwapchain swapchain
  => Tagged Scene DsBindings
  -> swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines :: Tagged Scene DsBindings
-> swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
allocatePipelines Tagged Scene DsBindings
sceneBinds swapchain
swapchain RenderPasses{ForwardMsaa
ShadowMap
rpShadowPass :: ShadowMap
rpForwardMsaa :: ForwardMsaa
$sel:rpShadowPass:RenderPasses :: RenderPasses -> ShadowMap
$sel:rpForwardMsaa:RenderPasses :: RenderPasses -> ForwardMsaa
..} = do
  let msaa :: SampleCountFlagBits
msaa = swapchain -> SampleCountFlagBits
forall a. HasSwapchain a => a -> SampleCountFlagBits
getMultisample swapchain
swapchain

  Pipeline
pDebug    <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
Debug.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pEvanwSdf <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
EvanwSdf.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pSkybox   <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
Skybox.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa

  Pipeline
pLitColored       <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitColored.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pLitColoredBlend  <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitColored.allocateBlend SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pLitMaterial      <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitMaterial.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pLitMaterialBlend <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitMaterial.allocateBlend SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pLitTextured      <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitTextured.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pLitTexturedBlend <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
LitTextured.allocateBlend SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa

  Pipeline
pUnlitColored        <- Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitColored.allocate Bool
True SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pUnlitColoredNoDepth <- Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitColored.allocate Bool
False SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pUnlitTextured       <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitTextured.allocate SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pUnlitTexturedBlend  <- SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitTextured.allocateBlend SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pWireframe           <- Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitColored.allocateWireframe Bool
True SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pWireframeNoDepth    <- Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitColored.allocateWireframe Bool
False SampleCountFlagBits
msaa Tagged Scene DsBindings
sceneBinds ForwardMsaa
rpForwardMsaa

  let sunBinds :: Tagged Sun DsBindings
sunBinds = Tagged Sun DsBindings
Sun.set0
  Pipeline
pShadowCast <- Tagged Sun DsBindings
-> ShadowMap -> Settings -> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Tagged Sun DsBindings
-> renderpass -> Settings -> ResourceT (RIO env) Pipeline
ShadowPipe.allocate Tagged Sun DsBindings
sunBinds ShadowMap
rpShadowPass Settings
ShadowPipe.defaults

  pure Pipelines :: Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipeline
-> Pipelines
Pipelines{Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
pShadowCast :: Pipeline
pWireframeNoDepth :: Pipeline
pWireframe :: Pipeline
pUnlitTexturedBlend :: Pipeline
pUnlitTextured :: Pipeline
pUnlitColoredNoDepth :: Pipeline
pUnlitColored :: Pipeline
pLitTexturedBlend :: Pipeline
pLitTextured :: Pipeline
pLitMaterialBlend :: Pipeline
pLitMaterial :: Pipeline
pLitColoredBlend :: Pipeline
pLitColored :: Pipeline
pSkybox :: Pipeline
pEvanwSdf :: Pipeline
pDebug :: Pipeline
$sel:pShadowCast:Pipelines :: Pipeline
$sel:pWireframeNoDepth:Pipelines :: Pipeline
$sel:pWireframe:Pipelines :: Pipeline
$sel:pUnlitTexturedBlend:Pipelines :: Pipeline
$sel:pUnlitTextured:Pipelines :: Pipeline
$sel:pUnlitColoredNoDepth:Pipelines :: Pipeline
$sel:pUnlitColored:Pipelines :: Pipeline
$sel:pLitTexturedBlend:Pipelines :: Pipeline
$sel:pLitTextured:Pipelines :: Pipeline
$sel:pLitMaterialBlend:Pipelines :: Pipeline
$sel:pLitMaterial:Pipelines :: Pipeline
$sel:pLitColoredBlend:Pipelines :: Pipeline
$sel:pLitColored:Pipelines :: Pipeline
$sel:pDebug:Pipelines :: Pipeline
$sel:pSkybox:Pipelines :: Pipeline
$sel:pEvanwSdf:Pipelines :: Pipeline
..}

getSceneLayout :: Pipelines -> Tagged '[Scene] Vk.DescriptorSetLayout
getSceneLayout :: Pipelines -> Tagged '[Scene] DescriptorSetLayout
getSceneLayout Pipelines{Pipeline
pLitColored :: Pipeline
$sel:pLitColored:Pipelines :: Pipelines -> Pipeline
pLitColored} =
  case Vector DescriptorSetLayout -> Maybe DescriptorSetLayout
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> m a
Vector.headM (Tagged '[Scene] (Vector DescriptorSetLayout)
-> Vector DescriptorSetLayout
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged '[Scene] (Vector DescriptorSetLayout)
 -> Vector DescriptorSetLayout)
-> Tagged '[Scene] (Vector DescriptorSetLayout)
-> Vector DescriptorSetLayout
forall a b. (a -> b) -> a -> b
$ Pipeline -> Tagged '[Scene] (Vector DescriptorSetLayout)
forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances
-> Tagged dsl (Vector DescriptorSetLayout)
Pipeline.pDescLayouts Pipeline
pLitColored) of
    Maybe DescriptorSetLayout
Nothing ->
      [Char] -> Tagged '[Scene] DescriptorSetLayout
forall a. HasCallStack => [Char] -> a
error [Char]
"pLitColored has at least set0 in layout"
    Just DescriptorSetLayout
set0layout ->
      DescriptorSetLayout -> Tagged '[Scene] DescriptorSetLayout
forall k (s :: k) b. b -> Tagged s b
Tagged DescriptorSetLayout
set0layout

getSunLayout :: Pipelines -> Tagged '[Sun] Vk.DescriptorSetLayout
getSunLayout :: Pipelines -> Tagged '[Sun] DescriptorSetLayout
getSunLayout Pipelines{Pipeline
pShadowCast :: Pipeline
$sel:pShadowCast:Pipelines :: Pipelines -> Pipeline
pShadowCast} =
  case Vector DescriptorSetLayout -> Maybe DescriptorSetLayout
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> m a
Vector.headM (Tagged '[Sun] (Vector DescriptorSetLayout)
-> Vector DescriptorSetLayout
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged '[Sun] (Vector DescriptorSetLayout)
 -> Vector DescriptorSetLayout)
-> Tagged '[Sun] (Vector DescriptorSetLayout)
-> Vector DescriptorSetLayout
forall a b. (a -> b) -> a -> b
$ Pipeline -> Tagged '[Sun] (Vector DescriptorSetLayout)
forall (dsl :: [*]) vertices instances.
Pipeline dsl vertices instances
-> Tagged dsl (Vector DescriptorSetLayout)
Pipeline.pDescLayouts Pipeline
pShadowCast) of
    Maybe DescriptorSetLayout
Nothing ->
      [Char] -> Tagged '[Sun] DescriptorSetLayout
forall a. HasCallStack => [Char] -> a
error [Char]
"pShadowCast has at least set0 in layout"
    Just DescriptorSetLayout
set0layout ->
      DescriptorSetLayout -> Tagged '[Sun] DescriptorSetLayout
forall k (s :: k) b. b -> Tagged s b
Tagged DescriptorSetLayout
set0layout