{-# LANGUAGE OverloadedLists #-}

module Stage.Loader.Setup
  ( bootstrap
  , stackStage
  ) where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Engine.Camera qualified as Camera
import Engine.Stage.Component qualified as Stage
import Engine.StageSwitch (trySwitchStage)
import Engine.Types (StackStage(..), StageSetupRIO)
import Engine.Types qualified as Engine
import Engine.UI.Layout qualified as Layout
import Engine.UI.Message qualified as Message
import Engine.Vulkan.Swapchain qualified as Swapchain
import Engine.Vulkan.Types (Queues)
import Engine.Worker qualified as Worker
import Geometry.Quad qualified as Quad
import Render.Basic qualified as Basic
import Render.DescSets.Set0 qualified as Set0
import Render.Samplers qualified as Samplers
import Resource.Collection qualified as Collection
import Resource.Combined.Textures qualified as CombinedTextures
import Resource.CommandBuffer (withPools)
import Resource.Font qualified as Font
import Resource.Model qualified as Model
import Resource.Region qualified as Region
import Resource.Source (Source)
import Resource.Texture.Ktx2 qualified as Ktx2
import RIO.State (gets)
import RIO.Vector.Partial ((!))
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk

import Stage.Loader.Render qualified as Render
import Stage.Loader.Scene qualified as Scene
import Stage.Loader.Types (FrameResources(..), RunState(..))
import Stage.Loader.UI qualified as UI

bootstrap
  :: Text
  -> (Font.Config, Font.Config)
  -> (Source, Source)
  -> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
  -> (loaded -> StackStage)
  -> ( Setup Vector Vector loaded -> Engine.StackStage
     , Engine.StageSetupRIO (Setup Vector Vector loaded)
     )
bootstrap :: forall loaded.
Text
-> (Config, Config)
-> (Source, Source)
-> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage)
-> (Setup Vector Vector loaded -> StackStage,
    StageSetupRIO (Setup Vector Vector loaded))
bootstrap Text
titleMessage (Config
smallFont, Config
largeFont) (Source
bgPath, Source
spinnerPath) (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage =
  (forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
Setup fonts textures loaded -> StackStage
stackStageBootstrap, RIO
  (App GlobalHandles (Maybe SwapchainResources))
  (Setup Vector Vector loaded)
action)
  where
    action :: RIO
  (App GlobalHandles (Maybe SwapchainResources))
  (Setup Vector Vector loaded)
action = forall env (m :: * -> *) a.
(MonadVulkan env m, MonadResource m) =>
(Queues CommandPool -> m a) -> m a
withPools \Queues CommandPool
pools -> do
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Bootstrapping loader"

      Vector Font
fonts <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall env (m :: * -> *).
(HasCallStack, MonadVulkan env m, HasLogFunc env, MonadThrow m,
 MonadResource m) =>
Queues CommandPool -> Config -> m Font
Font.allocate Queues CommandPool
pools) [Config
smallFont, Config
largeFont]
      Vector (Texture Flat)
textures <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a env (m :: * -> *).
(TextureLayers a, MonadVulkan env m, MonadResource m, MonadThrow m,
 HasLogFunc env, Typeable a, HasCallStack) =>
Queues CommandPool -> Source -> m (Texture a)
Ktx2.load Queues CommandPool
pools) [Source
bgPath, Source
spinnerPath]

      let
        fontContainers :: Vector Container
fontContainers = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Font -> Container
Font.container Vector Font
fonts
        combinedTextures :: Collection Vector Vector (Int32, Texture Flat)
combinedTextures = forall (t :: * -> *) ix a.
(Traversable t, Num ix) =>
t a -> t (ix, a)
Collection.enumerate CombinedTextures.Collection
          { $sel:textures:Collection :: Vector (Texture Flat)
textures = Vector (Texture Flat)
textures
          , $sel:fonts:Collection :: Vector (Texture Flat)
fonts    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Font -> Texture Flat
Font.texture Vector Font
fonts
          }

      let
        uiSettings :: Settings Vector Vector
uiSettings = UI.Settings
          { $sel:titleMessage:Settings :: Text
titleMessage = Text
titleMessage
          , $sel:backgroundIx:Settings :: Int32
backgroundIx = Int32
0
          , $sel:spinnerIx:Settings :: Int32
spinnerIx    = Int32
1

          , $sel:combined:Settings :: Collection Vector Vector (Int32, Texture Flat)
combined = Collection Vector Vector (Int32, Texture Flat)
combinedTextures
          , $sel:fonts:Settings :: Vector Container
fonts    = Vector Container
fontContainers

          , $sel:smallFont:Settings :: forall a. Vector a -> a
smallFont = \Vector a
fs -> Vector a
fs forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
0
          , $sel:largeFont:Settings :: forall a. Vector a -> a
largeFont = \Vector a
fs -> Vector a
fs forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
1
          }

      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Finished bootstrapping loader"
      pure Setup{Settings Vector Vector
loaded -> StackStage
(Text -> StageSetupRIO ()) -> StageSetupRIO loaded
$sel:uiSettings:Setup :: Settings Vector Vector
$sel:nextStage:Setup :: loaded -> StackStage
$sel:loadAction:Setup :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
uiSettings :: Settings Vector Vector
nextStage :: loaded -> StackStage
loadAction :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
..}

