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

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

  ForwardMsaa
-> Word32
-> CommandBuffer
-> StageFrameRIO FrameResources RunState ()
-> StageFrameRIO FrameResources RunState ()
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
    CommandBuffer
-> SwapchainResources -> StageFrameRIO FrameResources RunState ()
forall swapchain (io :: * -> *).
(HasSwapchain swapchain, MonadIO io) =>
CommandBuffer -> swapchain -> io ()
Swapchain.setDynamicFullscreen CommandBuffer
cb SwapchainResources
fSwapchainResources

    FrameResource '[Scene]
-> Pipeline
-> CommandBuffer
-> Bound
     '[Scene]
     Void
     Void
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
-> StageFrameRIO FrameResources RunState ()
forall {k} {k1} (m :: * -> *) (ds :: [*]) (vertices :: k)
       (instances :: k1) 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
      CommandBuffer
-> Pipeline
-> Bound
     '[Scene]
     (Vertex Packed VertexAttrs)
     Attrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
-> Bound
     '[Scene]
     Void
     Void
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
forall {k2} {k3} {k4} {k5} (pipeLayout :: [*]) (boundLayout :: [*])
       (m :: * -> *) (vertices :: k2) (instances :: k3)
       (oldVertices :: k4) (oldInstances :: k5).
(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
        CommandBuffer
-> Indexed 'Staged Packed VertexAttrs
-> Buffers
-> Bound
     '[Scene]
     (Vertex Packed VertexAttrs)
     (VertexBuffersOf Buffers)
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
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 -> Indexed 'Staged Packed VertexAttrs
UI.quadUV UI
ui) Buffers
background
        CommandBuffer
-> Indexed 'Staged Packed VertexAttrs
-> Buffers
-> Bound
     '[Scene]
     (Vertex Packed VertexAttrs)
     (VertexBuffersOf Buffers)
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
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 -> Indexed 'Staged Packed VertexAttrs
UI.quadUV UI
ui) Buffers
spinner

      CommandBuffer
-> Pipeline
-> Bound
     '[Scene]
     ()
     InstanceAttrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
-> Bound
     '[Scene]
     Void
     Void
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
forall {k2} {k3} {k4} {k5} (pipeLayout :: [*]) (boundLayout :: [*])
       (m :: * -> *) (vertices :: k2) (instances :: k3)
       (oldVertices :: k4) (oldInstances :: k5).
(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 (Bound
   '[Scene]
   ()
   InstanceAttrs
   (RIO
      (App GlobalHandles RunState,
       Frame RenderPasses Pipelines FrameResources))
   ()
 -> Bound
      '[Scene]
      Void
      Void
      (RIO
         (App GlobalHandles RunState,
          Frame RenderPasses Pipelines FrameResources))
      ())
-> Bound
     '[Scene]
     ()
     InstanceAttrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
-> Bound
     '[Scene]
     Void
     Void
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
forall a b. (a -> b) -> a -> b
$
        (Buffer
 -> Bound
      '[Scene]
      ()
      InstanceAttrs
      (RIO
         (App GlobalHandles RunState,
          Frame RenderPasses Pipelines FrameResources))
      ())
-> [Buffer]
-> Bound
     '[Scene]
     ()
     InstanceAttrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (CommandBuffer
-> Buffer
-> Bound
     '[Scene]
     ()
     InstanceAttrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
forall {k1} (m :: * -> *) (stage :: Store) (instances :: k1)
       (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer
-> Allocated stage instances -> Bound dsl () instances m ()
Draw.quads CommandBuffer
cb) [Buffer]
uiMessages