{-# LANGUAGE OverloadedLists #-}

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

import RIO

import RIO.State (gets)
import Vulkan.Core10 qualified as Vk

import Engine.Types qualified as Engine
import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Swapchain qualified as Swapchain
import Engine.Worker qualified as Worker
import Render.Basic qualified as Basic
import Render.DescSets.Set0 qualified as Set0
import Render.Draw qualified as Draw
import Render.ForwardMsaa qualified as ForwardMsaa

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{ProjectionProcess
Process
UI
$sel:rsUI:RunState :: RunState -> UI
$sel:rsSceneUiP:RunState :: RunState -> Process
$sel:rsProjectionP:RunState :: RunState -> ProjectionProcess
rsUI :: UI
rsSceneUiP :: Process
rsProjectionP :: ProjectionProcess
..} 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{Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
Pipeline
$sel:pShadowCast:Pipelines :: Pipelines -> Pipeline
$sel:pWireframeNoDepth:Pipelines :: Pipelines -> Pipeline
$sel:pWireframe:Pipelines :: Pipelines -> Pipeline
$sel:pUnlitTexturedBlend:Pipelines :: Pipelines -> Pipeline
$sel:pUnlitTextured:Pipelines :: Pipelines -> Pipeline
$sel:pUnlitColoredNoDepth:Pipelines :: Pipelines -> Pipeline
$sel:pUnlitColored:Pipelines :: Pipelines -> Pipeline
$sel:pLitTexturedBlend:Pipelines :: Pipelines -> Pipeline
$sel:pLitTextured:Pipelines :: Pipelines -> Pipeline
$sel:pLitMaterialBlend:Pipelines :: Pipelines -> Pipeline
$sel:pLitMaterial:Pipelines :: Pipelines -> Pipeline
$sel:pLitColoredBlend:Pipelines :: Pipelines -> Pipeline
$sel:pLitColored:Pipelines :: Pipelines -> Pipeline
$sel:pDebug:Pipelines :: Pipelines -> Pipeline
$sel:pSkybox:Pipelines :: Pipelines -> Pipeline
$sel:pEvanwSdf:Pipelines :: Pipelines -> Pipeline
pShadowCast :: Pipeline
pWireframeNoDepth :: Pipeline
pWireframe :: Pipeline
pUnlitTexturedBlend :: Pipeline
pUnlitTextured :: Pipeline
pUnlitColoredNoDepth :: Pipeline
pUnlitColored :: Pipeline
pLitTexturedBlend :: Pipeline
pLitTextured :: Pipeline
pLitMaterialBlend :: Pipeline
pLitMaterial :: Pipeline
pLitColoredBlend :: Pipeline
pLitColored :: Pipeline
pDebug :: Pipeline
pSkybox :: Pipeline
pEvanwSdf :: Pipeline
..} = Pipelines
fPipelines

  UI
ui <- ((App GlobalHandles RunState,
  Frame RenderPasses Pipelines FrameResources)
 -> App GlobalHandles RunState)
-> RIO (App GlobalHandles RunState) UI
-> RIO
     (App GlobalHandles RunState,
      Frame RenderPasses Pipelines FrameResources)
     UI
forall outer inner a.
(outer -> inner) -> RIO inner a -> RIO outer a
mapRIO (App GlobalHandles RunState,
 Frame RenderPasses Pipelines FrameResources)
-> App GlobalHandles RunState
forall a b. (a, b) -> a
fst (RIO (App GlobalHandles RunState) UI
 -> RIO
      (App GlobalHandles RunState,
       Frame RenderPasses Pipelines FrameResources)
      UI)
-> RIO (App GlobalHandles RunState) UI
-> RIO
     (App GlobalHandles RunState,
      Frame RenderPasses Pipelines FrameResources)
     UI
forall a b. (a -> b) -> a -> b
$ (RunState -> UI) -> RIO (App GlobalHandles RunState) 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
ForwardMsaa.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 ()
Pipeline.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 ()
Pipeline.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