keid-render-basic 0.1.0.0 → 0.1.1.0
raw patch · 8 files changed
+577/−2 lines, 8 filesdep +keid-geometry
Dependencies added: keid-geometry
Files
- ChangeLog.md +7/−1
- README.md +1/−0
- keid-render-basic.cabal +7/−1
- src/Stage/Loader/Render.hs +57/−0
- src/Stage/Loader/Scene.hs +30/−0
- src/Stage/Loader/Setup.hs +217/−0
- src/Stage/Loader/Types.hs +31/−0
- src/Stage/Loader/UI.hs +227/−0
ChangeLog.md view
@@ -1,3 +1,9 @@ # Changelog for keid-render-basic -## Unreleased changes+## 0.1.1.0++- Added `Stage.Loader.*` (and `keid-geometry` dependency with it).++## 0.1.0.0++- Initial public version.
README.md view
@@ -13,3 +13,4 @@ * Debug pipeline - Shadowmap pass * Shadow-casting pipeline+- Asset loader stage
keid-render-basic.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: keid-render-basic-version: 0.1.0.0+version: 0.1.1.0 synopsis: Basic rendering programs for Keid engine. category: Game Engine author: IC Rainbow@@ -53,6 +53,11 @@ Resource.Font Resource.Font.EvanW Resource.Mesh.Lit+ Stage.Loader.Render+ Stage.Loader.Scene+ Stage.Loader.Setup+ Stage.Loader.Types+ Stage.Loader.UI other-modules: Paths_keid_render_basic hs-source-dirs:@@ -128,6 +133,7 @@ , foldl , geomancy , keid-core+ , keid-geometry , neat-interpolation , resourcet , rio >=0.1.12.0
+ src/Stage/Loader/Render.hs view
@@ -0,0 +1,57 @@+{-# 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{..} = do+ Set0.observe rsSceneUiP frSceneUi+ UI.observe rsUI frUI++recordCommands+ :: Vk.CommandBuffer+ -> FrameResources+ -> Word32+ -> Basic.StageFrameRIO FrameResources RunState ()+recordCommands cb FrameResources{..} imageIndex = do+ (_context, Engine.Frame{fSwapchainResources, fRenderpass, fPipelines}) <- ask+ let Basic.Pipelines{..} = fPipelines++ ui <- mapRIO fst $ gets rsUI+ uiMessages <- traverse Worker.readObservedIO (UI.messages frUI)+ background <- Worker.readObservedIO (UI.background frUI)+ spinner <- Worker.readObservedIO (UI.spinner frUI)++ ForwardMsaa.usePass (Basic.rpForwardMsaa fRenderpass) imageIndex cb do+ Swapchain.setDynamicFullscreen cb fSwapchainResources++ Set0.withBoundSet0 frSceneUi pWireframe cb do+ -- Render UI+ Pipeline.bind cb pUnlitTexturedBlend do+ Draw.indexed cb (UI.quadUV ui) background+ Draw.indexed cb (UI.quadUV ui) spinner++ Pipeline.bind cb pEvanwSdf $+ traverse_ (Draw.quads cb) uiMessages
+ src/Stage/Loader/Scene.hs view
@@ -0,0 +1,30 @@+module Stage.Loader.Scene+ ( Process+ , spawn+ ) where++import RIO++import Geomancy.Transform qualified as Transform++import Engine.Camera qualified as Camera+import Engine.Worker qualified as Worker+import Render.DescSets.Set0 (Scene(..), emptyScene)++type Process = Worker.Merge Scene++spawn+ :: ( MonadUnliftIO m+ , Worker.HasOutput projection+ , Worker.GetOutput projection ~ Camera.Projection+ )+ => projection+ -> m Process+spawn = Worker.spawnMerge1 mkScene++mkScene :: Camera.Projection -> Scene+mkScene Camera.Projection{..} =+ emptyScene+ { sceneProjection = projectionOrthoUI+ , sceneInvProjection = Transform.inverse projectionOrthoUI -- FIXME: move to cell output+ }
+ src/Stage/Loader/Setup.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE OverloadedLists #-}++module Stage.Loader.Setup+ ( bootstrap+ , stackStage+ ) where++import RIO++import Control.Monad.Trans.Resource (ResourceT)+import Engine.StageSwitch (trySwitchStage)+import Engine.Types (StackStage(..), Stage(..), StageSetupRIO)+import Engine.Types qualified as Engine+import Engine.UI.Layout qualified as Layout+import Engine.UI.Message qualified as Message+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.Texture qualified as Texture+import Resource.Texture.Ktx1 qualified as Ktx1+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.Types (FrameResources(..), RunState(..))+import Stage.Loader.Scene qualified as Scene+import Stage.Loader.UI qualified as UI++bootstrap+ :: Text+ -> (Font.Config, Font.Config)+ -> (FilePath, FilePath)+ -> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)+ -> (loaded -> StackStage)+ -> ( (Setup Vector Vector loaded -> Engine.StackStage)+ , Engine.StageSetupRIO (Setup Vector Vector loaded)+ )+bootstrap titleMessage (smallFont, largeFont) (bgPath, spinnerPath) loadAction nextStage =+ (stackStageBootstrap, action)+ where+ action = withPools \pools -> do+ logDebug "Bootstrapping loader"++ let+ fontConfigs = [smallFont, largeFont] :: Vector Font.Config+ (fontKey, fonts) <- Font.allocateCollection pools fontConfigs++ let+ texturePaths = [bgPath, spinnerPath] :: Vector FilePath+ (textureKey, textures) <- Texture.allocateCollectionWith+ (Ktx1.createTexture pools)+ texturePaths++ let+ fontContainers = fmap Font.container fonts+ combinedTextures = Collection.enumerate CombinedTextures.Collection+ { textures = textures+ , fonts = fmap Font.texture fonts+ }++ let+ uiSettings = UI.Settings+ { titleMessage = titleMessage+ , backgroundIx = 0+ , spinnerIx = 1++ , combined = combinedTextures+ , fonts = fontContainers++ , smallFont = \fs -> fs ! 0+ , largeFont = \fs -> fs ! 1+ }++ loaderKey <- Resource.register $+ traverse_ @[] Resource.release+ [ fontKey+ , textureKey+ ]++ logDebug "Finished bootstrapping loader"+ pure Setup{..}++data Setup fonts textures loaded = Setup+ { loadAction :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded+ , nextStage :: loaded -> StackStage+ , uiSettings :: UI.Settings textures fonts+ , loaderKey :: Resource.ReleaseKey+ }++stackStageBootstrap+ :: (Traversable fonts, Traversable textures)+ => Setup fonts textures loaded -> StackStage+stackStageBootstrap Setup{..} = stackStage loadAction nextStage uiSettings++stackStage+ :: (Traversable fonts, Traversable textures)+ => ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)+ -> (loaded -> StackStage)+ -> UI.Settings textures fonts+ -> StackStage+stackStage loadAction nextStage uiSettings =+ StackStage $ loaderStage loadAction nextStage uiSettings++loaderStage+ :: (Traversable fonts, Traversable textures)+ => ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)+ -> (loaded -> StackStage)+ -> UI.Settings textures fonts+ -> Basic.Stage FrameResources RunState+loaderStage loadAction nextStage uiSettings = Stage+ { sTitle = "Loader"++ , sAllocateP = allocatePipelines+ , sInitialRS = initialRunState loadAction nextStage uiSettings+ , sInitialRR = initialFrameResources uiSettings+ , sBeforeLoop = pure ()++ , sUpdateBuffers = Render.updateBuffers+ , sRecordCommands = Render.recordCommands++ , sAfterLoop = pure+ }+ where+ allocatePipelines swapchain rps = do+ logDebug "Starting loader"+ (_, samplers) <- Samplers.allocate swapchain+ let sceneBinds = Set0.set0 samplers (Left 5) (Left 0) 1+ Basic.allocatePipelines sceneBinds swapchain rps++initialRunState+ :: ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)+ -> (loaded -> StackStage)+ -> UI.Settings textures fonts+ -> StageSetupRIO (Resource.ReleaseKey, RunState)+initialRunState loadAction nextStage uiSettings =+ withPools \pools -> do+ rsProjectionP <- Engine.getScreenP++ (sceneUiKey, rsSceneUiP) <- Worker.registered $+ Scene.spawn rsProjectionP++ context <- ask++ rsQuadUV <- Model.createStagedL context pools (Quad.toVertices Quad.texturedQuad) Nothing+ quadKey <- Resource.register $ Model.destroyIndexed context rsQuadUV++ (screenKey, screenBoxP) <- Worker.registered Layout.trackScreen++ (uiKey, rsUI) <- UI.spawn pools screenBoxP uiSettings++ let+ updateProgress text = do+ logInfo $ "Loader: " <> display text+ Worker.pushInput (UI.progressInput rsUI) \msg -> msg+ { Message.inputText = text+ }++ releaseKeys <- Resource.register $+ traverse_ @[] Resource.release+ [ sceneUiKey+ , quadKey+ , screenKey+ , uiKey+ ]++ switcher <- async do+ loader <- async $ loadAction updateProgress+ link loader+ -- threadDelay 1e6+ waitCatch loader >>= \case+ Left oopsie -> do+ logError "Loader failed"+ throwM oopsie+ Right loaded -> do+ logInfo "Loader signalled a stage change"++ updateProgress "Done!"+ switched <- trySwitchStage . Engine.Replace $+ nextStage loaded+ unless switched $+ logError "Loader switch failed"++ -- XXX: propagate exceptions from loader threads+ link switcher++ pure (releaseKeys, RunState{..})++initialFrameResources+ :: (Traversable fonts, Traversable textures)+ => UI.Settings fonts textures+ -> Queues Vk.CommandPool+ -> Basic.RenderPasses+ -> Basic.Pipelines+ -> ResourceT (Engine.StageRIO RunState) FrameResources+initialFrameResources UI.Settings{combined} _pools _passes pipelines = do+ frSceneUi <- Set0.allocate+ (Basic.getSceneLayout pipelines)+ (fmap snd combined)+ Nothing+ Nothing+ mempty -- XXX: no shadows on loader+ Nothing++ frUI <- gets rsUI >>=+ UI.newObserver++ pure FrameResources{..}
+ src/Stage/Loader/Types.hs view
@@ -0,0 +1,31 @@+module Stage.Loader.Types+ ( Stage+ , Frame++ , FrameResources(..)+ , RunState(..)+ ) where++import Engine.Camera qualified as Camera+import Render.Basic qualified as Basic+import Render.DescSets.Set0 qualified as Set0++import Stage.Loader.UI (UI)+import Stage.Loader.UI qualified as UI++type Stage = Basic.Stage FrameResources RunState++type Frame = Basic.Frame FrameResources++data FrameResources = FrameResources+ { frSceneUi :: Set0.FrameResource '[Set0.Scene]++ , frUI :: UI.Observer+ }++data RunState = RunState+ { rsProjectionP :: Camera.ProjectionProcess+ , rsSceneUiP :: Set0.Process++ , rsUI :: UI+ }
+ src/Stage/Loader/UI.hs view
@@ -0,0 +1,227 @@+module Stage.Loader.UI+ ( Settings(..)++ , UI(..)+ , spawn++ , Observer(..)+ , newObserver+ , observe+ ) where++import RIO++import Control.Monad.Trans.Resource (ResourceT)+import Control.Monad.Trans.Resource qualified as Resource+import Geomancy (vec4)+import Geomancy.Transform qualified as Transform+import RIO.Vector.Storable qualified as Storable+import Vulkan.Core10 qualified as Vk++import Engine.Types qualified as Engine+import Engine.UI.Layout qualified as Layout+import Engine.UI.Message qualified as Message+import Engine.Vulkan.Types (HasVulkan, Queues)+import Engine.Worker qualified as Worker+import Geometry.Quad qualified as Quad+import Render.Samplers qualified as Samplers+import Render.Unlit.Textured.Model qualified as UnlitTextured+import Resource.Buffer qualified as Buffer+import Resource.Combined.Textures qualified as CombinedTextures+import Resource.Font.EvanW qualified as EvanW+import Resource.Model qualified as Model+import Resource.Texture (Texture, Flat)++data Settings fonts textures = Settings+ { titleMessage :: Text+ , backgroundIx :: Int32+ , spinnerIx :: Int32++ , combined :: CombinedTextures.Collection textures fonts (Int32, Texture Flat)+ , fonts :: fonts EvanW.Container++ , smallFont :: forall a . fonts a -> a+ , largeFont :: forall a . fonts a -> a+ }++data UI = UI+ { titleP :: Message.Process+ , subtitleP :: Message.Process++ , progressInput :: Worker.Var Message.Input+ , progressP :: Message.Process++ , backgroundP :: Worker.Merge StorableAttrs+ , spinnerP :: Worker.Merge StorableAttrs++ , quadUV :: UnlitTextured.Model 'Buffer.Staged+ }++type StorableAttrs =+ ( Storable.Vector UnlitTextured.TextureParams+ , Storable.Vector UnlitTextured.Transform+ )++spawn+ :: Queues Vk.CommandPool+ -> Layout.BoxProcess+ -> Settings fonts textures+ -> Engine.StageRIO env (Resource.ReleaseKey, UI)+spawn pools screenBoxP Settings{..} = do+ paddingVar <- Worker.newVar 16+ (screenPaddedKey, screenPaddedP) <- Worker.registered $+ Layout.padAbs screenBoxP paddingVar++ -- Messages++ sections <- Layout.splitsRelStatic Layout.sharePadsV screenPaddedP [2, 1, 1]+ sectionsKey <- Worker.registerCollection sections++ (titleBoxP, subtitleBoxP, progressBoxP) <- case sections of+ [titleBoxP, subtitleBoxP, progressBoxP] ->+ pure (titleBoxP, subtitleBoxP, progressBoxP)+ _ ->+ error "assert: shares in Traversable preserve structure"++ (titleKey, titleP) <- Worker.registered $+ Worker.newVar title >>= Message.spawn titleBoxP+ (subtitleKey, subtitleP) <- Worker.registered $+ Worker.newVar subtitle >>= Message.spawn subtitleBoxP++ progressInput <- Worker.newVar progress+ (progressKey, progressP) <- Worker.registered $+ Message.spawn progressBoxP progressInput++ -- Splash++ (backgroundBoxKey, backgroundBoxP) <- Worker.registered $+ Layout.fitPlaceAbs Layout.Center 1.0 screenBoxP++ (backgroundKey, backgroundP) <- Worker.registered $+ Worker.spawnMerge1+ ( \box ->+ UnlitTextured.storableAttrs1+ (Samplers.linear Samplers.indices)+ backgroundIx+ [Layout.boxTransformAbs box]+ )+ backgroundBoxP++ -- Spinner++ (spinnerTransformTimeKey, spinnerTransformTimeP) <- Worker.registered $+ Worker.spawnTimed_ 100 True do+ t <- getMonotonicTime+ pure $ Transform.rotateZ (realToFrac t)++ (spinnerTransformBoxKey, spinnerTransformBoxP) <- Worker.registered $+ Worker.spawnMerge1+ (Layout.boxTransformAbs . snd . Layout.boxFitScale 64)+ subtitleBoxP++ (spinnerKey, spinnerP) <- Worker.registered $+ Worker.spawnMerge2+ ( \place turn ->+ UnlitTextured.storableAttrs1+ (Samplers.linear Samplers.indices)+ spinnerIx+ [turn, place]+ )+ spinnerTransformBoxP+ spinnerTransformTimeP++ -- Models++ context <- ask+ quadUV <- Model.createStagedL context pools (Quad.toVertices Quad.texturedQuad) Nothing+ quadUVKey <- Resource.register $ Model.destroyIndexed context quadUV++ -- Cleanup++ key <- Resource.register $ traverse_ Resource.release+ [ screenPaddedKey+ , sectionsKey+ , titleKey, subtitleKey, progressKey+ , backgroundBoxKey, backgroundKey+ , spinnerTransformBoxKey, spinnerTransformTimeKey, spinnerKey+ , quadUVKey+ ]++ pure (key, UI{..})+ where+ title = Message.Input+ { inputText = titleMessage+ , inputOrigin = Layout.CenterBottom+ , inputSize = 64+ , inputColor = vec4 1 0.5 0.25 1+ , inputFont = largeFont fonts+ , inputFontId = fst . largeFont $ CombinedTextures.fonts combined+ , inputOutline = vec4 0 0 0 1+ , inputOutlineWidth = 4/16+ , inputSmoothing = 1/16+ }++ subtitle = Message.Input+ { inputText = "Loading..."+ , inputOrigin = Layout.CenterTop+ , inputSize = 32+ , inputColor = vec4 0.5 1 0.25 1+ , inputFont = smallFont fonts+ , inputFontId = fst . smallFont $ CombinedTextures.fonts combined+ , inputOutline = vec4 0 0 0 1+ , inputOutlineWidth = 4/16+ , inputSmoothing = 1/16+ }++ progress = Message.Input+ { inputText = ""+ , inputOrigin = Layout.CenterBottom+ , inputSize = 16+ , inputColor = vec4 0.25 0.5 1 1+ , inputFont = smallFont fonts+ , inputFontId = fst . smallFont $ CombinedTextures.fonts combined+ , inputOutline = 0+ , inputOutlineWidth = 0+ , inputSmoothing = 1/16+ }++data Observer = Observer+ { messages :: [Message.Observer]+ , background :: Worker.ObserverIO (UnlitTextured.InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)+ , spinner :: Worker.ObserverIO (UnlitTextured.InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)+ }++newObserver :: UI -> ResourceT (Engine.StageRIO st) Observer+newObserver UI{..} = do+ -- XXX: Generic?+ messages <- traverse (const $ Message.newObserver 256)+ [ titleP+ , subtitleP+ , progressP+ ]++ let+ newBufferObserver1 =+ UnlitTextured.allocateInstancesCoherent_ 1 >>= Worker.newObserverIO++ background <- newBufferObserver1+ spinner <- newBufferObserver1++ pure Observer{..}++observe+ :: ( HasVulkan env+ )+ => UI+ -> Observer -> RIO env ()+observe UI{..} Observer{..} = do+ traverse_ (uncurry Message.observe) $+ zip [titleP, subtitleP, progressP] messages++ context <- ask++ Worker.observeIO_ backgroundP background $+ UnlitTextured.updateCoherentResize_ context++ Worker.observeIO_ spinnerP spinner $+ UnlitTextured.updateCoherentResize_ context