keid-render-basic-0.1.6.1: src/Render/Basic.hs

{- |
  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
import Vulkan.Zero (Zero(..))

-- keid-core

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

-- keid-render-basic

import Render.Debug.Pipeline qualified as Debug
import Render.DepthOnly.Pipeline qualified as DepthOnly
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.Sprite.Pipeline qualified as UnlitSprite
import Render.Unlit.Textured.Pipeline qualified as UnlitTextured
import Render.Unlit.TileMap.Pipeline qualified as UnlitTileMap

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
  { rpForwardMsaa :: ForwardMsaa
  , rpShadowPass  :: ShadowMap
  }

instance RenderPass RenderPasses where
  updateRenderpass swapchain RenderPasses{..} = RenderPasses
    <$> ForwardMsaa.updateMsaa swapchain rpForwardMsaa
    <*> pure rpShadowPass -- XXX: not a screen pass

  refcountRenderpass RenderPasses{..} = do
    refcountRenderpass rpForwardMsaa
    refcountRenderpass rpShadowPass

data Settings = Settings
  { sShadowSize   :: Word32
  , sShadowLayers :: Word32
  }
  deriving (Eq, Show)

instance Zero Settings where
  zero = Settings
    -- XXX: 1x1 placeholder image
    { sShadowSize   = 1
    , sShadowLayers = 1
    }

allocate
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => Settings
  -> swapchain
  -> ResourceT (RIO env) RenderPasses
allocate Settings{..} swapchain = do
  rpForwardMsaa <- ForwardMsaa.allocateMsaa swapchain

  rpShadowPass <- ShadowPass.allocate
    swapchain
    sShadowSize
    sShadowLayers

  pure RenderPasses{..}

allocate_
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => swapchain
  -> ResourceT (RIO env) RenderPasses
allocate_ = allocate zero

data Pipelines = Pipelines
  { pMSAA       :: Vk.SampleCountFlagBits
  , pSceneBinds :: Tagged Scene DsBindings

  , pEvanwSdf :: EvanwSdf.Pipeline
  , pSkybox   :: Skybox.Pipeline

  , pDebugUV      :: Debug.Pipeline
  , pDebugTexture :: Debug.Pipeline
  , pDebugShadow  :: Debug.Pipeline

  , pDepthOnly :: DepthOnly.Pipeline

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

  , pUnlitColored        :: UnlitColored.Pipeline
  , pUnlitColoredNoDepth :: UnlitColored.Pipeline
  , pUnlitTextured       :: UnlitTextured.Pipeline
  , pUnlitTexturedBlend  :: UnlitTextured.Pipeline

  , pSprite              :: UnlitSprite.Pipeline
  , pSpriteOutline       :: UnlitSprite.Pipeline
  , pTileMap             :: UnlitTileMap.Pipeline
  , pTileMapBlend        :: UnlitTileMap.Pipeline
  , pWireframe           :: UnlitColored.Pipeline
  , pWireframeNoDepth    :: UnlitColored.Pipeline

  , pShadowCast :: ShadowPipe.Pipeline
  }

allocatePipelines_
  :: HasSwapchain swapchain
  => swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ swapchain renderpasses = do
  (_, samplers) <- Samplers.allocate
    (Swapchain.getAnisotropy swapchain)

  allocatePipelines
    (Scene.mkBindings samplers Nothing Nothing 0)
    (Swapchain.getMultisample swapchain)
    renderpasses

allocatePipelines
  :: Tagged Scene DsBindings
  -> Vk.SampleCountFlagBits
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines pSceneBinds pMSAA RenderPasses{..} = do
  pDebugUV      <- Debug.allocate Debug.UV         pMSAA pSceneBinds rpForwardMsaa
  pDebugTexture <- Debug.allocate Debug.Texture    pMSAA pSceneBinds rpForwardMsaa
  pDebugShadow  <- Debug.allocate (Debug.Shadow 1) pMSAA pSceneBinds rpForwardMsaa

  pEvanwSdf <- EvanwSdf.allocate pMSAA pSceneBinds rpForwardMsaa
  pSkybox   <- Skybox.allocate pMSAA pSceneBinds rpForwardMsaa

  pDepthOnly <- DepthOnly.allocate pMSAA pSceneBinds rpForwardMsaa

  pLitColored       <- LitColored.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitColoredBlend  <- LitColored.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pLitMaterial      <- LitMaterial.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitMaterialBlend <- LitMaterial.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pLitTextured      <- LitTextured.allocate pMSAA pSceneBinds rpForwardMsaa
  pLitTexturedBlend <- LitTextured.allocateBlend pMSAA pSceneBinds rpForwardMsaa

  pSprite              <- UnlitSprite.allocate pMSAA Nothing False pSceneBinds rpForwardMsaa
  pSpriteOutline       <- UnlitSprite.allocate pMSAA Nothing True pSceneBinds rpForwardMsaa
  pTileMap             <- UnlitTileMap.allocate pMSAA pSceneBinds rpForwardMsaa
  pTileMapBlend        <- UnlitTileMap.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pUnlitColored        <- UnlitColored.allocate True pMSAA pSceneBinds rpForwardMsaa
  pUnlitColoredNoDepth <- UnlitColored.allocate False pMSAA pSceneBinds rpForwardMsaa
  pUnlitTextured       <- UnlitTextured.allocate pMSAA pSceneBinds rpForwardMsaa
  pUnlitTexturedBlend  <- UnlitTextured.allocateBlend pMSAA pSceneBinds rpForwardMsaa
  pWireframe           <- UnlitColored.allocateWireframe True pMSAA pSceneBinds rpForwardMsaa
  pWireframeNoDepth    <- UnlitColored.allocateWireframe False pMSAA pSceneBinds rpForwardMsaa

  let sunBinds = Sun.set0
  pShadowCast <- ShadowPipe.allocate sunBinds rpShadowPass ShadowPipe.defaults

  pure Pipelines{..}

getSceneLayout :: Pipelines -> Tagged '[Scene] Vk.DescriptorSetLayout
getSceneLayout Pipelines{pLitColored} =
  case Vector.headM (unTagged $ Pipeline.pDescLayouts pLitColored) of
    Nothing ->
      error "pLitColored has at least set0 in layout"
    Just set0layout ->
      Tagged set0layout

getSunLayout :: Pipelines -> Tagged '[Sun] Vk.DescriptorSetLayout
getSunLayout Pipelines{pShadowCast} =
  case Vector.headM (unTagged $ Pipeline.pDescLayouts pShadowCast) of
    Nothing ->
      error "pShadowCast has at least set0 in layout"
    Just set0layout ->
      Tagged set0layout