packages feed

keid-render-basic 0.1.1.4 → 0.1.2.0

raw patch · 11 files changed

+195/−53 lines, 11 filesdep +adjunctionsdep +distributivedep +file-embeddep ~keid-core

Dependencies added: adjunctions, distributive, file-embed

Dependency ranges changed: keid-core

Files

ChangeLog.md view
@@ -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.
keid-render-basic.cabal view
@@ -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
+ src/Global/Resource/CubeMap/Base.hs view
@@ -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)+  }
+ src/Global/Resource/CubeMap/Base/Paths.hs view
@@ -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
+ src/Global/Resource/Texture/Base.hs view
@@ -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)+  }
+ src/Global/Resource/Texture/Base/Paths.hs view
@@ -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
src/Render/Basic.hs view
@@ -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
src/Render/DescSets/Set0.hs view
@@ -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   }
src/Resource/Font.hs view
@@ -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
src/Resource/Font/EvanW.hs view
@@ -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
src/Stage/Loader/Setup.hs view
@@ -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