module Engine.Stage.Bootstrap.Setup ( stackStage , bootstrapStage ) where import RIO import Control.Monad.Trans.Resource (ResourceT) import UnliftIO.Resource qualified as Resource import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::)) import Engine.Types (StackStage(..), StageRIO, StageFrameRIO) import Engine.Types qualified as Engine import Engine.Vulkan.Types (Queues) import Engine.StageSwitch (trySwitchStage) import Engine.Stage.Bootstrap.Types (NoRendering(..), NoPipelines(..), NoResources(..), NoState(..)) stackStage :: (a -> StackStage) -> Engine.StageSetupRIO a -> StackStage stackStage :: forall a. (a -> StackStage) -> StageSetupRIO a -> StackStage stackStage a -> StackStage handoff StageSetupRIO a action = Stage NoRendering NoPipelines NoResources NoState -> StackStage forall rp p rr st. RenderPass rp => Stage rp p rr st -> StackStage StackStage (Stage NoRendering NoPipelines NoResources NoState -> StackStage) -> Stage NoRendering NoPipelines NoResources NoState -> StackStage forall a b. (a -> b) -> a -> b $ (a -> StackStage) -> StageSetupRIO a -> Stage NoRendering NoPipelines NoResources NoState forall a. (a -> StackStage) -> StageSetupRIO a -> Stage NoRendering NoPipelines NoResources NoState bootstrapStage a -> StackStage handoff StageSetupRIO a action bootstrapStage :: (a -> StackStage) -> Engine.StageSetupRIO a -> Engine.Stage NoRendering NoPipelines NoResources NoState bootstrapStage :: forall a. (a -> StackStage) -> StageSetupRIO a -> Stage NoRendering NoPipelines NoResources NoState bootstrapStage a -> StackStage handoff StageSetupRIO a action = Stage :: forall rp p rr st a. Text -> (SwapchainResources -> ResourceT (StageRIO st) rp) -> (SwapchainResources -> rp -> ResourceT (StageRIO st) p) -> StageRIO (Maybe SwapchainResources) (ReleaseKey, st) -> (Queues CommandPool -> rp -> p -> ResourceT (StageRIO st) rr) -> StageRIO st a -> (st -> rr -> StageFrameRIO rp p rr st ()) -> (CommandBuffer -> rr -> ("image index" ::: Word32) -> StageFrameRIO rp p rr st ()) -> (a -> StageRIO st ()) -> Stage rp p rr st Engine.Stage { $sel:sTitle:Stage :: Text sTitle = Text "Bootstrap" , $sel:sAllocateRP:Stage :: SwapchainResources -> ResourceT (RIO (App GlobalHandles NoState)) NoRendering sAllocateRP = SwapchainResources -> ResourceT (RIO (App GlobalHandles NoState)) NoRendering forall swapchain st. swapchain -> ResourceT (StageRIO st) NoRendering noRendering , $sel:sAllocateP:Stage :: SwapchainResources -> NoRendering -> ResourceT (RIO (App GlobalHandles NoState)) NoPipelines sAllocateP = SwapchainResources -> NoRendering -> ResourceT (RIO (App GlobalHandles NoState)) NoPipelines forall swapchain st. swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines noPipelines , $sel:sInitialRS:Stage :: StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState) sInitialRS = (a -> StackStage) -> StageSetupRIO a -> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState) forall a. (a -> StackStage) -> StageSetupRIO a -> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState) transitState a -> StackStage handoff StageSetupRIO a action , $sel:sInitialRR:Stage :: Queues CommandPool -> NoRendering -> NoPipelines -> ResourceT (RIO (App GlobalHandles NoState)) NoResources sInitialRR = Queues CommandPool -> NoRendering -> NoPipelines -> ResourceT (RIO (App GlobalHandles NoState)) NoResources forall renderPasses pipelines rs. Queues CommandPool -> renderPasses -> pipelines -> ResourceT (StageRIO rs) NoResources noFrameResources , $sel:sBeforeLoop:Stage :: StageRIO NoState () sBeforeLoop = () -> StageRIO NoState () forall (f :: * -> *) a. Applicative f => a -> f a pure () , $sel:sUpdateBuffers:Stage :: NoState -> NoResources -> StageFrameRIO NoRendering NoPipelines NoResources NoState () sUpdateBuffers = NoState -> NoResources -> StageFrameRIO NoRendering NoPipelines NoResources NoState () forall st rd rp p. st -> rd -> StageFrameRIO rp p rd st () noUpdates , $sel:sRecordCommands:Stage :: CommandBuffer -> NoResources -> ("image index" ::: Word32) -> StageFrameRIO NoRendering NoPipelines NoResources NoState () sRecordCommands = CommandBuffer -> NoResources -> ("image index" ::: Word32) -> StageFrameRIO NoRendering NoPipelines NoResources NoState () forall rd rp p st. CommandBuffer -> rd -> ("image index" ::: Word32) -> StageFrameRIO rp p rd st () noCommands , $sel:sAfterLoop:Stage :: () -> StageRIO NoState () sAfterLoop = () -> StageRIO NoState () forall (f :: * -> *) a. Applicative f => a -> f a pure } noRendering :: swapchain -> ResourceT (StageRIO st) NoRendering noRendering :: forall swapchain st. swapchain -> ResourceT (StageRIO st) NoRendering noRendering swapchain _swapchain = NoRendering -> ResourceT (StageRIO st) NoRendering forall (f :: * -> *) a. Applicative f => a -> f a pure NoRendering NoRendering noPipelines :: swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines noPipelines :: forall swapchain st. swapchain -> NoRendering -> ResourceT (StageRIO st) NoPipelines noPipelines swapchain _swapchain NoRendering NoRendering = NoPipelines -> ResourceT (StageRIO st) NoPipelines forall (f :: * -> *) a. Applicative f => a -> f a pure NoPipelines NoPipelines noCommands :: Vk.CommandBuffer -> rd -> "image index" ::: Word32 -> StageFrameRIO rp p rd st () noCommands :: forall rd rp p st. CommandBuffer -> rd -> ("image index" ::: Word32) -> StageFrameRIO rp p rd st () noCommands CommandBuffer _cb rd _rd "image index" ::: Word32 _index = () -> RIO (App GlobalHandles st, Frame rp p rd) () forall (f :: * -> *) a. Applicative f => a -> f a pure () noUpdates :: st -> rd -> StageFrameRIO rp p rd st () noUpdates :: forall st rd rp p. st -> rd -> StageFrameRIO rp p rd st () noUpdates st _st rd _rd = () -> RIO (App GlobalHandles st, Frame rp p rd) () forall (f :: * -> *) a. Applicative f => a -> f a pure () transitState :: (a -> StackStage) -> Engine.StageSetupRIO a -> Engine.StageSetupRIO (Resource.ReleaseKey, NoState) transitState :: forall a. (a -> StackStage) -> StageSetupRIO a -> StageRIO (Maybe SwapchainResources) (ReleaseKey, NoState) transitState a -> StackStage handoff StageSetupRIO a action = do a res <- StageSetupRIO a action Bool switched <- NextStage -> StageRIO (Maybe SwapchainResources) Bool forall rs. NextStage -> StageRIO rs Bool trySwitchStage (NextStage -> StageRIO (Maybe SwapchainResources) Bool) -> (StackStage -> NextStage) -> StackStage -> StageRIO (Maybe SwapchainResources) Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . StackStage -> NextStage Engine.Replace (StackStage -> StageRIO (Maybe SwapchainResources) Bool) -> StackStage -> StageRIO (Maybe SwapchainResources) Bool forall a b. (a -> b) -> a -> b $ a -> StackStage handoff a res Bool -> RIO (App GlobalHandles (Maybe SwapchainResources)) () -> RIO (App GlobalHandles (Maybe SwapchainResources)) () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool switched (RIO (App GlobalHandles (Maybe SwapchainResources)) () -> RIO (App GlobalHandles (Maybe SwapchainResources)) ()) -> RIO (App GlobalHandles (Maybe SwapchainResources)) () -> RIO (App GlobalHandles (Maybe SwapchainResources)) () forall a b. (a -> b) -> a -> b $ Utf8Builder -> RIO (App GlobalHandles (Maybe SwapchainResources)) () forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError Utf8Builder "Bootstrap switch failed" ReleaseKey key <- IO () -> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey Resource.register (IO () -> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey) -> IO () -> RIO (App GlobalHandles (Maybe SwapchainResources)) ReleaseKey forall a b. (a -> b) -> a -> b $ () -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure () pure (ReleaseKey key, NoState NoState) noFrameResources :: Queues Vk.CommandPool -> renderPasses -> pipelines -> ResourceT (StageRIO rs) NoResources noFrameResources :: forall renderPasses pipelines rs. Queues CommandPool -> renderPasses -> pipelines -> ResourceT (StageRIO rs) NoResources noFrameResources Queues CommandPool _queues renderPasses _rp pipelines _p = ((ReleaseKey, NoResources) -> NoResources) -> ResourceT (StageRIO rs) (ReleaseKey, NoResources) -> ResourceT (StageRIO rs) NoResources forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (ReleaseKey, NoResources) -> NoResources forall a b. (a, b) -> b snd (ResourceT (StageRIO rs) (ReleaseKey, NoResources) -> ResourceT (StageRIO rs) NoResources) -> ResourceT (StageRIO rs) (ReleaseKey, NoResources) -> ResourceT (StageRIO rs) NoResources forall a b. (a -> b) -> a -> b $! IO NoResources -> (NoResources -> IO ()) -> ResourceT (StageRIO rs) (ReleaseKey, NoResources) forall (m :: * -> *) a. MonadResource m => IO a -> (a -> IO ()) -> m (ReleaseKey, a) Resource.allocate (NoResources -> IO NoResources forall (f :: * -> *) a. Applicative f => a -> f a pure NoResources NoResources) (\NoResources NoResources -> () -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure ())