{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedLists #-}

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

module Render.Basic where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Data.Kind (Type)
import Data.Tagged (Tagged(..))
import RIO.FilePath ((</>), (<.>))
import RIO.Vector.Partial as Vector (headM)
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (Zero(..))

-- keid-core

import Engine.Stage.Component qualified as Stage
import Engine.Types (StageRIO)
import Engine.Types qualified as Engine
import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Pipeline.External (type (^))
import Engine.Vulkan.Pipeline.External qualified as External
import Engine.Vulkan.Pipeline.Graphics qualified as Graphics
import Engine.Vulkan.Shader qualified as Shader
import Engine.Vulkan.Swapchain qualified as Swapchain
import Engine.Vulkan.Types (DsBindings, HasSwapchain, HasVulkan, RenderPass(..))
import Engine.Worker qualified as Worker
import Resource.Region qualified as Region

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

-- |  Basic rendering component without any extensions.
type Rendering = Stage.Rendering RenderPasses Pipelines

-- |  Basic rendering component without any extensions and resources.
rendering_ :: Rendering st
rendering_ :: forall st. Rendering st
rendering_ = Rendering :: forall rp p st.
(SwapchainResources -> ResourceT (StageRIO st) rp)
-> (SwapchainResources -> rp -> ResourceT (StageRIO st) p)
-> Rendering rp p st
Stage.Rendering
  { $sel:rAllocateRP:Rendering :: SwapchainResources -> ResourceT (StageRIO st) RenderPasses
rAllocateRP = SwapchainResources -> ResourceT (StageRIO st) RenderPasses
forall swapchain env.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
swapchain -> ResourceT (RIO env) RenderPasses
allocate_
  , $sel:rAllocateP:Rendering :: SwapchainResources
-> RenderPasses -> ResourceT (StageRIO st) Pipelines
rAllocateP = SwapchainResources
-> RenderPasses -> ResourceT (StageRIO st) Pipelines
forall swapchain st.
HasSwapchain swapchain =>
swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
allocatePipelines_
  }

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

instance RenderPass RenderPasses where
  updateRenderpass :: forall env swapchain.
(HasLogFunc env, HasSwapchain swapchain, HasVulkan env,
 MonadResource (RIO env)) =>
swapchain -> RenderPasses -> RIO env RenderPasses
updateRenderpass swapchain
swapchain 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
<$> swapchain -> ForwardMsaa -> RIO env ForwardMsaa
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain swapchain) =>
swapchain -> ForwardMsaa -> m ForwardMsaa
ForwardMsaa.updateMsaa swapchain
swapchain 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 :: forall env. MonadResource (RIO env) => 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 Settings = Settings
  { Settings -> Word32
sShadowSize   :: Word32
  , Settings -> Word32
sShadowLayers :: Word32
  }
  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)

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

allocate
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => Settings
  -> swapchain
  -> ResourceT (RIO env) RenderPasses
allocate :: forall swapchain env.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
Settings -> swapchain -> ResourceT (RIO env) RenderPasses
allocate Settings{Word32
sShadowLayers :: Word32
sShadowSize :: Word32
$sel:sShadowLayers:Settings :: Settings -> Word32
$sel:sShadowSize:Settings :: Settings -> Word32
..} swapchain
swapchain = do
  ForwardMsaa
rpForwardMsaa <- swapchain -> ResourceT (RIO env) ForwardMsaa
forall (m :: * -> *) env swapchain.
(MonadResource m, MonadVulkan env m, HasLogFunc env,
 HasSwapchain swapchain) =>
swapchain -> m ForwardMsaa
ForwardMsaa.allocateMsaa swapchain
swapchain

  ShadowMap
rpShadowPass <- swapchain -> 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
    swapchain
swapchain
    Word32
sShadowSize
    Word32
sShadowLayers

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

allocate_
  :: ( HasSwapchain swapchain
     , HasLogFunc env
     , HasVulkan env
     )
  => swapchain
  -> ResourceT (RIO env) RenderPasses
allocate_ :: forall swapchain env.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
swapchain -> ResourceT (RIO env) RenderPasses
allocate_ = Settings -> swapchain -> ResourceT (RIO env) RenderPasses
forall swapchain env.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
Settings -> swapchain -> ResourceT (RIO env) RenderPasses
allocate Settings
forall a. Zero a => a
zero

type Pipelines = PipelinesF Identity
type PipelineObservers = PipelinesF External.Observers
type PipelineWorkers = PipelinesF External.ConfigureGraphics

data PipelinesF (f :: Type -> Type) = Pipelines
  { forall (f :: * -> *). PipelinesF f -> SampleCountFlagBits
pMSAA       :: Vk.SampleCountFlagBits
  , forall (f :: * -> *). PipelinesF f -> Tagged Scene DsBindings
pSceneBinds :: Tagged Scene DsBindings
  , forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
pSceneLayout :: Tagged '[Scene] Vk.DescriptorSetLayout

  , forall (f :: * -> *). PipelinesF f -> Tagged Sun DsBindings
pShadowBinds :: Tagged Sun DsBindings
  , forall (f :: * -> *).
PipelinesF f -> Tagged '[Sun] DescriptorSetLayout
pShadowLayout :: Tagged '[Sun] Vk.DescriptorSetLayout

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pEvanwSdf :: f ^ EvanwSdf.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSkybox   :: f ^ Skybox.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugUV      :: f ^ Debug.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugTexture :: f ^ Debug.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugShadow  :: f ^ Debug.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDepthOnly :: f ^ DepthOnly.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitColored       :: f ^ LitColored.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitColoredBlend  :: f ^ LitColored.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitMaterial      :: f ^ LitMaterial.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitMaterialBlend :: f ^ LitMaterial.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitTextured      :: f ^ LitTextured.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitTexturedBlend :: f ^ LitTextured.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitColored        :: f ^ UnlitColored.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitColoredNoDepth :: f ^ UnlitColored.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitTextured       :: f ^ UnlitTextured.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitTexturedBlend  :: f ^ UnlitTextured.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSprite              :: f ^ UnlitSprite.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSpriteOutline       :: f ^ UnlitSprite.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pTileMap             :: f ^ UnlitTileMap.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pTileMapBlend        :: f ^ UnlitTileMap.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pWireframe           :: f ^ UnlitColored.Pipeline
  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pWireframeNoDepth    :: f ^ UnlitColored.Pipeline

  , forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pShadowCast :: f ^ ShadowPipe.Pipeline
  }