data Setup fonts textures loaded = Setup
  { forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded
-> (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
  , forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded -> loaded -> StackStage
nextStage  :: loaded -> StackStage
  , forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded -> Settings textures fonts
uiSettings :: UI.Settings textures fonts
  }

stackStageBootstrap
  :: (Traversable fonts, Traversable textures)
  => Setup fonts textures loaded -> StackStage
stackStageBootstrap :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
Setup fonts textures loaded -> StackStage
stackStageBootstrap Setup{Settings textures fonts
loaded -> StackStage
(Text -> StageSetupRIO ()) -> StageSetupRIO loaded
uiSettings :: Settings textures fonts
nextStage :: loaded -> StackStage
loadAction :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
$sel:uiSettings:Setup :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded -> Settings textures fonts
$sel:nextStage:Setup :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded -> loaded -> StackStage
$sel:loadAction:Setup :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
Setup fonts textures loaded
-> (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
..} = forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage) -> Settings textures fonts -> StackStage
stackStage (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings

stackStage
  :: (Traversable fonts, Traversable textures)
  => ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
  -> (loaded -> StackStage)
  -> UI.Settings textures fonts
  -> StackStage
stackStage :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage) -> Settings textures fonts -> StackStage
stackStage (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings =
  forall rp p rr st. RenderPass rp => Stage rp p rr st -> StackStage
StackStage forall a b. (a -> b) -> a -> b
$ forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage)
-> Settings textures fonts
-> Stage FrameResources RunState
loaderStage (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings

loaderStage
  :: (Traversable fonts, Traversable textures)
  => ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
  -> (loaded -> StackStage)
  -> UI.Settings textures fonts
  -> Basic.Stage FrameResources RunState
loaderStage :: forall (fonts :: * -> *) (textures :: * -> *) loaded.
(Traversable fonts, Traversable textures) =>
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage)
-> Settings textures fonts
-> Stage FrameResources RunState
loaderStage (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings = forall (t :: * -> *) rp p st rr.
Foldable t =>
Text
-> Rendering rp p st
-> Resources rp p st rr
-> t (Scene rp p st rr)
-> Stage rp p rr st
Stage.assemble Text
"Loader" Rendering RenderPasses Pipelines RunState
rendering Resources RenderPasses Pipelines RunState FrameResources
resources (forall a. a -> Maybe a
Just Scene RenderPasses Pipelines RunState FrameResources
scene)
  where
    rendering :: Rendering RenderPasses Pipelines RunState
rendering = Stage.Rendering
      { $sel:rAllocateRP:Rendering :: SwapchainResources -> ResourceT (StageRIO RunState) RenderPasses
rAllocateRP = forall {swapchain} {env}.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
swapchain -> ResourceT (RIO env) RenderPasses
allocateRenderPass
      , $sel:rAllocateP:Rendering :: SwapchainResources
-> RenderPasses -> ResourceT (StageRIO RunState) Pipelines
rAllocateP = SwapchainResources
-> RenderPasses -> ResourceT (StageRIO RunState) Pipelines
allocatePipelines
      }

    allocateRenderPass :: swapchain -> ResourceT (RIO env) RenderPasses
allocateRenderPass swapchain
swapchain = do
      forall swapchain env.
(HasSwapchain swapchain, HasLogFunc env, HasVulkan env) =>
Settings -> swapchain -> ResourceT (RIO env) RenderPasses
Basic.allocate
        Basic.Settings
          { $sel:sShadowLayers:Settings :: Word32
sShadowLayers = Word32
1
          , $sel:sShadowSize:Settings :: Word32
sShadowSize   = Word32
1
          }
        swapchain
swapchain

    allocatePipelines :: SwapchainResources
-> RenderPasses -> ResourceT (StageRIO RunState) Pipelines
allocatePipelines SwapchainResources
swapchain RenderPasses
rps = do
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Allocating loader pipelines"
      Collection Sampler
samplers <- forall env (io :: * -> *).
MonadVulkan env io =>
("max anisotropy" ::: Float) -> ResourceT io (Collection Sampler)
Samplers.allocate (forall a. HasSwapchain a => a -> "max anisotropy" ::: Float
Swapchain.getAnisotropy SwapchainResources
swapchain)
      forall st.
Tagged Scene DsLayoutBindings
-> SampleCountFlagBits
-> RenderPasses
-> ResourceT (StageRIO st) Pipelines
Basic.allocatePipelines
        (Collection Sampler -> Tagged Scene DsLayoutBindings
sceneBinds Collection Sampler
samplers)
        (forall a. HasSwapchain a => a -> SampleCountFlagBits
Swapchain.getMultisample SwapchainResources
swapchain)
        RenderPasses
rps

    sceneBinds :: Collection Sampler -> Tagged Scene DsLayoutBindings
sceneBinds Collection Sampler
samplers = forall (samplers :: * -> *) (textures :: * -> *)
       (cubemaps :: * -> *) a b.
(Foldable samplers, Foldable textures, Foldable cubemaps) =>
samplers Sampler
-> textures a
-> cubemaps b
-> Word32
-> Tagged Scene DsLayoutBindings
Set0.mkBindings
      Collection Sampler
samplers
      (forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures
-> Collection textures fonts (Int32, Texture Flat)
UI.combined Settings textures fonts
uiSettings)
      forall a. Maybe a
Nothing
      Word32
0

    resources :: Resources RenderPasses Pipelines RunState FrameResources
resources = Stage.Resources
      { $sel:rInitialRS:Resources :: StageRIO (Maybe SwapchainResources) (ReleaseKey, RunState)
rInitialRS = forall loaded (textures :: * -> *) (fonts :: * -> *).
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage)
-> Settings textures fonts
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, RunState)
initialRunState (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings
      , $sel:rInitialRR:Resources :: Queues CommandPool
-> RenderPasses
-> Pipelines
-> ResourceT (StageRIO RunState) FrameResources
rInitialRR = forall (fonts :: * -> *) (textures :: * -> *).
(Traversable fonts, Traversable textures) =>
Settings fonts textures
-> Queues CommandPool
-> RenderPasses
-> Pipelines
-> ResourceT (StageRIO RunState) FrameResources
initialFrameResources Settings textures fonts
uiSettings
      }

    scene :: Scene RenderPasses Pipelines RunState FrameResources
scene = Stage.Scene
      { $sel:scBeforeLoop:Scene :: ResourceT (StageRIO RunState) ()
scBeforeLoop = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      , $sel:scUpdateBuffers:Scene :: RunState
-> FrameResources
-> StageFrameRIO RenderPasses Pipelines FrameResources RunState ()
scUpdateBuffers = RunState
-> FrameResources
-> StageFrameRIO RenderPasses Pipelines FrameResources RunState ()
Render.updateBuffers
      , $sel:scRecordCommands:Scene :: CommandBuffer
-> FrameResources
-> Word32
-> StageFrameRIO RenderPasses Pipelines FrameResources RunState ()
scRecordCommands = CommandBuffer
-> FrameResources
-> Word32
-> StageFrameRIO RenderPasses Pipelines FrameResources RunState ()
Render.recordCommands
      }

initialRunState
  :: ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
  -> (loaded -> StackStage)
  -> UI.Settings textures fonts
  -> StageSetupRIO (Resource.ReleaseKey, RunState)
initialRunState :: forall loaded (textures :: * -> *) (fonts :: * -> *).
((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)
-> (loaded -> StackStage)
-> Settings textures fonts
-> StageRIO (Maybe SwapchainResources) (ReleaseKey, RunState)
initialRunState (Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction loaded -> StackStage
nextStage Settings textures fonts
uiSettings =
  forall env (m :: * -> *) a.
(MonadVulkan env m, MonadResource m) =>
(Queues CommandPool -> m a) -> m a
withPools \Queues CommandPool
pools -> forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
Region.run do
    ProjectionProcess 'Orthographic
rsProjectionP <- forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m (ProjectionProcess 'Orthographic)
Camera.spawnOrthoPixelsCentered

    Process
rsSceneUiP <- forall (m :: * -> *) projection.
(MonadResource m, MonadUnliftIO m, HasOutput projection,
 GetOutput projection ~ Projection 'Orthographic) =>
projection -> m Process
Scene.spawn ProjectionProcess 'Orthographic
rsProjectionP

    Indexed 'Staged Packed Vec2
rsQuadUV <- forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text
-> Queues CommandPool
-> [Vertex pos attrs]
-> Maybe [Word32]
-> m (Indexed 'Staged pos attrs)
Model.createStagedL (forall a. a -> Maybe a
Just Text
"rsQuadUV") Queues CommandPool
pools (forall pos attrs. Quad (Vertex pos attrs) -> [Vertex pos attrs]
Quad.toVertices Quad (Vertex Packed Vec2)
Quad.texturedQuad) forall a. Maybe a
Nothing
    forall env (m :: * -> *) (storage :: Store) pos attrs.
(MonadVulkan env m, MonadResource m) =>
Indexed storage pos attrs -> m ()
Model.registerIndexed_ Indexed 'Staged Packed Vec2
rsQuadUV

    BoxProcess
screenBoxP <- forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m BoxProcess
Layout.trackScreen

    UI
rsUI <- forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
Region.local forall a b. (a -> b) -> a -> b
$
      forall (fonts :: * -> *) (textures :: * -> *) env.
Queues CommandPool
-> BoxProcess
-> Settings fonts textures
-> StageRIO env (ReleaseKey, UI)
UI.spawn Queues CommandPool
pools BoxProcess
screenBoxP Settings textures fonts
uiSettings

    let
      updateProgress :: Text -> StageSetupRIO ()
updateProgress Text
text = do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Loader: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
text
        forall (m :: * -> *) var.
(MonadIO m, HasInput var) =>
var -> (GetInput var -> GetInput var) -> m ()
Worker.pushInput (UI -> Var Input
UI.progressInput UI
rsUI) \GetInput (Var Input)
msg -> GetInput (Var Input)
msg
          { $sel:inputText:Input :: Text
Message.inputText = Text
text
          }

    Async ()
switcher <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async do
      Async loaded
loader <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Starting load action"
        forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded
loadAction Text -> StageSetupRIO ()
updateProgress) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left (SomeException
e :: SomeException) -> do
            forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Load action failed with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
          Right loaded
r -> do
            forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Load action finished"
            pure loaded
r

      forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async loaded
loader
      -- threadDelay 1e6
      forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Either SomeException a)
waitCatch Async loaded
loader forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left SomeException
oopsie -> do
          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"Loader failed"
          forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
oopsie
        Right loaded
loaded -> do
          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Loader signalled a stage change"

          Text -> StageSetupRIO ()
updateProgress Text
"Done!"
          Bool
switched <- forall rs. NextStage -> StageRIO rs Bool
trySwitchStage forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackStage -> NextStage
Engine.Replace forall a b. (a -> b) -> a -> b
$
            loaded -> StackStage
nextStage loaded
loaded
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
switched forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"Loader switch failed"

    -- XXX: propagate exceptions from loader threads
    forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async ()
switcher

    pure RunState{Process
UI
$sel:rsUI:RunState :: UI
$sel:rsSceneUiP:RunState :: Process
rsUI :: UI
rsSceneUiP :: Process
..}

initialFrameResources
  :: (Traversable fonts, Traversable textures)
  => UI.Settings fonts textures
  -> Queues Vk.CommandPool
  -> Basic.RenderPasses
  -> Basic.Pipelines
  -> ResourceT (Engine.StageRIO RunState) FrameResources
initialFrameResources :: forall (fonts :: * -> *) (textures :: * -> *).
(Traversable fonts, Traversable textures) =>
Settings fonts textures
-> Queues CommandPool
-> RenderPasses
-> Pipelines
-> ResourceT (StageRIO RunState) FrameResources
initialFrameResources UI.Settings{Collection textures fonts (Int32, Texture Flat)
combined :: Collection textures fonts (Int32, Texture Flat)
$sel:combined:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures
-> Collection textures fonts (Int32, Texture Flat)
combined} Queues CommandPool
_pools RenderPasses
_passes Pipelines
pipelines = do
  FrameResource '[Scene]
frSceneUi <- forall (textures :: * -> *) (cubes :: * -> *) env (m :: * -> *).
(Traversable textures, Traversable cubes, MonadVulkan env m,
 MonadResource m) =>
Tagged '[Scene] DescriptorSetLayout
-> textures (Texture Flat)
-> cubes (Texture CubeMap)
-> Maybe (Allocated 'Coherent Sun)
-> ("shadow maps" ::: Vector ImageView)
-> Maybe (Allocated 'Coherent Material)
-> ResourceT m (FrameResource '[Scene])
Set0.allocate
    (forall (f :: * -> *).
PipelinesF f -> Tagged '[Scene] DescriptorSetLayout
Basic.getSceneLayout Pipelines
pipelines)
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Collection textures fonts (Int32, Texture Flat)
combined)
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    forall a. Monoid a => a
mempty -- XXX: no shadows on loader
    forall a. Maybe a
Nothing

  Observer
frUI <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState -> UI
rsUI forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall st. UI -> ResourceT (StageRIO st) Observer
UI.newObserver

  pure FrameResources{FrameResource '[Scene]
Observer
$sel:frUI:FrameResources :: Observer
$sel:frSceneUi:FrameResources :: FrameResource '[Scene]
frUI :: Observer
frSceneUi :: FrameResource '[Scene]
..}