diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Changelog for keid-render-basic +## 0.1.2.0 + +- Added embedded base textures and cubes needed for shader code. +- Changed Font resource to Source loader for both container and texture. +- Added callstack freezing to report call sites in debug log. +- Changed Loader stage to use `Source` in bootstrap. +- Removed `Set0.set0` and `Set0.set0_`. + - Added `Set0.mkBindings` instead. + - Minimal descriptor counts derived from base collections to prevent HOOM errors. + ## 0.1.1.4 - Fixed another VK_HOST_OUT_OF_MEMORY, in Loader stage. diff --git a/keid-render-basic.cabal b/keid-render-basic.cabal --- a/keid-render-basic.cabal +++ b/keid-render-basic.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: keid-render-basic -version: 0.1.1.4 +version: 0.1.2.0 synopsis: Basic rendering programs for Keid engine. category: Game Engine author: IC Rainbow @@ -25,6 +25,10 @@ library exposed-modules: Engine.UI.Message + Global.Resource.CubeMap.Base + Global.Resource.CubeMap.Base.Paths + Global.Resource.Texture.Base + Global.Resource.Texture.Base.Paths Render.Basic Render.Code.Lit Render.Debug.Model @@ -121,13 +125,16 @@ ViewPatterns ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints build-depends: - aeson + adjunctions + , aeson , base >=4.7 && <5 , bytestring , derive-storable , derive-storable-plugin + , distributive + , file-embed >=0.0.10 , geomancy - , keid-core + , keid-core >=0.1.2.0 , keid-geometry , neat-interpolation , resourcet diff --git a/src/Global/Resource/CubeMap/Base.hs b/src/Global/Resource/CubeMap/Base.hs new file mode 100644 --- /dev/null +++ b/src/Global/Resource/CubeMap/Base.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveAnyClass #-} + +-- {-# OPTIONS_GHC -fforce-recomp #-} + +module Global.Resource.CubeMap.Base + ( Collection(..) + , sources + ) where + +import RIO + +import Data.Distributive (Distributive(..)) +import Data.Distributive.Generic (genericCollect) +import Data.Functor.Rep (Co(..), Representable) +import GHC.Generics (Generic1) +import Resource.Source (Source) +import Resource.Source qualified as Source + +import Global.Resource.CubeMap.Base.Paths qualified as Paths + +data Collection a = Collection + { black :: a + } + deriving stock (Show, Functor, Foldable, Traversable, Generic, Generic1) + deriving Applicative via (Co Collection) + deriving anyclass (Representable) + +instance Distributive Collection where + collect = genericCollect + +sources :: Collection Source +sources = Collection + { black = $(Source.embedFile Paths.BLACK_KTX_ZST) + } diff --git a/src/Global/Resource/CubeMap/Base/Paths.hs b/src/Global/Resource/CubeMap/Base/Paths.hs new file mode 100644 --- /dev/null +++ b/src/Global/Resource/CubeMap/Base/Paths.hs @@ -0,0 +1,10 @@ +module Global.Resource.CubeMap.Base.Paths where + +import RIO + +import Data.FileEmbed (makeRelativeToProject) +import Resource.Static as Static +import RIO.FilePath (()) + +makeRelativeToProject ("embed" "cubemaps") >>= + Static.filePatterns Static.Files diff --git a/src/Global/Resource/Texture/Base.hs b/src/Global/Resource/Texture/Base.hs new file mode 100644 --- /dev/null +++ b/src/Global/Resource/Texture/Base.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveAnyClass #-} + +-- {-# OPTIONS_GHC -fforce-recomp #-} + +module Global.Resource.Texture.Base + ( Collection(..) + , sources + ) where + +import RIO + +import Data.Distributive (Distributive(..)) +import Data.Distributive.Generic (genericCollect) +import Data.Functor.Rep (Co(..), Representable) +import GHC.Generics (Generic1) +import Resource.Source (Source) +import Resource.Source qualified as Source + +import Global.Resource.Texture.Base.Paths qualified as Paths + +data Collection a = Collection + { black :: a + , flat :: a + , ibl_brdf_lut :: a + } + deriving stock (Show, Functor, Foldable, Traversable, Generic, Generic1) + deriving Applicative via (Co Collection) + deriving anyclass (Representable) + +instance Distributive Collection where + collect = genericCollect + +sources :: Collection Source +sources = Collection + { black = $(Source.embedFile Paths.BLACK_KTX_ZST) + , flat = $(Source.embedFile Paths.FLAT_KTX_ZST) + , ibl_brdf_lut = $(Source.embedFile Paths.IBL_BRDF_LUT_KTX_ZST) + } diff --git a/src/Global/Resource/Texture/Base/Paths.hs b/src/Global/Resource/Texture/Base/Paths.hs new file mode 100644 --- /dev/null +++ b/src/Global/Resource/Texture/Base/Paths.hs @@ -0,0 +1,10 @@ +module Global.Resource.Texture.Base.Paths where + +import RIO + +import Data.FileEmbed (makeRelativeToProject) +import Resource.Static as Static +import RIO.FilePath (()) + +makeRelativeToProject ("embed" "textures") >>= + Static.filePatterns Static.Files diff --git a/src/Render/Basic.hs b/src/Render/Basic.hs --- a/src/Render/Basic.hs +++ b/src/Render/Basic.hs @@ -98,7 +98,7 @@ allocatePipelines_ swapchain renderpasses = do (_, samplers) <- Samplers.allocate swapchain allocatePipelines - (Scene.set0 samplers (Left 3) (Left 1) 2) + (Scene.mkBindings samplers Nothing Nothing 0) swapchain renderpasses diff --git a/src/Render/DescSets/Set0.hs b/src/Render/DescSets/Set0.hs --- a/src/Render/DescSets/Set0.hs +++ b/src/Render/DescSets/Set0.hs @@ -9,8 +9,7 @@ , updateSet0Ds - , set0 - , set0_ + , mkBindings -- TODO: extract to typeclass magic , vertexPos @@ -52,13 +51,14 @@ import Engine.Vulkan.Pipeline qualified as Pipeline import Engine.Vulkan.Types (DsBindings, HasVulkan(..)) import Engine.Worker qualified as Worker +import Global.Resource.CubeMap.Base qualified as BaseCubeMap +import Global.Resource.Texture.Base qualified as BaseTexture import Render.DescSets.Sun (Sun) import Render.Lit.Material (Material) import Resource.Buffer qualified as Buffer import Resource.Collection qualified as Collection import Resource.DescriptorSet qualified as DescriptorSet import Resource.Image qualified as Image -import Resource.Texture (Flat, CubeMap, Texture) import Resource.Texture qualified as Texture -- * Set0 data @@ -101,14 +101,17 @@ -- * Common descriptor set -set0 - :: Traversable samplers +mkBindings + :: ( Foldable samplers + , Foldable textures + , Foldable cubemaps + ) => samplers Vk.Sampler - -> Either Word32 (Vector (Texture Flat)) - -> Either Word32 (Vector (Texture CubeMap)) + -> textures a + -> cubemaps b -> Word32 -> Tagged Scene DsBindings -set0 samplers textures cubes shadows = Tagged +mkBindings samplers textures cubes shadows = Tagged [ (set0bind0, zero) , (set0bind1 samplers, zero) , (set0bind2 textures, partialBinding) @@ -137,10 +140,6 @@ (https://vulkan.lunarg.com/doc/view/1.2.162.1~rc2/linux/1.2-extensions/vkspec.html#VUID-VkDescriptorSetLayoutBindingFlagsCreateInfo-pBindingFlags-03004) -} --- | Nothing texture-related is provided. -set0_ :: Tagged Scene DsBindings -set0_ = set0 [] (Left 0) (Left 0) 0 - set0bind0 :: Vk.DescriptorSetLayoutBinding set0bind0 = Vk.DescriptorSetLayoutBinding { binding = 0 @@ -150,7 +149,10 @@ , immutableSamplers = mempty } -set0bind1 :: Traversable t => t Vk.Sampler -> Vk.DescriptorSetLayoutBinding +set0bind1 + :: Foldable samplers + => samplers Vk.Sampler + -> Vk.DescriptorSetLayoutBinding set0bind1 samplers = Vk.DescriptorSetLayoutBinding { Vk.binding = 1 , Vk.stageFlags = Vk.SHADER_STAGE_FRAGMENT_BIT @@ -161,35 +163,35 @@ where linearSamplers = Collection.toVector samplers -set0bind2 :: Either Word32 (Vector (Texture Flat)) -> Vk.DescriptorSetLayoutBinding +set0bind2 + :: Foldable textures + => textures a + -> Vk.DescriptorSetLayoutBinding set0bind2 textures = Vk.DescriptorSetLayoutBinding { binding = 2 , descriptorType = Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE - , descriptorCount = textureCount + , descriptorCount = fromIntegral $ max baseTextures textureCount , stageFlags = Vk.SHADER_STAGE_FRAGMENT_BIT , immutableSamplers = mempty } where - textureCount = case textures of - Left n -> - n - Right v -> - fromIntegral $ Vector.length v + baseTextures = length BaseTexture.sources + textureCount = length textures -set0bind3 :: Either Word32 (Vector (Texture CubeMap)) -> Vk.DescriptorSetLayoutBinding +set0bind3 + :: Foldable cubes + => cubes a + -> Vk.DescriptorSetLayoutBinding set0bind3 cubes = Vk.DescriptorSetLayoutBinding { binding = 3 , descriptorType = Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE - , descriptorCount = cubeCount + , descriptorCount = fromIntegral $ max baseCubes cubeCount , stageFlags = Vk.SHADER_STAGE_FRAGMENT_BIT , immutableSamplers = mempty } where - cubeCount = case cubes of - Left n -> - n - Right v -> - fromIntegral $ Vector.length v + baseCubes = length BaseCubeMap.sources + cubeCount = length cubes set0bind4 :: Vk.DescriptorSetLayoutBinding set0bind4 = Vk.DescriptorSetLayoutBinding @@ -205,7 +207,7 @@ { binding = 5 , descriptorType = Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER , stageFlags = Vk.SHADER_STAGE_FRAGMENT_BIT - , descriptorCount = shadows + , descriptorCount = max 1 shadows , immutableSamplers = mempty } diff --git a/src/Resource/Font.hs b/src/Resource/Font.hs --- a/src/Resource/Font.hs +++ b/src/Resource/Font.hs @@ -10,6 +10,7 @@ import RIO +import GHC.Stack (withFrozenCallStack) import RIO.Vector qualified as Vector import UnliftIO.Resource qualified as Resource import Vulkan.Core10 qualified as Vk @@ -17,6 +18,7 @@ import Engine.Types (StageRIO) import Engine.Vulkan.Types (Queues) import Resource.Font.EvanW qualified as EvanW +import Resource.Source (Source) import Resource.Texture (Texture, Flat) import Resource.Texture qualified as Texture import Resource.Texture.Ktx1 qualified as Ktx1 @@ -24,18 +26,21 @@ -- * General collection tools data Config = Config - { configContainer :: FilePath - , configTexture :: FilePath + { configContainer :: Source + , configTexture :: Source } - deriving (Eq, Ord, Show) + deriving (Show) allocateCollection - :: Traversable collection + :: ( Traversable collection + , HasCallStack + ) => Queues Vk.CommandPool -> collection Config -> StageRIO st (Resource.ReleaseKey, collection Font) allocateCollection pools collection = do - collected <- for collection $ allocateFont pools + collected <- for collection $ + withFrozenCallStack $ allocateFont pools key <- Resource.register $ traverse_ Resource.release $ fmap fst collected pure (key, fmap snd collected) @@ -50,15 +55,18 @@ } allocateFont - :: Queues Vk.CommandPool + :: HasCallStack + => Queues Vk.CommandPool -> Config -> StageRIO st (Resource.ReleaseKey, Font) allocateFont pools Config{..} = do context <- ask - container <- EvanW.load configContainer + container <- withFrozenCallStack $ + EvanW.load configContainer - createTexture <- toIO $ Ktx1.createTexture pools configTexture + createTexture <- toIO . withFrozenCallStack $ + Ktx1.load pools configTexture (textureKey, texture) <- Resource.allocate createTexture diff --git a/src/Resource/Font/EvanW.hs b/src/Resource/Font/EvanW.hs --- a/src/Resource/Font/EvanW.hs +++ b/src/Resource/Font/EvanW.hs @@ -17,14 +17,17 @@ import RIO -import Data.Aeson (FromJSON, eitherDecodeFileStrict') +import Data.Aeson (FromJSON, eitherDecodeStrict') import Foreign qualified import Geomancy (Vec2, vec2, pattern WithVec2) +import GHC.Stack (withFrozenCallStack) import RIO.HashMap qualified as HashMap import RIO.Text qualified as Text import Vulkan.NamedType ((:::)) import Engine.UI.Layout qualified as Layout +import Resource.Source (Source) +import Resource.Source qualified as Source -- * Loading @@ -58,12 +61,17 @@ instance FromJSON Container instance FromJSON Character -load :: HasLogFunc env => FilePath -> RIO env Container -load fp = do - logInfo $ "Loading font " <> fromString fp - liftIO (eitherDecodeFileStrict' fp) >>= \case +load + :: ( MonadIO m + , MonadReader env m + , HasLogFunc env + , HasCallStack + ) + => Source -> m Container +load = withFrozenCallStack . Source.load \bytes -> + case eitherDecodeStrict' bytes of Left err -> - throwM . FontError $ Text.pack err + liftIO . throwIO . FontError $ Text.pack err Right res -> pure res diff --git a/src/Stage/Loader/Setup.hs b/src/Stage/Loader/Setup.hs --- a/src/Stage/Loader/Setup.hs +++ b/src/Stage/Loader/Setup.hs @@ -24,6 +24,7 @@ import Resource.CommandBuffer (withPools) import Resource.Font qualified as Font import Resource.Model qualified as Model +import Resource.Source (Source) import Resource.Texture qualified as Texture import Resource.Texture.Ktx1 qualified as Ktx1 import RIO.State (gets) @@ -39,7 +40,7 @@ bootstrap :: Text -> (Font.Config, Font.Config) - -> (FilePath, FilePath) + -> (Source, Source) -> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded) -> (loaded -> StackStage) -> ( (Setup Vector Vector loaded -> Engine.StackStage) @@ -56,9 +57,9 @@ (fontKey, fonts) <- Font.allocateCollection pools fontConfigs let - texturePaths = [bgPath, spinnerPath] :: Vector FilePath + texturePaths = [bgPath, spinnerPath] :: Vector Source (textureKey, textures) <- Texture.allocateCollectionWith - (Ktx1.createTexture pools) + (Ktx1.load pools) texturePaths let @@ -132,11 +133,16 @@ } where allocatePipelines swapchain rps = do - logDebug "Starting loader" + logDebug "Allocating loader pipelines" (_, samplers) <- Samplers.allocate swapchain - let sceneBinds = Set0.set0 samplers (Left 5) (Left 1) 1 - Basic.allocatePipelines sceneBinds swapchain rps + Basic.allocatePipelines (sceneBinds samplers) swapchain rps + sceneBinds samplers = Set0.mkBindings + samplers + (UI.combined uiSettings) + Nothing + 0 + initialRunState :: ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded) -> (loaded -> StackStage) @@ -174,7 +180,16 @@ ] switcher <- async do - loader <- async $ loadAction updateProgress + loader <- async do + logDebug "Starting load action" + try (loadAction updateProgress) >>= \case + Left (e :: SomeException) -> do + logError $ "Load action failed with " <> displayShow e + throwM e + Right r -> do + logDebug "Load action finished" + pure r + link loader -- threadDelay 1e6 waitCatch loader >>= \case