allocatePipelines_
  :: HasSwapchain swapchain
  => swapchain
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ :: forall swapchain st.
HasSwapchain swapchain =>
swapchain -> RenderPasses -> ResourceT (StageRIO st) Pipelines
allocatePipelines_ swapchain
swapchain RenderPasses
renderpasses = do
  (ReleaseKey
_, Collection Sampler
samplers) <- ("max anisotropy" ::: Float)
-> ResourceT (StageRIO st) (ReleaseKey, Collection Sampler)
forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
("max anisotropy" ::: Float) -> m (ReleaseKey, Collection Sampler)
Samplers.allocate
    (swapchain -> "max anisotropy" ::: Float
forall a. HasSwapchain a => a -> "max anisotropy" ::: Float
Swapchain.getAnisotropy swapchain
swapchain)

  Tagged Scene DsBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) Pipelines
forall st.
Tagged Scene DsBindings
-> SampleCountFlagBits
-> 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 -> SampleCountFlagBits
forall a. HasSwapchain a => a -> SampleCountFlagBits
Swapchain.getMultisample swapchain
swapchain)
    RenderPasses
renderpasses

allocatePipelines
  :: Tagged Scene DsBindings
  -> Vk.SampleCountFlagBits
  -> RenderPasses
  -> ResourceT (StageRIO st) Pipelines
allocatePipelines :: forall st.
Tagged Scene DsBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) Pipelines
allocatePipelines Tagged Scene DsBindings
pSceneBinds SampleCountFlagBits
pMSAA RenderPasses{ForwardMsaa
ShadowMap
rpShadowPass :: ShadowMap
rpForwardMsaa :: ForwardMsaa
$sel:rpShadowPass:RenderPasses :: RenderPasses -> ShadowMap
$sel:rpForwardMsaa:RenderPasses :: RenderPasses -> ForwardMsaa
..} = do
  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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa

  Pipeline
pDebugUV      <- Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
Debug.allocate Mode
Debug.UV         SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pDebugTexture <- Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
Debug.allocate Mode
Debug.Texture    SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pDebugShadow  <- Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Mode
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
Debug.allocate (Word32 -> Mode
Debug.Shadow Word32
1) SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa

  Pipeline
pDepthOnly <- 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
DepthOnly.allocate SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa

  Pipeline
pSprite              <- SampleCountFlagBits
-> Maybe ("max anisotropy" ::: Float)
-> Bool
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Maybe ("max anisotropy" ::: Float)
-> Bool
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitSprite.allocate SampleCountFlagBits
pMSAA Maybe ("max anisotropy" ::: Float)
forall a. Maybe a
Nothing Bool
False Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pSpriteOutline       <- SampleCountFlagBits
-> Maybe ("max anisotropy" ::: Float)
-> Bool
-> Tagged Scene DsBindings
-> ForwardMsaa
-> ResourceT (StageRIO st) Pipeline
forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Maybe ("max anisotropy" ::: Float)
-> Bool
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
UnlitSprite.allocate SampleCountFlagBits
pMSAA Maybe ("max anisotropy" ::: Float)
forall a. Maybe a
Nothing Bool
True Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pTileMap             <- 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
UnlitTileMap.allocate SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa
  Pipeline
pTileMapBlend        <- 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
UnlitTileMap.allocateBlend SampleCountFlagBits
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds 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
pMSAA Tagged Scene DsBindings
pSceneBinds ForwardMsaa
rpForwardMsaa

  let pShadowBinds :: Tagged Sun DsBindings
pShadowBinds = 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
pShadowBinds ShadowMap
rpShadowPass Settings
ShadowPipe.defaults

  let
    pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pSceneLayout =
      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 ->
          String -> Tagged '[Scene] DescriptorSetLayout
forall a. HasCallStack => String -> a
error String
"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

    pShadowLayout :: Tagged '[Sun] DescriptorSetLayout
pShadowLayout =
      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 ->
          String -> Tagged '[Sun] DescriptorSetLayout
forall a. HasCallStack => String -> a
error String
"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

  pure Pipelines :: forall (f :: * -> *).
SampleCountFlagBits
-> Tagged Scene DsBindings
-> Tagged '[Scene] DescriptorSetLayout
-> Tagged Sun DsBindings
-> Tagged '[Sun] DescriptorSetLayout
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> PipelinesF f
Pipelines{Tagged '[Sun] DescriptorSetLayout
Tagged '[Scene] DescriptorSetLayout
Tagged Sun DsBindings
Tagged Scene DsBindings
SampleCountFlagBits
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
Identity ^ Pipeline
pShadowLayout :: Tagged '[Sun] DescriptorSetLayout
pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pShadowCast :: Pipeline
pShadowBinds :: Tagged Sun DsBindings
pWireframeNoDepth :: Pipeline
pWireframe :: Pipeline
pUnlitTexturedBlend :: Pipeline
pUnlitTextured :: Pipeline
pUnlitColoredNoDepth :: Pipeline
pUnlitColored :: Pipeline
pTileMapBlend :: Pipeline
pTileMap :: Pipeline
pSpriteOutline :: Pipeline
pSprite :: Pipeline
pLitTexturedBlend :: Pipeline
pLitTextured :: Pipeline
pLitMaterialBlend :: Pipeline
pLitMaterial :: Pipeline
pLitColoredBlend :: Pipeline
pLitColored :: Pipeline
pDepthOnly :: Pipeline
pDebugShadow :: Pipeline
pDebugTexture :: Pipeline
pDebugUV :: Pipeline
pSkybox :: Pipeline
pEvanwSdf :: Pipeline
pMSAA :: SampleCountFlagBits
pSceneBinds :: Tagged Scene DsBindings
$sel:pShadowCast:Pipelines :: Identity ^ Pipeline
$sel:pWireframeNoDepth:Pipelines :: Identity ^ Pipeline
$sel:pWireframe:Pipelines :: Identity ^ Pipeline
$sel:pTileMapBlend:Pipelines :: Identity ^ Pipeline
$sel:pTileMap:Pipelines :: Identity ^ Pipeline
$sel:pSpriteOutline:Pipelines :: Identity ^ Pipeline
$sel:pSprite:Pipelines :: Identity ^ Pipeline
$sel:pUnlitTexturedBlend:Pipelines :: Identity ^ Pipeline
$sel:pUnlitTextured:Pipelines :: Identity ^ Pipeline
$sel:pUnlitColoredNoDepth:Pipelines :: Identity ^ Pipeline
$sel:pUnlitColored:Pipelines :: Identity ^ Pipeline
$sel:pLitTexturedBlend:Pipelines :: Identity ^ Pipeline
$sel:pLitTextured:Pipelines :: Identity ^ Pipeline
$sel:pLitMaterialBlend:Pipelines :: Identity ^ Pipeline
$sel:pLitMaterial:Pipelines :: Identity ^ Pipeline
$sel:pLitColoredBlend:Pipelines :: Identity ^ Pipeline
$sel:pLitColored:Pipelines :: Identity ^ Pipeline
$sel:pDepthOnly:Pipelines :: Identity ^ Pipeline
$sel:pDebugShadow:Pipelines :: Identity ^ Pipeline
$sel:pDebugTexture:Pipelines :: Identity ^ Pipeline
$sel:pDebugUV:Pipelines :: Identity ^ Pipeline
$sel:pSkybox:Pipelines :: Identity ^ Pipeline
$sel:pEvanwSdf:Pipelines :: Identity ^ Pipeline
$sel:pShadowLayout:Pipelines :: Tagged '[Sun] DescriptorSetLayout
$sel:pShadowBinds:Pipelines :: Tagged Sun DsBindings
$sel:pSceneLayout:Pipelines :: Tagged '[Scene] DescriptorSetLayout
$sel:pSceneBinds:Pipelines :: Tagged Scene DsBindings
$sel:pMSAA:Pipelines :: SampleCountFlagBits
..}

