{-# 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
  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
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}) <- 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 DsBindings
Tagged Scene DsBindings
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
$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
pShadowCast :: Identity ^ Pipeline
pWireframeNoDepth :: Identity ^ Pipeline
pWireframe :: Identity ^ Pipeline
pTileMapBlend :: Identity ^ Pipeline
pTileMap :: Identity ^ Pipeline
pSpriteOutline :: Identity ^ Pipeline
pSprite :: 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 DsBindings
pSceneLayout :: Tagged '[Scene] DescriptorSetLayout
pSceneBinds :: Tagged Scene DsBindings
pMSAA :: SampleCountFlagBits
..} = 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)
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)
  InstanceBuffers 'Coherent 'Coherent
background <- IORef (Versioned (InstanceBuffers 'Coherent 'Coherent))
-> RIO
     (App GlobalHandles RunState,
      Frame RenderPasses Pipelines FrameResources)
     (InstanceBuffers 'Coherent 'Coherent)
forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO (Observer -> IORef (Versioned (InstanceBuffers 'Coherent 'Coherent))
UI.background Observer
frUI)
  InstanceBuffers 'Coherent 'Coherent
spinner <- IORef (Versioned (InstanceBuffers 'Coherent 'Coherent))
-> RIO
     (App GlobalHandles RunState,
      Frame RenderPasses Pipelines FrameResources)
     (InstanceBuffers 'Coherent 'Coherent)
forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO (Observer -> IORef (Versioned (InstanceBuffers 'Coherent 'Coherent))
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 (io :: * -> *).
MonadIO io =>
CommandBuffer -> SwapchainResources -> 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 (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
pWireframe CommandBuffer
cb do
      -- Render UI
      CommandBuffer
-> Pipeline
-> Bound
     '[Scene]
     VertexAttrs
     InstanceAttrs
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
-> Bound
     '[Scene]
     Void
     Void
     (RIO
        (App GlobalHandles RunState,
         Frame RenderPasses Pipelines FrameResources))
     ()
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
        CommandBuffer
-> Indexed 'Staged Packed VertexAttrs
-> InstanceBuffers 'Coherent 'Coherent
-> Bound
     '[Scene]
     VertexAttrs
     (VertexBuffersOf (InstanceBuffers 'Coherent 'Coherent))
     (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 attrs (VertexBuffersOf instances) m ()
Draw.indexed CommandBuffer
cb (UI -> Indexed 'Staged Packed VertexAttrs
UI.quadUV UI
ui) InstanceBuffers 'Coherent 'Coherent
background
        CommandBuffer
-> Indexed 'Staged Packed VertexAttrs
-> InstanceBuffers 'Coherent 'Coherent
-> Bound
     '[Scene]
     VertexAttrs
     (VertexBuffersOf (InstanceBuffers 'Coherent 'Coherent))
     (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 attrs (VertexBuffersOf instances) m ()
Draw.indexed CommandBuffer
cb (UI -> Indexed 'Staged Packed VertexAttrs
UI.quadUV UI
ui) InstanceBuffers 'Coherent 'Coherent
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 (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 (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 (m :: * -> *) (stage :: Store) instances (dsl :: [*]).
MonadUnliftIO m =>
CommandBuffer
-> Allocated stage instances -> Bound dsl () instances m ()
Draw.quads CommandBuffer
cb) [Buffer]
uiMessages