{-# LANGUAGE OverloadedLists #-}

module Stage.Loader.Render
  ( updateBuffers
  , recordCommands
  ) where

import RIO

import Engine.Types qualified as Engine
import Engine.Vulkan.Pipeline.Graphics qualified as Graphics
import Engine.Vulkan.Swapchain qualified as Swapchain
import Engine.Worker qualified as Worker
import Render.Draw qualified as Draw
import Render.Pass (usePass)
import RIO.State (gets)
import Vulkan.Core10 qualified as Vk

import Render.Basic qualified as Basic
import Render.DescSets.Set0 qualified as Set0
import Stage.Loader.Types (FrameResources(..), RunState(..))
import Stage.Loader.UI qualified as UI

updateBuffers
  :: RunState
  -> FrameResources
  -> Basic.StageFrameRIO FrameResources RunState ()
updateBuffers :: RunState
-> FrameResources -> StageFrameRIO FrameResources RunState ()
updateBuffers RunState{Process
UI
$sel:rsUI:RunState :: RunState -> UI
$sel:rsSceneUiP:RunState :: RunState -> Process
rsUI :: UI
rsSceneUiP :: Process
..} FrameResources{FrameResource '[Scene]
Observer
$sel:frUI:FrameResources :: FrameResources -> Observer
$sel:frSceneUi:FrameResources :: FrameResources -> FrameResource '[Scene]
frUI :: Observer
frSceneUi :: FrameResource '[Scene]
..} = do
  forall (m :: * -> *) (ds :: [*]).
MonadUnliftIO m =>
Process -> FrameResource ds -> m ()
Set0.observe Process
rsSceneUiP FrameResource '[Scene]
frSceneUi
  forall env. HasVulkan env => UI -> Observer -> RIO env ()
UI.observe UI
rsUI Observer
frUI

recordCommands
  :: Vk.CommandBuffer
  -> FrameResources
  -> Word32
  -> Basic.StageFrameRIO FrameResources RunState ()
recordCommands :: CommandBuffer
-> FrameResources
-> Word32
-> StageFrameRIO FrameResources RunState ()
recordCommands CommandBuffer
cb FrameResources{FrameResource '[Scene]
Observer
frUI :: Observer
frSceneUi :: FrameResource '[Scene]
$sel:frUI:FrameResources :: FrameResources -> Observer
$sel:frSceneUi:FrameResources :: FrameResources -> FrameResource '[Scene]
..} Word32
imageIndex = do
  (App GlobalHandles RunState
_context, Engine.Frame{SwapchainResources
$sel:fSwapchainResources:Frame :: forall renderpass pipelines resources.
Frame renderpass pipelines resources -> SwapchainResources
fSwapchainResources :: SwapchainResources
fSwapchainResources, RenderPasses
$sel:fRenderpass:Frame :: forall renderpass pipelines resources.
Frame renderpass pipelines resources -> renderpass
fRenderpass :: RenderPasses
fRenderpass, Pipelines
$sel:fPipelines:Frame :: forall renderpass pipelines resources.
Frame renderpass pipelines resources -> pipelines
fPipelines :: Pipelines
fPipelines}) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  let Basic.Pipelines{Tagged '[Sun] DescriptorSetLayout
Tagged '[Scene] DescriptorSetLayout
Tagged Sun DsLayoutBindings
Tagged Scene DsLayoutBindings
SampleCountFlagBits
Identity ^ 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
$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:pLine2dNoDepth:Pipelines :: forall (f :: * -> *). PipelinesF f -> f ^ Pipeline
$sel:pLine2d: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 DsLayoutBindings
$sel:pSceneLayout:Pipelines :: forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
$sel:pSceneBinds:Pipelines :: forall (f :: * -> *). PipelinesF f -> Tagged Scene DsLayoutBindings
$sel:pMSAA:Pipelines :: forall (f :: * -> *). PipelinesF f -> SampleCountFlagBits
pShadowCast :: Identity ^ Pipeline
pWireframeNoDepth :: Identity ^ Pipeline
pWireframe :: Identity ^ Pipeline
pTileMapBlend :: Identity ^ Pipeline
pTileMap :: Identity ^ Pipeline
pSpriteOutline :: Identity ^ Pipeline
pSprite :: Identity ^ Pipeline
pLine2dNoDepth :: Identity ^ Pipeline
pLine2d :: Identity ^ Pipeline
pUnlitTexturedBlend :: Identity ^ Pipeline
pUnlitTextured :: Identity ^ Pipeline
pUnlitColoredNoDepth :: Identity ^ Pipeline
pUnlitColored :: Identity ^ Pipeline
pLitTexturedBlend :: Identity ^ Pipeline
pLitTextured :: Identity ^ Pipeline
pLitMaterialBlend :: Identity ^ Pipeline
pLitMaterial :: Identity ^ Pipeline
pLitColoredBlend :: Identity ^ Pipeline
pLitColored :: Identity ^ Pipeline
pDepthOnly :: Identity ^ Pipeline
pDebugShadow :: Identity ^ Pipeline
pDebugTexture :: Identity ^ Pipeline
pDebugUV :: Identity ^ Pipeline
pSkybox :: Identity ^ Pipeline
pEvanwSdf :: Identity ^ Pipeline
pShadowLayout :: Tagged '[Sun] DescriptorSetLayout
pShadowBinds :: Tagged Sun DsLayoutBindings
pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pSceneBinds :: Tagged Scene DsLayoutBindings
pMSAA :: SampleCountFlagBits
..} = Pipelines
fPipelines

  UI
ui <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState -> UI
rsUI
  [Buffer]
uiMessages <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO (Observer -> [Observer]
UI.messages Observer
frUI)
  Buffers
background <- forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO (Observer -> ObserverCoherent
UI.background Observer
frUI)
  Buffers
spinner <- forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO (Observer -> ObserverCoherent
UI.spinner Observer
frUI)

  forall (io :: * -> *) a r.
(MonadIO io, HasRenderPass a) =>
a -> Word32 -> CommandBuffer -> io r -> io r
usePass (RenderPasses -> ForwardMsaa
Basic.rpForwardMsaa RenderPasses
fRenderpass) Word32
imageIndex CommandBuffer
cb do
    forall swapchain (io :: * -> *).
(HasSwapchain swapchain, MonadIO io) =>
CommandBuffer -> swapchain -> io ()
Swapchain.setDynamicFullscreen CommandBuffer
cb SwapchainResources
fSwapchainResources

    forall (m :: * -> *) (ds :: [*]) vertices instances b.
MonadIO m =>
FrameResource ds
-> Pipeline ds vertices instances
-> CommandBuffer
-> Bound ds Void Void m b
-> m b
Set0.withBoundSet0 FrameResource '[Scene]
frSceneUi Pipeline
pUnlitTexturedBlend CommandBuffer
cb do
      -- Render UI
      forall (pipeLayout :: [*]) (boundLayout :: [*]) (m :: * -> *)
       vertices instances oldVertices oldInstances.
(Compatible pipeLayout boundLayout, MonadIO m) =>
CommandBuffer
-> Pipeline pipeLayout vertices instances
-> Bound boundLayout vertices instances m ()
-> Bound boundLayout oldVertices oldInstances m ()
Graphics.bind CommandBuffer
cb Pipeline
pUnlitTexturedBlend do
        forall (m :: * -> *) instances (storage :: Store) pos attrs
       (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
Draw.indexed CommandBuffer
cb (UI -> Model 'Staged
UI.quadUV UI
ui) Buffers
background
        forall (m :: * -> *) instances (storage :: Store) pos attrs
       (dsl :: [*]).
(MonadUnliftIO m, HasVertexBuffers instances) =>
CommandBuffer
-> Indexed storage pos attrs
-> instances
-> Bound dsl (Vertex pos attrs) (VertexBuffersOf instances) m ()
Draw.indexed CommandBuffer
cb (UI -> Model 'Staged
UI.quadUV UI
ui) Buffers
spinner

      forall (pipeLayout :: [*]) (boundLayout :: [*]) (m :: * -> *)
       vertices instances oldVertices oldInstances.
(Compatible pipeLayout boundLayout, MonadIO m) =>
CommandBuffer
-> Pipeline pipeLayout vertices instances
-> Bound boundLayout vertices instances m ()
-> Bound boundLayout oldVertices oldInstances m ()
Graphics.bind CommandBuffer
cb Pipeline
pEvanwSdf forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) (stage :: Store) instances (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer
-> Allocated stage instances -> Bound dsl () instances m ()
Draw.quads CommandBuffer
cb) [Buffer]
uiMessages