allocateWorkers
  :: Tagged Scene DsBindings
  -> Vk.SampleCountFlagBits
  -> RenderPasses
  -> ResourceT (StageRIO st) PipelineWorkers
allocateWorkers :: forall st.
Tagged Scene DsBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) PipelineWorkers
allocateWorkers Tagged Scene DsBindings
sceneBinds SampleCountFlagBits
pMSAA RenderPasses
renderPasses = do
  Pipelines
builtin <- Tagged Scene DsBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) Pipelines
forall st.
Tagged Scene DsBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) Pipelines
allocatePipelines Tagged Scene DsBindings
sceneBinds SampleCountFlagBits
pMSAA RenderPasses
renderPasses

  let
    evanwSdfFiles :: Stages (Maybe String)
evanwSdfFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"evanw-sdf" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"evanw-sdf" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] () InstanceAttrs ())
evanwSdfWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] () InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] () InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] () InstanceAttrs ())))
-> (StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] () InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] () InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] () InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] () InstanceAttrs ())
-> StageRIO st (Process (Config '[Scene] () InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"evanw-sdf" Stages (Maybe String)
evanwSdfFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
EvanwSdf.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    skyboxFiles :: Stages (Maybe String)
skyboxFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"skybox" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"skybox" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] () () ())
skyboxWorker <- StageRIO st (ReleaseKey, Process (Config '[Scene] () () ()))
-> ResourceT (StageRIO st) (Process (Config '[Scene] () () ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO st (ReleaseKey, Process (Config '[Scene] () () ()))
 -> ResourceT (StageRIO st) (Process (Config '[Scene] () () ())))
-> (StageRIO st (Process (Config '[Scene] () () ()))
    -> StageRIO st (ReleaseKey, Process (Config '[Scene] () () ())))
-> StageRIO st (Process (Config '[Scene] () () ()))
-> ResourceT (StageRIO st) (Process (Config '[Scene] () () ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] () () ()))
-> StageRIO st (ReleaseKey, Process (Config '[Scene] () () ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] () () ()))
 -> ResourceT (StageRIO st) (Process (Config '[Scene] () () ())))
-> StageRIO st (Process (Config '[Scene] () () ()))
-> ResourceT (StageRIO st) (Process (Config '[Scene] () () ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] () () ())
-> StageRIO st (Process (Config '[Scene] () () ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"skybox" Stages (Maybe String)
skyboxFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
Skybox.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    debugFiles :: Stages (Maybe String)
debugFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"debug" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"debug" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] Vec2 InstanceAttrs Mode)
debugUVWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs Mode)
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"debug-uv" Stages (Maybe String)
debugFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Mode -> Tagged Scene DsBindings -> Config
Debug.config Mode
Debug.UV Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec2 InstanceAttrs Mode)
debugTextureWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs Mode)
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"debug-texture" Stages (Maybe String)
debugFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Mode -> Tagged Scene DsBindings -> Config
Debug.config Mode
Debug.Texture Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec2 InstanceAttrs Mode)
debugShadowWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode)))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs Mode)
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs Mode))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"debug-shadow" Stages (Maybe String)
debugFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Mode -> Tagged Scene DsBindings -> Config
Debug.config (Word32 -> Mode
Debug.Shadow Word32
1) Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    depthOnlyFiles :: Stages (Maybe String)
depthOnlyFiles = String -> Stages (Maybe String)
forall a. ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.vertexOnly
      (String
shaderDir String -> ShowS
</> String
"depth-only" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] () Transform ())
depthOnlyWorker <- StageRIO st (ReleaseKey, Process (Config '[Scene] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] () Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] () Transform ())))
-> (StageRIO st (Process (Config '[Scene] () Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] () Transform ())))
-> StageRIO st (Process (Config '[Scene] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] () Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] () Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] () Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] () Transform ())))
-> StageRIO st (Process (Config '[Scene] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] () Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] () Transform ())
-> StageRIO st (Process (Config '[Scene] () Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"debug" Stages (Maybe String)
depthOnlyFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
DepthOnly.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    litColoredFiles :: Stages (Maybe String)
litColoredFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"lit-colored" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"lit-colored" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] VertexAttrs Transform ())
litColoredWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs Transform ()))
    -> StageRIO
         st
         (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs Transform ())
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-colored" Stages (Maybe String)
litColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitColored.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] VertexAttrs Transform ())
litColoredBlendWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs Transform ()))
    -> StageRIO
         st
         (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs Transform ())
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-colored-blend" Stages (Maybe String)
litColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitColored.configBlend Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    litMaterialFiles :: Stages (Maybe String)
litMaterialFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"lit-material" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"lit-material" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] VertexAttrs Transform ())
litMaterialWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs Transform ()))
    -> StageRIO
         st
         (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs Transform ())
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-material" Stages (Maybe String)
litMaterialFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitMaterial.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] VertexAttrs Transform ())
litMaterialBlendWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs Transform ()))
    -> StageRIO
         st
         (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ())))
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] VertexAttrs Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs Transform ())
-> StageRIO st (Process (Config '[Scene] VertexAttrs Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-material-blend" Stages (Maybe String)
litMaterialFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitMaterial.configBlend Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    litTexturedFiles :: Stages (Maybe String)
litTexturedFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"lit-textured" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"lit-textured" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] VertexAttrs InstanceAttrs ())
litTexturedWorker <- StageRIO
  st
  (ReleaseKey,
   Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st
   (ReleaseKey,
    Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
 -> ResourceT
      (StageRIO st)
      (Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
    -> StageRIO
         st
         (ReleaseKey,
          Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO
  st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> StageRIO
     st
     (ReleaseKey,
      Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO
   st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
 -> ResourceT
      (StageRIO st)
      (Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs InstanceAttrs ())
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-textured" Stages (Maybe String)
litTexturedFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitTextured.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] VertexAttrs InstanceAttrs ())
litTexturedBlendWorker <- StageRIO
  st
  (ReleaseKey,
   Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st
   (ReleaseKey,
    Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
 -> ResourceT
      (StageRIO st)
      (Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> (StageRIO
      st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
    -> StageRIO
         st
         (ReleaseKey,
          Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO
  st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> StageRIO
     st
     (ReleaseKey,
      Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO
   st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
 -> ResourceT
      (StageRIO st)
      (Process (Config '[Scene] VertexAttrs InstanceAttrs ())))
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
-> ResourceT
     (StageRIO st)
     (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] VertexAttrs InstanceAttrs ())
-> StageRIO
     st (Process (Config '[Scene] VertexAttrs InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"lit-textured-blend" Stages (Maybe String)
litTexturedFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
LitTextured.configBlend Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    unlitColoredFiles :: Stages (Maybe String)
unlitColoredFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"unlit-colored" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"unlit-colored" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] Vec4 Transform ())
unlitColoredWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec4 Transform ())
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"unlit-colored" Stages (Maybe String)
unlitColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Bool -> Tagged Scene DsBindings -> Config
UnlitColored.config Bool
True Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec4 Transform ())
unlitColoredNoDepthWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec4 Transform ())
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"unlit-colored-nodepth" Stages (Maybe String)
unlitColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Bool -> Tagged Scene DsBindings -> Config
UnlitColored.config Bool
False Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    unlitTexturedFiles :: Stages (Maybe String)
unlitTexturedFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"unlit-textured" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"unlit-textured" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] Vec2 InstanceAttrs ())
unlitTexturedWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs ())
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"unlit-textured" Stages (Maybe String)
unlitTexturedFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
UnlitTextured.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec2 InstanceAttrs ())
unlitTexturedBlendWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs ())
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"unlit-textured" Stages (Maybe String)
unlitTexturedFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
UnlitTextured.configBlend Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    spriteFiles :: Stages (Maybe String)
spriteFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"sprite" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"sprite" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
spriteWorker <- StageRIO
  st
  (ReleaseKey,
   Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st
   (ReleaseKey,
    Process
      (Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
 -> ResourceT
      (StageRIO st)
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> (StageRIO
      st
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
    -> StageRIO
         st
         (ReleaseKey,
          Process
            (Config
               '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO
  st
  (Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> StageRIO
     st
     (ReleaseKey,
      Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO
   st
   (Process
      (Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
 -> ResourceT
      (StageRIO st)
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"sprite" Stages (Maybe String)
spriteFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Maybe ("max anisotropy" ::: Float)
-> Bool -> Tagged Scene DsBindings -> Config
UnlitSprite.config Maybe ("max anisotropy" ::: Float)
forall a. Maybe a
Nothing Bool
False Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
spriteOutlineWorker <- StageRIO
  st
  (ReleaseKey,
   Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st
   (ReleaseKey,
    Process
      (Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
 -> ResourceT
      (StageRIO st)
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> (StageRIO
      st
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
    -> StageRIO
         st
         (ReleaseKey,
          Process
            (Config
               '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO
  st
  (Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> StageRIO
     st
     (ReleaseKey,
      Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO
   st
   (Process
      (Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
 -> ResourceT
      (StageRIO st)
      (Process
         (Config
            '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
-> ResourceT
     (StageRIO st)
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config
         '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
-> StageRIO
     st
     (Process
        (Config
           '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool)))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"sprite" Stages (Maybe String)
spriteFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Maybe ("max anisotropy" ::: Float)
-> Bool -> Tagged Scene DsBindings -> Config
UnlitSprite.config Maybe ("max anisotropy" ::: Float)
forall a. Maybe a
Nothing Bool
True Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    tileMapFiles :: Stages (Maybe String)
tileMapFiles =
      String -> String -> Stages (Maybe String)
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages
        (String
shaderDir String -> ShowS
</> String
"tilemap" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")
        (String
shaderDir String -> ShowS
</> String
"tilemap" String -> ShowS
<.> String
"frag" String -> ShowS
<.> String
"spv")

  Process (Config '[Scene] Vec2 InstanceAttrs ())
tileMapWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs ())
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"tilemap" Stages (Maybe String)
tileMapFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
UnlitTileMap.config Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec2 InstanceAttrs ())
tileMapBlendWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ())))
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec2 InstanceAttrs ())
-> StageRIO st (Process (Config '[Scene] Vec2 InstanceAttrs ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"tilemap" Stages (Maybe String)
tileMapFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Scene DsBindings -> Config
UnlitTileMap.configBlend Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec4 Transform ())
wireframeWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec4 Transform ())
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"wireframe" Stages (Maybe String)
unlitColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Bool -> Tagged Scene DsBindings -> Config
UnlitColored.configWireframe Bool
True Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  Process (Config '[Scene] Vec4 Transform ())
wireframeNoDepthWorker <- StageRIO
  st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO
   st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Scene] Vec4 Transform ())))
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Scene] Vec4 Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Scene] Vec4 Transform ())
-> StageRIO st (Process (Config '[Scene] Vec4 Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"wireframe-nodepth" Stages (Maybe String)
unlitColoredFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Bool -> Tagged Scene DsBindings -> Config
UnlitColored.configWireframe Bool
False Tagged Scene DsBindings
sceneBinds)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  let
    shadowCastFiles :: Stages (Maybe String)
shadowCastFiles =
      String -> Stages (Maybe String)
forall a. ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.vertexOnly
        (String
shaderDir String -> ShowS
</> String
"shadow-cast" String -> ShowS
<.> String
"vert" String -> ShowS
<.> String
"spv")

  Process (Config '[Sun] () Transform ())
shadowCastWorker <- StageRIO st (ReleaseKey, Process (Config '[Sun] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Sun] () Transform ()))
forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local (StageRIO st (ReleaseKey, Process (Config '[Sun] () Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Sun] () Transform ())))
-> (StageRIO st (Process (Config '[Sun] () Transform ()))
    -> StageRIO
         st (ReleaseKey, Process (Config '[Sun] () Transform ())))
-> StageRIO st (Process (Config '[Sun] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Sun] () Transform ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageRIO st (Process (Config '[Sun] () Transform ()))
-> StageRIO
     st (ReleaseKey, Process (Config '[Sun] () Transform ()))
forall (m :: * -> *) a.
(MonadResource m, HasWorker a) =>
m a -> m (ReleaseKey, a)
Worker.registered (StageRIO st (Process (Config '[Sun] () Transform ()))
 -> ResourceT
      (StageRIO st) (Process (Config '[Sun] () Transform ())))
-> StageRIO st (Process (Config '[Sun] () Transform ()))
-> ResourceT
     (StageRIO st) (Process (Config '[Sun] () Transform ()))
forall a b. (a -> b) -> a -> b
$
    Text
-> Stages (Maybe String)
-> ((Stages (Maybe ByteString), Reflect Stages)
    -> Config '[Sun] () Transform ())
-> StageRIO st (Process (Config '[Sun] () Transform ()))
forall (m :: * -> *) env (stages :: * -> *) config.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasProcessContext env, StageInfo stages) =>
Text
-> stages (Maybe String)
-> ((stages (Maybe ByteString), Reflect stages) -> config)
-> m (Process config)
External.spawnReflect Text
"shadow-cast" Stages (Maybe String)
shadowCastFiles \(Stages (Maybe ByteString)
stageCode, Reflect Stages
reflect) ->
      (Tagged Sun DsBindings -> Settings -> Config
ShadowPipe.config (Pipelines -> Tagged Sun DsBindings
forall (f :: * -> *). PipelinesF f -> Tagged Sun DsBindings
pShadowBinds Pipelines
builtin) Settings
ShadowPipe.defaults)
        { $sel:cStages:Config :: Stages (Maybe ByteString)
Graphics.cStages = Stages (Maybe ByteString)
stageCode
        , $sel:cReflect:Config :: Maybe (Reflect Stages)
Graphics.cReflect = Reflect Stages -> Maybe (Reflect Stages)
forall a. a -> Maybe a
Just Reflect Stages
reflect
        }

  pure Pipelines
builtin
    { $sel:pEvanwSdf:Pipelines :: ConfigureGraphics ^ Pipeline
pEvanwSdf = Process (Config '[Scene] () InstanceAttrs ())
ConfigureGraphics ^ Pipeline
evanwSdfWorker
    , $sel:pSkybox:Pipelines :: ConfigureGraphics ^ Pipeline
pSkybox = Process (Config '[Scene] () () ())
ConfigureGraphics ^ Pipeline
skyboxWorker
    , $sel:pDebugUV:Pipelines :: ConfigureGraphics ^ Pipeline
pDebugUV = Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
debugUVWorker
    , $sel:pDebugTexture:Pipelines :: ConfigureGraphics ^ Pipeline
pDebugTexture = Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
debugTextureWorker
    , $sel:pDebugShadow:Pipelines :: ConfigureGraphics ^ Pipeline
pDebugShadow = Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
debugShadowWorker
    , $sel:pDepthOnly:Pipelines :: ConfigureGraphics ^ Pipeline
pDepthOnly = Process (Config '[Scene] () Transform ())
ConfigureGraphics ^ Pipeline
depthOnlyWorker
    , $sel:pLitColored:Pipelines :: ConfigureGraphics ^ Pipeline
pLitColored = Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
litColoredWorker
    , $sel:pLitColoredBlend:Pipelines :: ConfigureGraphics ^ Pipeline
pLitColoredBlend = Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
litColoredBlendWorker
    , $sel:pLitMaterial:Pipelines :: ConfigureGraphics ^ Pipeline
pLitMaterial = Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
litMaterialWorker
    , $sel:pLitMaterialBlend:Pipelines :: ConfigureGraphics ^ Pipeline
pLitMaterialBlend = Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
litMaterialBlendWorker
    , $sel:pLitTextured:Pipelines :: ConfigureGraphics ^ Pipeline
pLitTextured = Process (Config '[Scene] VertexAttrs InstanceAttrs ())
ConfigureGraphics ^ Pipeline
litTexturedWorker
    , $sel:pLitTexturedBlend:Pipelines :: ConfigureGraphics ^ Pipeline
pLitTexturedBlend = Process (Config '[Scene] VertexAttrs InstanceAttrs ())
ConfigureGraphics ^ Pipeline
litTexturedBlendWorker
    , $sel:pUnlitColored:Pipelines :: ConfigureGraphics ^ Pipeline
pUnlitColored = Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
unlitColoredWorker
    , $sel:pUnlitColoredNoDepth:Pipelines :: ConfigureGraphics ^ Pipeline
pUnlitColoredNoDepth = Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
unlitColoredNoDepthWorker
    , $sel:pUnlitTextured:Pipelines :: ConfigureGraphics ^ Pipeline
pUnlitTextured = Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
unlitTexturedWorker
    , $sel:pUnlitTexturedBlend:Pipelines :: ConfigureGraphics ^ Pipeline
pUnlitTexturedBlend = Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
unlitTexturedBlendWorker
    , $sel:pSprite:Pipelines :: ConfigureGraphics ^ Pipeline
pSprite = Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
ConfigureGraphics ^ Pipeline
spriteWorker
    , $sel:pSpriteOutline:Pipelines :: ConfigureGraphics ^ Pipeline
pSpriteOutline = Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
ConfigureGraphics ^ Pipeline
spriteOutlineWorker
    , $sel:pTileMap:Pipelines :: ConfigureGraphics ^ Pipeline
pTileMap = Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
tileMapWorker
    , $sel:pTileMapBlend:Pipelines :: ConfigureGraphics ^ Pipeline
pTileMapBlend = Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
tileMapBlendWorker
    , $sel:pWireframe:Pipelines :: ConfigureGraphics ^ Pipeline
pWireframe = Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
wireframeWorker
    , $sel:pWireframeNoDepth:Pipelines :: ConfigureGraphics ^ Pipeline
pWireframeNoDepth = Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
wireframeNoDepthWorker
    , $sel:pShadowCast:Pipelines :: ConfigureGraphics ^ Pipeline
pShadowCast = Process (Config '[Sun] () Transform ())
ConfigureGraphics ^ Pipeline
shadowCastWorker
    }

allocateObservers
  :: RenderPasses
  -> PipelineWorkers
  -> ResourceT (Engine.StageRIO rs) PipelineObservers
allocateObservers :: forall rs.
RenderPasses
-> PipelineWorkers -> ResourceT (StageRIO rs) PipelineObservers
allocateObservers RenderPasses
renderPasses Pipelines{Tagged '[Sun] DescriptorSetLayout
Tagged '[Scene] DescriptorSetLayout
Tagged Sun DsBindings
Tagged Scene DsBindings
SampleCountFlagBits
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
ConfigureGraphics ^ Pipeline
pShadowCast :: ConfigureGraphics ^ Pipeline
pWireframeNoDepth :: ConfigureGraphics ^ Pipeline
pWireframe :: ConfigureGraphics ^ Pipeline
pTileMapBlend :: ConfigureGraphics ^ Pipeline
pTileMap :: ConfigureGraphics ^ Pipeline
pSpriteOutline :: ConfigureGraphics ^ Pipeline
pSprite :: ConfigureGraphics ^ Pipeline
pUnlitTexturedBlend :: ConfigureGraphics ^ Pipeline
pUnlitTextured :: ConfigureGraphics ^ Pipeline
pUnlitColoredNoDepth :: ConfigureGraphics ^ Pipeline
pUnlitColored :: ConfigureGraphics ^ Pipeline
pLitTexturedBlend :: ConfigureGraphics ^ Pipeline
pLitTextured :: ConfigureGraphics ^ Pipeline
pLitMaterialBlend :: ConfigureGraphics ^ Pipeline
pLitMaterial :: ConfigureGraphics ^ Pipeline
pLitColoredBlend :: ConfigureGraphics ^ Pipeline
pLitColored :: ConfigureGraphics ^ Pipeline
pDepthOnly :: ConfigureGraphics ^ Pipeline
pDebugShadow :: ConfigureGraphics ^ Pipeline
pDebugTexture :: ConfigureGraphics ^ Pipeline
pDebugUV :: ConfigureGraphics ^ Pipeline
pSkybox :: ConfigureGraphics ^ Pipeline
pEvanwSdf :: ConfigureGraphics ^ Pipeline
pShadowLayout :: Tagged '[Sun] DescriptorSetLayout
pShadowBinds :: Tagged Sun DsBindings
pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pSceneBinds :: Tagged Scene DsBindings
pMSAA :: SampleCountFlagBits
$sel:pShadowCast:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pWireframeNoDepth:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pWireframe:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pTileMapBlend:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pTileMap:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pSpriteOutline:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pSprite:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pUnlitTexturedBlend:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pUnlitTextured:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pUnlitColoredNoDepth:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pUnlitColored:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitTexturedBlend:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitTextured:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitMaterialBlend:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitMaterial:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitColoredBlend:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLitColored:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pDepthOnly:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pDebugShadow:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pDebugTexture:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pDebugUV:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pSkybox:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pEvanwSdf:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pShadowLayout:Pipelines :: forall (f :: * -> *).
PipelinesF f -> Tagged '[Sun] DescriptorSetLayout
$sel:pShadowBinds:Pipelines :: forall (f :: * -> *). PipelinesF f -> Tagged Sun DsBindings
$sel:pSceneLayout:Pipelines :: forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
$sel:pSceneBinds:Pipelines :: forall (f :: * -> *). PipelinesF f -> Tagged Scene DsBindings
$sel:pMSAA:Pipelines :: forall (f :: * -> *). PipelinesF f -> SampleCountFlagBits
..} = do
  Observer Pipeline
evanwSdfExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] () InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] () InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pEvanwSdf

  Observer Pipeline
skyboxExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] () () ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] () () ())
ConfigureGraphics ^ Pipeline
pSkybox

  Observer Pipeline
debugUVExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs Mode)
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
pDebugUV

  Observer Pipeline
debugTextureExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs Mode)
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
pDebugTexture

  Observer Pipeline
debugShadowExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs Mode)
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs Mode)
ConfigureGraphics ^ Pipeline
pDebugShadow

  Observer Pipeline
depthOnlyExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] () Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] () Transform ())
ConfigureGraphics ^ Pipeline
pDepthOnly

  Observer Pipeline
litColoredExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
pLitColored

  Observer Pipeline
litColoredBlendExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
pLitColoredBlend

  Observer Pipeline
litMaterialExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
pLitMaterial

  Observer Pipeline
litMaterialBlendExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs Transform ())
ConfigureGraphics ^ Pipeline
pLitMaterialBlend

  Observer Pipeline
litTexturedExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pLitTextured

  Observer Pipeline
litTexturedBlendExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] VertexAttrs InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] VertexAttrs InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pLitTexturedBlend

  Observer Pipeline
unlitColoredExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec4 Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
pUnlitColored

  Observer Pipeline
unlitColoredNoDepthExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec4 Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
pUnlitColoredNoDepth

  Observer Pipeline
unlitTexturedExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pUnlitTextured

  Observer Pipeline
unlitTexturedBlendExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pUnlitTexturedBlend

  Observer Pipeline
spriteExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
ConfigureGraphics ^ Pipeline
pSprite

  Observer Pipeline
spriteOutlineExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process
     (Config
        '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process
  (Config
     '[Scene] () InstanceAttrs ("max anisotropy" ::: Float, Bool))
ConfigureGraphics ^ Pipeline
pSpriteOutline

  Observer Pipeline
tileMapExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pTileMap

  Observer Pipeline
tileMapBlendExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec2 InstanceAttrs ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec2 InstanceAttrs ())
ConfigureGraphics ^ Pipeline
pTileMapBlend

  Observer Pipeline
wireframeExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec4 Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
pWireframe

  Observer Pipeline
wireframeNoDepthExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Scene] Vec4 Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Scene] Vec4 Transform ())
ConfigureGraphics ^ Pipeline
pWireframeNoDepth

  Observer Pipeline
shadowCastExt <- ForwardMsaa
-> SampleCountFlagBits
-> Process (Config '[Sun] () Transform ())
-> ResourceT (StageRIO rs) (Observer Pipeline)
forall pipeline (dsl :: [*]) vertices instances worker renderpass
       rs.
(pipeline ~ Pipeline dsl vertices instances, HasOutput worker,
 Specialization (Specialization pipeline), HasRenderPass renderpass,
 GetOutput worker ~ Configure pipeline) =>
renderpass
-> SampleCountFlagBits
-> worker
-> ResourceT (StageRIO rs) (Observer pipeline)
External.newObserverGraphics
    ForwardMsaa
forward
    SampleCountFlagBits
pMSAA
    Process (Config '[Sun] () Transform ())
ConfigureGraphics ^ Pipeline
pShadowCast

  pure Pipelines :: forall (f :: * -> *).
SampleCountFlagBits
-> Tagged Scene DsBindings
-> Tagged '[Scene] DescriptorSetLayout
-> Tagged Sun DsBindings
-> Tagged '[Sun] DescriptorSetLayout
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> (f ^ Pipeline)
-> PipelinesF f
Pipelines
    { $sel:pEvanwSdf:Pipelines :: Observers ^ Pipeline
pEvanwSdf = Observer Pipeline
Observers ^ Pipeline
evanwSdfExt
    , $sel:pSkybox:Pipelines :: Observers ^ Pipeline
pSkybox = Observer Pipeline
Observers ^ Pipeline
skyboxExt
    , $sel:pDebugUV:Pipelines :: Observers ^ Pipeline
pDebugUV = Observer Pipeline
Observers ^ Pipeline
debugUVExt
    , $sel:pDebugTexture:Pipelines :: Observers ^ Pipeline
pDebugTexture = Observer Pipeline
Observers ^ Pipeline
debugTextureExt
    , $sel:pDebugShadow:Pipelines :: Observers ^ Pipeline
pDebugShadow = Observer Pipeline
Observers ^ Pipeline
debugShadowExt
    , $sel:pDepthOnly:Pipelines :: Observers ^ Pipeline
pDepthOnly = Observer Pipeline
Observers ^ Pipeline
depthOnlyExt
    , $sel:pLitColored:Pipelines :: Observers ^ Pipeline
pLitColored = Observer Pipeline
Observers ^ Pipeline
litColoredExt
    , $sel:pLitColoredBlend:Pipelines :: Observers ^ Pipeline
pLitColoredBlend = Observer Pipeline
Observers ^ Pipeline
litColoredBlendExt
    , $sel:pLitMaterial:Pipelines :: Observers ^ Pipeline
pLitMaterial = Observer Pipeline
Observers ^ Pipeline
litMaterialExt
    , $sel:pLitMaterialBlend:Pipelines :: Observers ^ Pipeline
pLitMaterialBlend = Observer Pipeline
Observers ^ Pipeline
litMaterialBlendExt
    , $sel:pLitTextured:Pipelines :: Observers ^ Pipeline
pLitTextured = Observer Pipeline
Observers ^ Pipeline
litTexturedExt
    , $sel:pLitTexturedBlend:Pipelines :: Observers ^ Pipeline
pLitTexturedBlend = Observer Pipeline
Observers ^ Pipeline
litTexturedBlendExt
    , $sel:pUnlitColored:Pipelines :: Observers ^ Pipeline
pUnlitColored = Observer Pipeline
Observers ^ Pipeline
unlitColoredExt
    , $sel:pUnlitColoredNoDepth:Pipelines :: Observers ^ Pipeline
pUnlitColoredNoDepth = Observer Pipeline
Observers ^ Pipeline
unlitColoredNoDepthExt
    , $sel:pUnlitTextured:Pipelines :: Observers ^ Pipeline
pUnlitTextured = Observer Pipeline
Observers ^ Pipeline
unlitTexturedExt
    , $sel:pUnlitTexturedBlend:Pipelines :: Observers ^ Pipeline
pUnlitTexturedBlend = Observer Pipeline
Observers ^ Pipeline
unlitTexturedBlendExt
    , $sel:pSprite:Pipelines :: Observers ^ Pipeline
pSprite = Observer Pipeline
Observers ^ Pipeline
spriteExt
    , $sel:pSpriteOutline:Pipelines :: Observers ^ Pipeline
pSpriteOutline = Observer Pipeline
Observers ^ Pipeline
spriteOutlineExt
    , $sel:pTileMap:Pipelines :: Observers ^ Pipeline
pTileMap = Observer Pipeline
Observers ^ Pipeline
tileMapExt
    , $sel:pTileMapBlend:Pipelines :: Observers ^ Pipeline
pTileMapBlend = Observer Pipeline
Observers ^ Pipeline
tileMapBlendExt
    , $sel:pWireframe:Pipelines :: Observers ^ Pipeline
pWireframe = Observer Pipeline
Observers ^ Pipeline
wireframeExt
    , $sel:pWireframeNoDepth:Pipelines :: Observers ^ Pipeline
pWireframeNoDepth = Observer Pipeline
Observers ^ Pipeline
wireframeNoDepthExt
    , $sel:pShadowCast:Pipelines :: Observers ^ Pipeline
pShadowCast = Observer Pipeline
Observers ^ Pipeline
shadowCastExt
    , Tagged '[Sun] DescriptorSetLayout
Tagged '[Scene] DescriptorSetLayout
Tagged Sun DsBindings
Tagged Scene DsBindings
SampleCountFlagBits
pShadowLayout :: Tagged '[Sun] DescriptorSetLayout
pShadowBinds :: Tagged Sun DsBindings
pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pSceneBinds :: Tagged Scene DsBindings
pMSAA :: SampleCountFlagBits
$sel:pShadowLayout:Pipelines :: Tagged '[Sun] DescriptorSetLayout
$sel:pShadowBinds:Pipelines :: Tagged Sun DsBindings
$sel:pSceneLayout:Pipelines :: Tagged '[Scene] DescriptorSetLayout
$sel:pSceneBinds:Pipelines :: Tagged Scene DsBindings
$sel:pMSAA:Pipelines :: SampleCountFlagBits
..
    }
  where
    forward :: ForwardMsaa
forward = RenderPasses -> ForwardMsaa
rpForwardMsaa RenderPasses
renderPasses

observePipelines
  :: RenderPasses
  -> PipelineWorkers
  -> PipelineObservers
  -> Engine.StageFrameRIO rp p fr rs ()
observePipelines :: forall rp p fr rs.
RenderPasses
-> PipelineWorkers
-> PipelineObservers
-> StageFrameRIO rp p fr rs ()
observePipelines RenderPasses
fRenderpass PipelineWorkers
workers PipelineObservers
pipelines = do
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @EvanwSdf.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pEvanwSdf

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @Skybox.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSkybox

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @Debug.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugUV
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @Debug.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugTexture
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @Debug.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDebugShadow

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @DepthOnly.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pDepthOnly

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitColored
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitColoredBlend

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitTextured.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitTextured
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitTextured.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitTexturedBlend

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitMaterial.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitMaterial
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @LitMaterial.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pLitMaterialBlend

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitColored
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitColoredNoDepth

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitTextured.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitTextured
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitTextured.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pUnlitTexturedBlend

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitSprite.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSprite
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitSprite.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pSpriteOutline

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitTileMap.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pTileMap
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitTileMap.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pTileMapBlend

  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pWireframe
  forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe @UnlitColored.Pipeline forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pWireframeNoDepth

  ShadowMap
-> SampleCountFlagBits
-> Tagged '[Sun] [DsBindings]
-> Process (Config '[Sun] () Transform ())
-> Observer Pipeline
-> StageFrameRIO rp p fr rs ()
forall renderpass output pipeline (dsl :: [*]) vertices instances
       spec rp p fr rs.
(HasRenderPass renderpass, HasOutput output,
 GetOutput output ~ Configure pipeline,
 pipeline ~ Pipeline dsl vertices instances,
 spec ~ Specialization pipeline, Specialization spec) =>
renderpass
-> SampleCountFlagBits
-> Tagged dsl [DsBindings]
-> output
-> ObserverIO (ReleaseKey, pipeline)
-> StageFrameRIO rp p fr rs ()
External.observeGraphics
    (RenderPasses -> ShadowMap
rpShadowPass RenderPasses
fRenderpass) -- XXX: different RP here
    (PipelineWorkers -> SampleCountFlagBits
forall (f :: * -> *). PipelinesF f -> SampleCountFlagBits
pMSAA PipelineWorkers
workers)
    ([DsBindings] -> Tagged '[Sun] [DsBindings]
forall {k} (s :: k) b. b -> Tagged s b
Tagged [Tagged Scene DsBindings -> DsBindings
forall {k} (s :: k) b. Tagged s b -> b
unTagged (Tagged Scene DsBindings -> DsBindings)
-> Tagged Scene DsBindings -> DsBindings
forall a b. (a -> b) -> a -> b
$ PipelineObservers -> Tagged Scene DsBindings
forall (f :: * -> *). PipelinesF f -> Tagged Scene DsBindings
pSceneBinds PipelineObservers
pipelines])
    (PipelineWorkers -> ConfigureGraphics ^ Pipeline
forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pShadowCast PipelineWorkers
workers)
    (PipelineObservers -> Observers ^ Pipeline
forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
pShadowCast PipelineObservers
pipelines)
  where
    observe
      :: forall
         p
         s vs is
         rps ps fr rs
      .  ( p ~ Graphics.Pipeline s vs is
         , Shader.Specialization (Graphics.Specialization p)
         )
      => (forall a . PipelinesF a -> a ^ p)
      -> Engine.StageFrameRIO rps ps fr rs ()
    observe :: forall p (s :: [*]) vs is rps ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p)) =>
(forall (a :: * -> *). PipelinesF a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
observe =
      forall (pf :: (* -> *) -> *) p renderpass dsl (s :: [*]) vs is rps
       ps fr rs.
(p ~ Pipeline s vs is, Specialization (Specialization p),
 HasRenderPass renderpass) =>
renderpass
-> SampleCountFlagBits
-> Tagged dsl DsBindings
-> pf ConfigureGraphics
-> pf Observers
-> (forall (a :: * -> *). pf a -> a ^ p)
-> StageFrameRIO rps ps fr rs ()
External.observeField
        @PipelinesF
        @p
        (RenderPasses -> ForwardMsaa
rpForwardMsaa RenderPasses
fRenderpass)
        (PipelineWorkers -> SampleCountFlagBits
forall (f :: * -> *). PipelinesF f -> SampleCountFlagBits
pMSAA PipelineWorkers
workers)
        (PipelineObservers -> Tagged Scene DsBindings
forall (f :: * -> *). PipelinesF f -> Tagged Scene DsBindings
pSceneBinds PipelineObservers
pipelines)
        PipelineWorkers
workers
        PipelineObservers
pipelines

getSceneLayout :: PipelinesF f -> Tagged '[Scene] Vk.DescriptorSetLayout
getSceneLayout :: forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
getSceneLayout = PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
pSceneLayout

getSunLayout :: Pipelines -> Tagged '[Sun] Vk.DescriptorSetLayout
getSunLayout :: Pipelines -> Tagged '[Sun] DescriptorSetLayout
getSunLayout = Pipelines -> Tagged '[Sun] DescriptorSetLayout
forall (f :: * -> *).
PipelinesF f -> Tagged '[Sun] DescriptorSetLayout
pShadowLayout

shaderDir :: FilePath
shaderDir :: String
shaderDir = String
"data" String -> ShowS
</> String
"shaders" String -> ShowS
</> String
"basic"

stageSources :: Map Text Graphics.StageCode
stageSources :: Map Text StageCode
stageSources =
  [ (Text
"evanw-sdf", StageCode
EvanwSdf.stageCode)
  , (Text
"skybox", StageCode
Skybox.stageCode)
  , (Text
"debug", StageCode
Debug.stageCode)
  , (Text
"depth-only", StageCode
DepthOnly.stageCode)
  , (Text
"lit-colored", StageCode
LitColored.stageCode)
  , (Text
"lit-material", StageCode
LitMaterial.stageCode)
  , (Text
"lit-textured", StageCode
LitTextured.stageCode)
  , (Text
"unlit-colored", StageCode
UnlitColored.stageCode)
  , (Text
"unlit-textured", StageCode
UnlitTextured.stageCode)
  , (Text
"sprite", StageCode
UnlitSprite.stageCode)
  , (Text
"tilemap", StageCode
UnlitTileMap.stageCode)
  , (Text
"shadow-cast", StageCode
ShadowPipe.stageCode)
  ]