keid-render-basic 0.1.7.0 → 0.1.8.0

raw patch · 51 files changed

+1456/−1378 lines, 51 filesdep ~keid-corebinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: keid-core

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• embed/cubemaps/black.ktx2 binary
• embed/textures/black.ktx2 binary
• embed/textures/flat.ktx2 binary
• embed/textures/ibl_brdf_lut.ktx2 binary
• keid-render-basic.cabal +12/−3
• src/Engine/UI/Message.hs +21/−20
• src/Global/Resource/CubeMap/Base.hs +7/−3
• src/Global/Resource/Texture/Base.hs +7/−3
• src/Render/Basic.hs +70/−32
• src/Render/Code/Lit.hs +17/−7
• src/Render/Debug/Code.hs +2/−2
• src/Render/Debug/Model.hs +69/−181
• src/Render/Debug/Pipeline.hs +6/−13
• src/Render/DepthOnly/Pipeline.hs +8/−12
• src/Render/DescSets/Set0.hs +44/−49
• src/Render/DescSets/Sun.hs +29/−57
• src/Render/Font/EvanwSdf/Model.hs +23/−51
• src/Render/Font/EvanwSdf/Pipeline.hs +4/−8
• src/Render/ForwardMsaa.hs +88/−76
• src/Render/Lit/Colored/Model.hs +10/−32
• src/Render/Lit/Colored/Pipeline.hs +8/−14
• src/Render/Lit/Material.hs +4/−0
• src/Render/Lit/Material/Code.hs +2/−0
• src/Render/Lit/Material/Model.hs +9/−43
• src/Render/Lit/Material/Pipeline.hs +8/−14
• src/Render/Lit/Textured/Model.hs +13/−143
• src/Render/Lit/Textured/Pipeline.hs +8/−15
• src/Render/Pass/Compose.hs +183/−0
• src/Render/ShadowMap/Pipeline.hs +6/−11
• src/Render/ShadowMap/RenderPass.hs +25/−32
• src/Render/Skybox/Pipeline.hs +3/−3
• src/Render/Unlit/Colored/Model.hs +4/−9
• src/Render/Unlit/Colored/Pipeline.hs +8/−14
• src/Render/Unlit/Line2d/Code.hs +61/−0
• src/Render/Unlit/Line2d/Draw.hs +86/−0
• src/Render/Unlit/Line2d/Model.hs +201/−0
• src/Render/Unlit/Line2d/Pipeline.hs +69/−0
• src/Render/Unlit/Sprite/Code.hs +30/−17
• src/Render/Unlit/Sprite/Model.hs +56/−18
• src/Render/Unlit/Sprite/Pipeline.hs +4/−8
• src/Render/Unlit/Textured/Model.hs +76/−158
• src/Render/Unlit/Textured/Pipeline.hs +8/−15
• src/Render/Unlit/TileMap/Code.hs +38/−11
• src/Render/Unlit/TileMap/Model.hs +51/−153
• src/Render/Unlit/TileMap/Pipeline.hs +8/−15
• src/Resource/Font.hs +8/−34
• src/Stage/Loader/Render.hs +1/−1
• src/Stage/Loader/Scene.hs +4/−1
• src/Stage/Loader/Setup.hs +17/−44
• src/Stage/Loader/UI.hs +29/−56

@@ -1,5 +1,16 @@ # Changelog for keid-render-basic +## 0.1.8.0++- Embedded texture resources now using KTX2.+- Fixed grid artifacts in TileMap shader.+- Added multiscattering term for `Lit` pipelines, plugging an energy loss in metals.+- Added Unlit Line2D pipeline for batches of extra-fancy lines with rounded corners and segments.+- Fixed missing margins in sprite model generation from an atlas.+- Sprite LOD fixed to 0 to prevent issues with packed tilesets.+- Added tileset borders and offset.+- Changed TileMap pipeline model to use Tiled-style mod flags in A-channel.+ ## 0.1.7.0  - Pipelines updated to use `Engine.Vulkan.Pipeline.Graphics`.

binary file changed (absent → 265 bytes)

binary file changed (absent → 278 bytes)

binary file changed (absent → 329 bytes)

binary file changed (absent → 193434 bytes)

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack  name:           keid-render-basic-version:        0.1.7.0+version:        0.1.8.0 synopsis:       Basic rendering programs for Keid engine. category:       Game Engine homepage:       https://keid.haskell-game.dev@@ -20,9 +20,13 @@     ChangeLog.md data-files:     embed/cubemaps/black.ktx.zst+    embed/cubemaps/black.ktx2     embed/textures/black.ktx.zst+    embed/textures/black.ktx2     embed/textures/flat.ktx.zst+    embed/textures/flat.ktx2     embed/textures/ibl_brdf_lut.ktx.zst+    embed/textures/ibl_brdf_lut.ktx2  source-repository head   type: git@@ -60,6 +64,7 @@       Render.Lit.Textured.Code       Render.Lit.Textured.Model       Render.Lit.Textured.Pipeline+      Render.Pass.Compose       Render.ShadowMap.Code       Render.ShadowMap.Pipeline       Render.ShadowMap.RenderPass@@ -68,6 +73,10 @@       Render.Unlit.Colored.Code       Render.Unlit.Colored.Model       Render.Unlit.Colored.Pipeline+      Render.Unlit.Line2d.Code+      Render.Unlit.Line2d.Draw+      Render.Unlit.Line2d.Model+      Render.Unlit.Line2d.Pipeline       Render.Unlit.Sprite.Code       Render.Unlit.Sprite.Model       Render.Unlit.Sprite.Pipeline@@ -155,7 +164,7 @@     , derive-storable-plugin     , file-embed >=0.0.10     , geomancy-    , keid-core >=0.1.7.0+    , keid-core >=0.1.8.0     , keid-geometry     , neat-interpolation     , resourcet

@@ -19,11 +19,12 @@ import Data.Vector.Storable qualified as Storable import Geomancy (Vec4) import Geomancy.Vec4 qualified as Vec4+import UnliftIO.Resource (MonadResource) import Vulkan.Core10 qualified as Vk  import Engine.Types qualified as Engine import Engine.UI.Layout qualified as Layout-import Engine.Vulkan.Types (HasVulkan)+import Engine.Vulkan.Types (MonadVulkan) import Engine.Worker qualified as Worker import Render.Font.EvanwSdf.Model qualified as EvanwSdf import Render.Samplers qualified as Samplers@@ -33,15 +34,21 @@ type Process = Worker.Merge (Storable.Vector EvanwSdf.InstanceAttrs)  spawn-  :: ( Worker.HasOutput box+  :: ( MonadResource m+     , MonadUnliftIO m+     , Worker.HasOutput box      , Worker.GetOutput box ~ Layout.Box      , Worker.HasOutput input      , Worker.GetOutput input ~ Input-     ) => box -> input -> RIO env Process+     )+  => box+  -> input+  -> m Process spawn = Worker.spawnMerge2 mkAttrs  spawnFromR-  :: ( Resource.MonadResource (RIO env)+  :: ( MonadResource m+     , MonadUnliftIO m      , Worker.HasOutput box      , Worker.GetOutput box ~ Layout.Box      , Worker.HasOutput source@@ -49,14 +56,10 @@   => box   -> source   -> (Worker.GetOutput source -> Input)-  -> RIO env (Resource.ReleaseKey, Resource.ReleaseKey, Process)+  -> m Process spawnFromR parent inputProc mkMessage = do   inputP <- Worker.spawnMerge1 mkMessage inputProc-  messageP <- spawn parent inputP--  (,,messageP)-    <$> Worker.register inputP-    <*> Worker.register messageP+  spawn parent inputP  data Input = Input   { inputText         :: Text@@ -105,25 +108,23 @@  newObserver :: Int -> ResourceT (Engine.StageRIO st) Observer newObserver initialSize = do-  context <- ask--  messageData <- Buffer.createCoherent context Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT initialSize mempty+  messageData <- Buffer.createCoherent (Just "Message") Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT initialSize mempty   observer <- Worker.newObserverIO messageData +  context <- ask   void $! Resource.register do     vData <- readIORef observer-    Buffer.destroyAll context vData+    traverse_ (Buffer.destroy context) vData    pure observer  observe-  :: ( HasVulkan env+  :: ( MonadVulkan env m      , Worker.HasOutput source      , Worker.GetOutput source ~ Storable.Vector EvanwSdf.InstanceAttrs      )   => source-  -> Observer -> RIO env ()-observe messageP observer = do-  context <- ask-  Worker.observeIO_ messageP observer $-    Buffer.updateCoherentResize_ context+  -> Observer+  -> m ()+observe messageP observer =+  Worker.observeIO_ messageP observer Buffer.updateCoherentResize_

@@ -4,25 +4,29 @@  module Global.Resource.CubeMap.Base   ( Collection(..)+  , Textures   , sources   ) where  import RIO  import GHC.Generics (Generic1)+import Resource.Collection (Generically1(..)) import Resource.Source (Source) import Resource.Source qualified as Source-import Resource.Collection (Generically1(..))+import Resource.Texture (Texture, CubeMap)  import Global.Resource.CubeMap.Base.Paths qualified as Paths  data Collection a = Collection-  { black        :: a+  { black :: a   }   deriving stock (Show, Functor, Foldable, Traversable, Generic1)   deriving Applicative via Generically1 Collection +type Textures = Collection (Texture CubeMap)+ sources :: Collection Source sources = Collection-  { black        = $(Source.embedFile Paths.BLACK_KTX_ZST)+  { black = $(Source.embedFile Paths.BLACK_KTX2)   }

@@ -4,6 +4,7 @@  module Global.Resource.Texture.Base   ( Collection(..)+  , Textures   , sources   ) where @@ -13,6 +14,7 @@ import Resource.Collection (Generically1(..)) import Resource.Source (Source) import Resource.Source qualified as Source+import Resource.Texture (Texture, Flat)  import Global.Resource.Texture.Base.Paths qualified as Paths @@ -24,9 +26,11 @@   deriving stock (Show, Functor, Foldable, Traversable, Generic1)   deriving Applicative via Generically1 Collection +type Textures = Collection (Texture Flat)+ 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)+  { black        = $(Source.embedFile Paths.BLACK_KTX2)+  , flat         = $(Source.embedFile Paths.FLAT_KTX2)+  , ibl_brdf_lut = $(Source.embedFile Paths.IBL_BRDF_LUT_KTX2)   }

@@ -28,9 +28,7 @@ import Engine.Vulkan.Pipeline.Graphics qualified as Graphics import Engine.Vulkan.Shader qualified as Shader import Engine.Vulkan.Swapchain qualified as Swapchain-import Engine.Vulkan.Types (DsBindings, HasSwapchain, HasVulkan, RenderPass(..))-import Engine.Worker qualified as Worker-import Resource.Region qualified as Region+import Engine.Vulkan.Types (DsLayoutBindings, HasSwapchain, HasVulkan, RenderPass(..))  -- keid-render-basic @@ -52,6 +50,7 @@ import Render.ShadowMap.RenderPass qualified as ShadowPass import Render.Skybox.Pipeline qualified as Skybox import Render.Unlit.Colored.Pipeline qualified as UnlitColored+import Render.Unlit.Line2d.Pipeline qualified as UnlitLine2d import Render.Unlit.Sprite.Pipeline qualified as UnlitSprite import Render.Unlit.Textured.Pipeline qualified as UnlitTextured import Render.Unlit.TileMap.Pipeline qualified as UnlitTileMap@@ -130,10 +129,10 @@  data PipelinesF (f :: Type -> Type) = Pipelines   { pMSAA       :: Vk.SampleCountFlagBits-  , pSceneBinds :: Tagged Scene DsBindings+  , pSceneBinds :: Tagged Scene DsLayoutBindings   , pSceneLayout :: Tagged '[Scene] Vk.DescriptorSetLayout -  , pShadowBinds :: Tagged Sun DsBindings+  , pShadowBinds :: Tagged Sun DsLayoutBindings   , pShadowLayout :: Tagged '[Sun] Vk.DescriptorSetLayout    , pEvanwSdf :: f ^ EvanwSdf.Pipeline@@ -157,6 +156,9 @@   , pUnlitTextured       :: f ^ UnlitTextured.Pipeline   , pUnlitTexturedBlend  :: f ^ UnlitTextured.Pipeline +  , pLine2d        :: f ^ UnlitLine2d.Pipeline+  , pLine2dNoDepth :: f ^ UnlitLine2d.Pipeline+   , pSprite              :: f ^ UnlitSprite.Pipeline   , pSpriteOutline       :: f ^ UnlitSprite.Pipeline   , pTileMap             :: f ^ UnlitTileMap.Pipeline@@ -173,8 +175,7 @@   -> RenderPasses   -> ResourceT (StageRIO st) Pipelines allocatePipelines_ swapchain renderpasses = do-  (_, samplers) <- Samplers.allocate-    (Swapchain.getAnisotropy swapchain)+  samplers <- Samplers.allocate (Swapchain.getAnisotropy swapchain)    allocatePipelines     (Scene.mkBindings samplers Nothing Nothing 0)@@ -182,7 +183,7 @@     renderpasses  allocatePipelines-  :: Tagged Scene DsBindings+  :: Tagged Scene DsLayoutBindings   -> Vk.SampleCountFlagBits   -> RenderPasses   -> ResourceT (StageRIO st) Pipelines@@ -203,6 +204,8 @@   pLitTextured      <- LitTextured.allocate pMSAA pSceneBinds rpForwardMsaa   pLitTexturedBlend <- LitTextured.allocateBlend pMSAA pSceneBinds rpForwardMsaa +  pLine2d              <- UnlitLine2d.allocate True pMSAA pSceneBinds rpForwardMsaa+  pLine2dNoDepth       <- UnlitLine2d.allocate False pMSAA pSceneBinds rpForwardMsaa   pSprite              <- UnlitSprite.allocate pMSAA Nothing False pSceneBinds rpForwardMsaa   pSpriteOutline       <- UnlitSprite.allocate pMSAA Nothing True pSceneBinds rpForwardMsaa   pTileMap             <- UnlitTileMap.allocate pMSAA pSceneBinds rpForwardMsaa@@ -235,7 +238,7 @@   pure Pipelines{..}  allocateWorkers-  :: Tagged Scene DsBindings+  :: Tagged Scene DsLayoutBindings   -> Vk.SampleCountFlagBits   -> RenderPasses   -> ResourceT (StageRIO st) PipelineWorkers@@ -248,7 +251,7 @@         (shaderDir </> "evanw-sdf" <.> "vert" <.> "spv")         (shaderDir </> "evanw-sdf" <.> "frag" <.> "spv") -  evanwSdfWorker <- Region.local . Worker.registered $+  evanwSdfWorker <-     External.spawnReflect "evanw-sdf" evanwSdfFiles \(stageCode, reflect) ->       (EvanwSdf.config sceneBinds)         { Graphics.cStages = stageCode@@ -261,7 +264,7 @@         (shaderDir </> "skybox" <.> "vert" <.> "spv")         (shaderDir </> "skybox" <.> "frag" <.> "spv") -  skyboxWorker <- Region.local . Worker.registered $+  skyboxWorker <-     External.spawnReflect "skybox" skyboxFiles \(stageCode, reflect) ->       (Skybox.config sceneBinds)         { Graphics.cStages = stageCode@@ -274,21 +277,21 @@         (shaderDir </> "debug" <.> "vert" <.> "spv")         (shaderDir </> "debug" <.> "frag" <.> "spv") -  debugUVWorker <- Region.local . Worker.registered $+  debugUVWorker <-     External.spawnReflect "debug-uv" debugFiles \(stageCode, reflect) ->       (Debug.config Debug.UV sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  debugTextureWorker <- Region.local . Worker.registered $+  debugTextureWorker <-     External.spawnReflect "debug-texture" debugFiles \(stageCode, reflect) ->       (Debug.config Debug.Texture sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  debugShadowWorker <- Region.local . Worker.registered $+  debugShadowWorker <-     External.spawnReflect "debug-shadow" debugFiles \(stageCode, reflect) ->       (Debug.config (Debug.Shadow 1) sceneBinds)         { Graphics.cStages = stageCode@@ -299,7 +302,7 @@     depthOnlyFiles = Graphics.vertexOnly       (shaderDir </> "depth-only" <.> "vert" <.> "spv") -  depthOnlyWorker <- Region.local . Worker.registered $+  depthOnlyWorker <-     External.spawnReflect "debug" depthOnlyFiles \(stageCode, reflect) ->       (DepthOnly.config sceneBinds)         { Graphics.cStages = stageCode@@ -312,14 +315,14 @@         (shaderDir </> "lit-colored" <.> "vert" <.> "spv")         (shaderDir </> "lit-colored" <.> "frag" <.> "spv") -  litColoredWorker <- Region.local . Worker.registered $+  litColoredWorker <-     External.spawnReflect "lit-colored" litColoredFiles \(stageCode, reflect) ->       (LitColored.config sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  litColoredBlendWorker <- Region.local . Worker.registered $+  litColoredBlendWorker <-     External.spawnReflect "lit-colored-blend" litColoredFiles \(stageCode, reflect) ->       (LitColored.configBlend sceneBinds)         { Graphics.cStages = stageCode@@ -332,14 +335,14 @@         (shaderDir </> "lit-material" <.> "vert" <.> "spv")         (shaderDir </> "lit-material" <.> "frag" <.> "spv") -  litMaterialWorker <- Region.local . Worker.registered $+  litMaterialWorker <-     External.spawnReflect "lit-material" litMaterialFiles \(stageCode, reflect) ->       (LitMaterial.config sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  litMaterialBlendWorker <- Region.local . Worker.registered $+  litMaterialBlendWorker <-     External.spawnReflect "lit-material-blend" litMaterialFiles \(stageCode, reflect) ->       (LitMaterial.configBlend sceneBinds)         { Graphics.cStages = stageCode@@ -352,14 +355,14 @@         (shaderDir </> "lit-textured" <.> "vert" <.> "spv")         (shaderDir </> "lit-textured" <.> "frag" <.> "spv") -  litTexturedWorker <- Region.local . Worker.registered $+  litTexturedWorker <-     External.spawnReflect "lit-textured" litTexturedFiles \(stageCode, reflect) ->       (LitTextured.config sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  litTexturedBlendWorker <- Region.local . Worker.registered $+  litTexturedBlendWorker <-     External.spawnReflect "lit-textured-blend" litTexturedFiles \(stageCode, reflect) ->       (LitTextured.configBlend sceneBinds)         { Graphics.cStages = stageCode@@ -367,19 +370,39 @@         }    let+    line2dFiles =+      Graphics.basicStages+        (shaderDir </> "line-2d" <.> "vert" <.> "spv")+        (shaderDir </> "line-2d" <.> "frag" <.> "spv")++  line2dWorker <-+    External.spawnReflect "unlit-colored" line2dFiles \(stageCode, reflect) ->+      (UnlitLine2d.config True sceneBinds)+        { Graphics.cStages = stageCode+        , Graphics.cReflect = Just reflect+        }++  line2dNoDepthWorker <-+    External.spawnReflect "unlit-colored-nodepth" line2dFiles \(stageCode, reflect) ->+      (UnlitLine2d.config False sceneBinds)+        { Graphics.cStages = stageCode+        , Graphics.cReflect = Just reflect+        }++  let     unlitColoredFiles =       Graphics.basicStages         (shaderDir </> "unlit-colored" <.> "vert" <.> "spv")         (shaderDir </> "unlit-colored" <.> "frag" <.> "spv") -  unlitColoredWorker <- Region.local . Worker.registered $+  unlitColoredWorker <-     External.spawnReflect "unlit-colored" unlitColoredFiles \(stageCode, reflect) ->       (UnlitColored.config True sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  unlitColoredNoDepthWorker <- Region.local . Worker.registered $+  unlitColoredNoDepthWorker <-     External.spawnReflect "unlit-colored-nodepth" unlitColoredFiles \(stageCode, reflect) ->       (UnlitColored.config False sceneBinds)         { Graphics.cStages = stageCode@@ -392,14 +415,14 @@         (shaderDir </> "unlit-textured" <.> "vert" <.> "spv")         (shaderDir </> "unlit-textured" <.> "frag" <.> "spv") -  unlitTexturedWorker <- Region.local . Worker.registered $+  unlitTexturedWorker <-     External.spawnReflect "unlit-textured" unlitTexturedFiles \(stageCode, reflect) ->       (UnlitTextured.config sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  unlitTexturedBlendWorker <- Region.local . Worker.registered $+  unlitTexturedBlendWorker <-     External.spawnReflect "unlit-textured" unlitTexturedFiles \(stageCode, reflect) ->       (UnlitTextured.configBlend sceneBinds)         { Graphics.cStages = stageCode@@ -412,14 +435,14 @@         (shaderDir </> "sprite" <.> "vert" <.> "spv")         (shaderDir </> "sprite" <.> "frag" <.> "spv") -  spriteWorker <- Region.local . Worker.registered $+  spriteWorker <-     External.spawnReflect "sprite" spriteFiles \(stageCode, reflect) ->       (UnlitSprite.config Nothing False sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  spriteOutlineWorker <- Region.local . Worker.registered $+  spriteOutlineWorker <-     External.spawnReflect "sprite" spriteFiles \(stageCode, reflect) ->       (UnlitSprite.config Nothing True sceneBinds)         { Graphics.cStages = stageCode@@ -432,28 +455,28 @@         (shaderDir </> "tilemap" <.> "vert" <.> "spv")         (shaderDir </> "tilemap" <.> "frag" <.> "spv") -  tileMapWorker <- Region.local . Worker.registered $+  tileMapWorker <-     External.spawnReflect "tilemap" tileMapFiles \(stageCode, reflect) ->       (UnlitTileMap.config sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  tileMapBlendWorker <- Region.local . Worker.registered $+  tileMapBlendWorker <-     External.spawnReflect "tilemap" tileMapFiles \(stageCode, reflect) ->       (UnlitTileMap.configBlend sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  wireframeWorker <- Region.local . Worker.registered $+  wireframeWorker <-     External.spawnReflect "wireframe" unlitColoredFiles \(stageCode, reflect) ->       (UnlitColored.configWireframe True sceneBinds)         { Graphics.cStages = stageCode         , Graphics.cReflect = Just reflect         } -  wireframeNoDepthWorker <- Region.local . Worker.registered $+  wireframeNoDepthWorker <-     External.spawnReflect "wireframe-nodepth" unlitColoredFiles \(stageCode, reflect) ->       (UnlitColored.configWireframe False sceneBinds)         { Graphics.cStages = stageCode@@ -465,7 +488,7 @@       Graphics.vertexOnly         (shaderDir </> "shadow-cast" <.> "vert" <.> "spv") -  shadowCastWorker <- Region.local . Worker.registered $+  shadowCastWorker <-     External.spawnReflect "shadow-cast" shadowCastFiles \(stageCode, reflect) ->       (ShadowPipe.config (pShadowBinds builtin) ShadowPipe.defaults)         { Graphics.cStages = stageCode@@ -485,6 +508,8 @@     , pLitMaterialBlend = litMaterialBlendWorker     , pLitTextured = litTexturedWorker     , pLitTexturedBlend = litTexturedBlendWorker+    , pLine2d = line2dWorker+    , pLine2dNoDepth = line2dNoDepthWorker     , pUnlitColored = unlitColoredWorker     , pUnlitColoredNoDepth = unlitColoredNoDepthWorker     , pUnlitTextured = unlitTexturedWorker@@ -563,6 +588,16 @@     pMSAA     pLitTexturedBlend +  line2dExt <- External.newObserverGraphics+    forward+    pMSAA+    pLine2d++  line2dNoDepthExt <- External.newObserverGraphics+    forward+    pMSAA+    pLine2dNoDepth+   unlitColoredExt <- External.newObserverGraphics     forward     pMSAA@@ -631,6 +666,8 @@     , pLitMaterialBlend = litMaterialBlendExt     , pLitTextured = litTexturedExt     , pLitTexturedBlend = litTexturedBlendExt+    , pLine2d = line2dExt+    , pLine2dNoDepth = line2dNoDepthExt     , pUnlitColored = unlitColoredExt     , pUnlitColoredNoDepth = unlitColoredNoDepthExt     , pUnlitTextured = unlitTexturedExt@@ -734,6 +771,7 @@   , ("lit-textured", LitTextured.stageCode)   , ("unlit-colored", UnlitColored.stageCode)   , ("unlit-textured", UnlitTextured.stageCode)+  , ("line-2d", UnlitLine2d.stageCode)   , ("sprite", UnlitSprite.stageCode)   , ("tilemap", UnlitTileMap.stageCode)   , ("shadow-cast", ShadowPipe.stageCode)

@@ -177,22 +177,32 @@       ).rgb;     } +    // BUG: raw NdotV is sometimes negative, like we're looking at the back side.+    // Cubists would appreciate, but IBL term gives that edge and the dot artifacts.+    float NdotV = clamp(dot(normal, rayDir), 0.0, 1.0);+     // Specular reflectance     vec2 ibl = texture(       sampler2D(         textures[BRDF_LUT],         samplers[BRDF_LUT_SAMPLER]       ),-      vec2(roughness, max(dot(normal, rayDir), 0.0))+      vec2(NdotV, roughness),+      0.0     ).rg;-    vec3 F = F_SchlickR(max(dot(normal, rayDir), 0.0), F0, roughness);-    vec3 specular = nonOcclusion * reflection * (F * ibl.x + ibl.y); -    vec3 kD = (1.0 - F) * (1.0 - metallic);+    // Single scattering+    vec3 F = F_SchlickR(NdotV, F0, roughness);+    vec3 FssEss = F * ibl.x + ibl.y;+    vec3 specular = nonOcclusion * reflection * FssEss; -    // Diffuse based on irradiance-    vec3 diffuseI = nonOcclusion * irradiance * albedo;-    vec3 ambient = kD * diffuseI + specular;+    // Multiple scattering+    float Ems = 1.0 - (ibl.x + ibl.y);+    vec3 F_avg = F0 + (1.0 - F0) / 21.0;+    vec3 FmsEms = Ems * FssEss * F_avg / (1.0 - F_avg * Ems);++    vec3 kD = albedo * (1.0 - FssEss - FmsEms);+    vec3 ambient = specular + (FmsEms + kD) * irradiance;      // Combine with ambient     vec3 color = Lo + ambient;

@@ -62,8 +62,8 @@      layout(location = 0) out vec4 oColor; -    layout (constant_id=0) const uint mode = 0;-    layout (constant_id=1) const uint shadow_mask = 0;+    layout(constant_id=0) const uint mode = 0;+    layout(constant_id=1) const uint shadow_mask = 0;      void main() {       vec4 texel = vec4(0);

@@ -1,218 +1,106 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedRecordDot #-}++{- XXX: Copy-pasta from Unlit.Textured.Model.++Attept with newtypes ended up too disruptive.+Perhaps a better solution would be adding unique tag parameter to Pipeline type.+-}+ module Render.Debug.Model   ( Model+  , Vertex   , VertexAttrs-  , vkVertexAttrs -  , InstanceAttrs(..)-  , instanceAttrs--  , StorableAttrs-  , storableAttrs1+  , AttrsF(..)+  , Attrs+  , attrs -  , InstanceBuffers(..)+  , Stores+  , stores1+  , Buffers    , TextureParams(..)-  , vkInstanceTexture -    -- TODO: extract and merge with UnlitTextured-  , allocateInstancesWith-  , allocateInstancesCoherent-  , allocateInstancesCoherent_-  , updateCoherentResize_-  , Transform+  , ObserverCoherent   ) where  import RIO --import Foreign (Storable(..))-import Geomancy (Transform, Vec2, Vec4)+import Foreign.Storable.Generic (GStorable)+import Geomancy (Transform, Vec2) import Geomancy.Vec3 qualified as Vec3 import RIO.Vector.Storable qualified as Storable-import UnliftIO.Resource (MonadResource, ReleaseKey, ResourceT, allocate)-import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::)) import Vulkan.Zero (Zero(..)) -import Engine.Vulkan.Types (HasVulkan)+import Engine.Types (HKD)+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)+import Engine.Worker qualified as Worker+import Render.Unlit.Textured.Model (TextureParams(..)) import Resource.Buffer qualified as Buffer import Resource.Model qualified as Model+import Resource.Model.Observer qualified as Observer  type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  type VertexAttrs = "uv" ::: Vec2 -vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32_SFLOAT -- vTexCoord :: vec2-  ]---- | Data for a single element.-data InstanceAttrs = InstanceAttrs-  { textureParams :: TextureParams-  , transformMat4 :: Transform-  }--instance Zero InstanceAttrs where-  zero = InstanceAttrs-    { textureParams = zero-    , transformMat4 = mempty-    }--instanceAttrs :: Int32 -> Int32 -> [Transform] -> InstanceAttrs-instanceAttrs samplerId textureId transforms = InstanceAttrs-  { textureParams = zero-      { tpSamplerId = samplerId-      , tpTextureId = textureId-      }-  , transformMat4 = mconcat transforms+data AttrsF f = Attrs+  { params     :: HKD f TextureParams+  , transforms :: HKD f Transform   }---- | Intermediate data to be shipped.-type StorableAttrs =-  ( Storable.Vector TextureParams-  , Storable.Vector Transform-  )+  deriving (Generic) -storableAttrs1 :: Int32 -> Int32 -> [Transform] -> StorableAttrs-storableAttrs1 samplerId textureId transforms =-  ( Storable.singleton textureParams-  , Storable.singleton transformMat4-  )-  where-    InstanceAttrs{..} = instanceAttrs-      samplerId-      textureId-      transforms+type Attrs = AttrsF Identity+deriving instance Show Attrs+instance GStorable Attrs --- | GPU-bound data.-data InstanceBuffers textureStage transformStage = InstanceBuffers-  { ibTexture   :: InstanceTexture textureStage-  , ibTransform :: InstanceTransform transformStage-  }+instance HasVertexInputBindings Attrs where+  vertexInputBindings =+    [ instanceFormat @TextureParams+    , instanceFormat @Transform+    ] -type InstanceTexture stage = Buffer.Allocated stage TextureParams+type Stores = AttrsF Storable.Vector+deriving instance Show Stores -type InstanceTransform stage = Buffer.Allocated stage Transform+type Buffers = AttrsF (Buffer.Allocated 'Buffer.Coherent)+deriving instance Show Buffers+instance Observer.VertexBuffers Buffers+type ObserverCoherent = Worker.ObserverIO Buffers -instance Model.HasVertexBuffers (InstanceBuffers textureStage transformStage) where-  type VertexBuffersOf (InstanceBuffers textureStage transformStage) = InstanceAttrs+instance Observer.UpdateCoherent Buffers Stores -  {-# INLINE getVertexBuffers #-}-  getVertexBuffers InstanceBuffers{..} =-    [ Buffer.aBuffer ibTexture-    , Buffer.aBuffer ibTransform-    ]+instance Model.HasVertexBuffers Buffers where+  type VertexBuffersOf Buffers = Attrs -  {-# INLINE getInstanceCount #-}-  getInstanceCount InstanceBuffers{..} =-    min-      (Buffer.aUsed ibTexture)-      (Buffer.aUsed ibTransform)+instance Zero Attrs where+  zero = Attrs+    { params = zero+    , transforms = mempty+    } -data TextureParams = TextureParams-  { tpScale     :: Vec2-  , tpOffset    :: Vec2-  , tpGamma     :: Vec4-  , tpSamplerId :: Int32-  , tpTextureId :: Int32+attrs :: Int32 -> Int32 -> [Transform] -> Attrs+attrs samplerId textureId transforms = Attrs+  { params = zero+      { tpSamplerId = samplerId+      , tpTextureId = textureId+      }+  , transforms = mconcat transforms   }-  deriving (Show) -instance Zero TextureParams where-  zero = TextureParams-    { tpScale     = 1-    , tpOffset    = 0-    , tpGamma     = 1.0-    , tpSamplerId = minBound-    , tpTextureId = minBound+stores1 :: Int32 -> Int32 -> [Transform] -> Stores+stores1 samplerId textureId transforms =+  Attrs+    { params = Storable.singleton attrs1.params+    , transforms = Storable.singleton attrs1.transforms     }--instance Storable TextureParams where-  alignment ~_ = 4--  sizeOf ~_ = 8 + 8 + 16 + 4 + 4--  poke ptr TextureParams{..} = do-    pokeByteOff ptr  0 tpScale-    pokeByteOff ptr  8 tpOffset-    pokeByteOff ptr 16 tpGamma-    pokeByteOff ptr 32 tpSamplerId-    pokeByteOff ptr 36 tpTextureId--  peek ptr = do-    tpScale     <- peekByteOff ptr  0-    tpOffset    <- peekByteOff ptr  8-    tpGamma     <- peekByteOff ptr 16-    tpSamplerId <- peekByteOff ptr 32-    tpTextureId <- peekByteOff ptr 36-    pure TextureParams{..}--vkInstanceTexture :: [Vk.Format]-vkInstanceTexture =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4-  , Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2-  ]--allocateInstancesWith-  :: ( MonadResource m-     , MonadUnliftIO m-     )-  => (Vk.BufferUsageFlagBits -> Int -> Storable.Vector TextureParams -> m (InstanceTexture texture))-  -> (Vk.BufferUsageFlagBits -> Int -> Storable.Vector Transform -> m (InstanceTransform transform))-  -> (forall stage a . Buffer.Allocated stage a -> m ())-  -> [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers texture transform)-allocateInstancesWith createTextures createTransforms bufferDestroy instances = do-  ul <- askUnliftIO-  allocate (create ul) (destroy ul)   where-    textures   = Storable.fromList $ map textureParams instances-    transforms = Storable.fromList $ map transformMat4 instances-    numInstances = Storable.length textures--    create (UnliftIO ul) = ul do-      ibTexture   <- createTextures   Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances textures-      ibTransform <- createTransforms Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances transforms-      pure InstanceBuffers{..}--    destroy (UnliftIO ul) InstanceBuffers{..} = ul do-      bufferDestroy ibTexture-      bufferDestroy ibTransform--allocateInstancesCoherent-  :: ( MonadReader env m-     , HasVulkan env-     , MonadResource m-     , MonadUnliftIO m-     )-  => [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent instances = do-  context <- ask-  allocateInstancesWith-    (Buffer.createCoherent context)-    (Buffer.createCoherent context)-    (Buffer.destroy context)-    instances--allocateInstancesCoherent_-  :: (HasVulkan env)-  => Int-  -> ResourceT (RIO env) (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent_ n =-  fmap snd $ allocateInstancesCoherent (replicate n zero)--updateCoherentResize_-  :: ( HasVulkan context-     , MonadUnliftIO m-     )-  => context-  -> InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent-  -> (Storable.Vector TextureParams, Storable.Vector Transform)-  -> m (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-updateCoherentResize_ context InstanceBuffers{..} (textures, transforms) =-  InstanceBuffers-    <$> Buffer.updateCoherentResize_ context ibTexture textures-    <*> Buffer.updateCoherentResize_ context ibTransform transforms+    attrs1 = attrs+      samplerId+      textureId+      transforms

@@ -16,13 +16,13 @@  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics import Engine.Vulkan.Shader qualified as Shader-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag) import Render.Debug.Code qualified as Code import Render.Debug.Model qualified as Model-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.Attrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = Mode @@ -47,26 +47,19 @@      )   => Mode   -> Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate mode multisample tset0 = do   fmap snd . Graphics.allocate Nothing multisample (config mode tset0) -config :: Mode -> Tagged Scene DsBindings -> Config+config :: Mode -> Tagged Scene DsLayoutBindings -> Config config mode (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts    = Tagged @'[Scene] [set0]   , Graphics.cStages         = stageSpirv-  , Graphics.cVertexInput    = vertexInput+  , Graphics.cVertexInput    = Graphics.vertexInput @Pipeline   , Graphics.cSpecialization = mode   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos -- vPosition-      , (Vk.VERTEX_INPUT_RATE_VERTEX,   Model.vkVertexAttrs)-      , (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceTexture)-      , instanceTransform-      ]  stageCode :: Graphics.StageCode stageCode = Graphics.basicStages Code.vert Code.frag

@@ -15,14 +15,15 @@ import Data.Tagged (Tagged(..)) import Vulkan.Core10 qualified as Vk -import Geomancy (Transform) import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..))+import Geomancy (Transform) import Render.Code (compileVert) import Render.DepthOnly.Code qualified as Code-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene)+import Resource.Model (Vertex3d) -type Pipeline = Graphics.Pipeline '[Scene] () Transform+type Pipeline = Graphics.Pipeline '[Scene] (Vertex3d ()) Transform type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -31,7 +32,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -42,17 +43,12 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos-      , instanceTransform-      ]  stageCode  :: Graphics.StageCode stageCode = Graphics.vertexOnly Code.vert

@@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-} +{-# LANGUAGE OverloadedLists #-}+ module Render.DescSets.Set0   ( Scene(..)   , emptyScene@@ -11,10 +13,6 @@    , mkBindings -  -- TODO: extract to typeclass magic-  , vertexPos-  , instanceTransform-   , FrameResource(..)   , extendResourceDS @@ -30,7 +28,6 @@ import Control.Monad.Trans.Resource (ResourceT) import Control.Monad.Trans.Resource qualified as ResourceT import Data.Bits ((.|.))-import Data.ByteString.Char8 qualified as BS8 import Data.Kind (Type) import Data.Tagged (Tagged(..)) import Data.Vector qualified as Vector@@ -42,13 +39,12 @@ import Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing qualified as Vk12 import Vulkan.CStruct.Extends (SomeStruct(..)) import Vulkan.NamedType ((:::))-import Vulkan.Utils.Debug qualified as Debug import Vulkan.Zero (Zero(..))  import Engine.Vulkan.DescSets (Bound, Extend, extendDS, withBoundDescriptorSets0) import Engine.Vulkan.Pipeline (Pipeline) import Engine.Vulkan.Pipeline qualified as Pipeline-import Engine.Vulkan.Types (DsBindings, MonadVulkan, HasVulkan(..))+import Engine.Vulkan.Types (DsLayoutBindings, MonadVulkan, HasVulkan(..)) import Engine.Worker qualified as Worker import Global.Resource.CubeMap.Base qualified as BaseCubeMap import Global.Resource.Texture.Base qualified as BaseTexture@@ -56,9 +52,11 @@ 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.Region qualified as Region import Resource.Texture qualified as Texture+import Resource.Vulkan.DescriptorPool qualified as DescriptorPool+import Resource.Vulkan.Named qualified as Named  -- * Set0 data @@ -109,7 +107,7 @@   -> textures a   -> cubemaps b   -> Word32-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings mkBindings samplers textures cubes shadows = Tagged   [ (set0bind0,          zero)   , (set0bind1 samplers, zero)@@ -219,29 +217,13 @@   , immutableSamplers = mempty   } -vertexPos :: (Vk.VertexInputRate, [Vk.Format])-vertexPos =-  ( Vk.VERTEX_INPUT_RATE_VERTEX-  , [ Vk.FORMAT_R32G32B32_SFLOAT -- vPosition :: vec3-    ]-  )--instanceTransform :: (Vk.VertexInputRate, [Vk.Format])-instanceTransform =-  ( Vk.VERTEX_INPUT_RATE_INSTANCE-  , [ Vk.FORMAT_R32G32B32A32_SFLOAT -- iModel :: mat4-    , Vk.FORMAT_R32G32B32A32_SFLOAT-    , Vk.FORMAT_R32G32B32A32_SFLOAT-    , Vk.FORMAT_R32G32B32A32_SFLOAT-    ]-  )- -- * Setup  allocate   :: ( Traversable textures      , Traversable cubes      , MonadVulkan env m+     , ResourceT.MonadResource m      )   => Tagged '[Scene] Vk.DescriptorSetLayout   -> textures (Texture.Texture Texture.Flat)@@ -251,21 +233,17 @@   -> Maybe (Buffer.Allocated 'Buffer.Coherent Material)   -> ResourceT m (FrameResource '[Scene]) allocate (Tagged set0layout) textures cubes lightsData shadowViews materialsData = do-  context <- asks id--  (_dpKey, descPool) <- DescriptorSet.allocatePool 1 dpSizes+  descPool <- Region.local $+    DescriptorPool.allocate (Just "Basic") 1 dpSizes -  let-    set0dsCI = zero-      { Vk.descriptorPool = descPool-      , Vk.setLayouts     = Vector.singleton set0layout-      }-  descSets <- fmap (Tagged @'[Scene]) $-    Vk.allocateDescriptorSets (getDevice context) set0dsCI+  descSets <- DescriptorPool.allocateSetsFrom descPool (Just "Basic") [set0layout] -  (_, sceneData) <- ResourceT.allocate-    (Buffer.createCoherent context Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT 1 $ VectorS.singleton emptyScene)-    (Buffer.destroy context)+  sceneData <- Region.local $+    Buffer.allocateCoherent+    (Just "Basic.Data")+    Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT+    1+    [emptyScene]    let     -- TODO: must be checked against depth format and TILING_OPTIMAL@@ -285,18 +263,33 @@    let ifor = flip Vector.imapM   shadowMaps <- ifor shadowViews \ix depthView -> do-    (_, shadowSampler) <- Vk.withSampler (getDevice context) shadowCI Nothing ResourceT.allocate-    Debug.nameObject (getDevice context) shadowSampler $-      "ShadowSampler." <> BS8.pack (show ix)+    shadowSampler <- Region.local do+      device <- asks getDevice+      Vk.withSampler device shadowCI Nothing ResourceT.allocate+    Named.object shadowSampler $+      "Basic.ShadowSampler." <> fromString (show ix)     pure (shadowSampler, depthView) -  updateSet0Ds context descSets sceneData textures cubes lightsData shadowMaps materialsData+  context <- ask+  updateSet0Ds+    context+    (Tagged descSets)+    sceneData+    textures+    cubes+    lightsData+    shadowMaps+    materialsData -  scene <- Worker.newObserverIO emptyScene+  observer <- Worker.newObserverIO emptyScene -  pure $ FrameResource descSets sceneData scene+  pure FrameResource+    { frDescSets = Tagged descSets+    , frBuffer = sceneData+    , frObserver = observer+    } -dpSizes :: DescriptorSet.TypeMap Word32+dpSizes :: [(Vk.DescriptorType, Word32)] dpSizes =   [ ( Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER     , uniformBuffers@@ -319,11 +312,13 @@  -- | Minimal viable 'Scene' without textures and lighting. allocateEmpty-  :: MonadVulkan env m+  :: ( MonadVulkan env m+     , ResourceT.MonadResource m+     )   => Tagged '[Scene] Vk.DescriptorSetLayout   -> ResourceT m (FrameResource '[Scene]) allocateEmpty taggedLayout =-  allocate taggedLayout [] [] Nothing mempty Nothing+  allocate taggedLayout Nothing Nothing Nothing mempty Nothing  updateSet0Ds   :: ( HasVulkan context@@ -459,7 +454,7 @@               , Vk.range  = Vk.WHOLE_SIZE               } -    writeSets = Vector.fromList $ concat+    writeSets = Vector.concat       [ pure writeSet0b0       -- XXX: binding 1 is immutable samplers, baked into layout.       , skipEmpty linearTextures writeSet0b2

@@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-} +{-# LANGUAGE OverloadedLists #-}+ module Render.DescSets.Sun   ( Sun(..)   , createSet0Ds@@ -23,8 +25,7 @@  import RIO -import Control.Monad.Trans.Resource (ResourceT)-import Control.Monad.Trans.Resource qualified as ResourceT+import Control.Monad.Trans.Resource (MonadResource, ResourceT) import Data.Tagged (Tagged(..)) import Data.Vector qualified as Vector import Data.Vector.Storable qualified as VectorS@@ -36,16 +37,16 @@ import Vulkan.Core10 qualified as Vk import Vulkan.CStruct.Extends (SomeStruct(..)) import Vulkan.NamedType ((:::))-import Vulkan.Utils.Debug qualified as Debug import Vulkan.Zero (Zero(..))  import Engine.Camera qualified as Camera import Engine.Types (StageRIO) import Engine.Vulkan.DescSets ()-import Engine.Vulkan.Types (DsBindings, HasVulkan(..))+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan(..)) import Engine.Worker qualified as Worker import Resource.Buffer qualified as Buffer-import Resource.DescriptorSet qualified as DescriptorSet+import Resource.Region qualified as Region+import Resource.Vulkan.DescriptorPool qualified as DescriptorPool  -- * Set0 data for light projection @@ -76,7 +77,7 @@ -- * Shadow casting descriptor set  set0-  :: Tagged Sun DsBindings+  :: Tagged Sun DsLayoutBindings set0 = Tagged   [ (set0bind0, zero)   ]@@ -101,55 +102,24 @@       , Buffer       ) createSet0Ds (Tagged set0layout) = do-  context <- asks id--  (_dpKey, descPool) <- DescriptorSet.allocatePool 1 dpSizes--  let-    set0dsCI = zero-      { Vk.descriptorPool = descPool-      , Vk.setLayouts     = Vector.singleton set0layout-      }-  descSets <- fmap (Tagged @'[Sun]) $-    Vk.allocateDescriptorSets (getDevice context) set0dsCI--  let-    initialSuns = VectorS.replicate MAX_VIEWS zero-  (_, sunData) <- ResourceT.allocate-    (Buffer.createCoherent context Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT MAX_VIEWS initialSuns)-    (Buffer.destroyAll context . Just)+  descPool <- Region.local $+    DescriptorPool.allocate (Just "Basic.Sun") 1+      [ ( Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER+        , 1 + 1+        )+      ] -  updateSet0Ds descSets sunData+  descSets <- DescriptorPool.allocateSetsFrom descPool (Just "Basic.Sun") [set0layout] -  let device = getDevice context-  Debug.nameObject device descPool "Sun.Pool"-  for_ (unTagged descSets) \ds ->-    Debug.nameObject device ds "Sun.DS"-  Debug.nameObject device (Buffer.aBuffer sunData) "Sun.Data"+  sunData <- Region.local $+    Buffer.allocateCoherent+      (Just "Basic.Sun.Data")+      Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT MAX_VIEWS+      (VectorS.replicate MAX_VIEWS zero) -  pure (descSets, sunData)+  updateSet0Ds (Tagged descSets) sunData -dpSizes :: DescriptorSet.TypeMap Word32-dpSizes =-  [ ( Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER-    , uniformBuffers-    )-  -- XXX: may be required to fetch textures for shadows from texture-masked models-  -- , ( Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE-  --   , sampledImages-  --   )-  -- , ( Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER-  --   , sampledImages + shadowMaps-  --   )-  -- , ( Vk.DESCRIPTOR_TYPE_SAMPLER-  --   , staticSamplers-  --   )-  ]-  where-    uniformBuffers = 2    -- 1 scene + 1 light array-    -- sampledImages  = 128  -- max dynamic textures and cubemaps-    -- staticSamplers = 8    -- immutable samplers-    -- shadowMaps     = 2    -- max shadowmaps+  pure (Tagged descSets, sunData)  updateSet0Ds   :: Tagged '[Sun] (Vector Vk.DescriptorSet)@@ -157,7 +127,7 @@   -> ResourceT (StageRIO st) () updateSet0Ds (Tagged ds) Buffer.Allocated{aBuffer} = do   context <- asks id-  Vk.updateDescriptorSets (getDevice context) writeSets mempty+  Vk.updateDescriptorSets (getDevice context) [writeSet0b0] mempty    where     destSet0 = case Vector.headM ds of@@ -172,7 +142,7 @@       , Vk.dstArrayElement = 0       , Vk.descriptorCount = 1       , Vk.descriptorType  = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER-      , Vk.bufferInfo      = Vector.singleton set0bind0I+      , Vk.bufferInfo      = [set0bind0I]       }       where         set0bind0I = Vk.DescriptorBufferInfo@@ -181,9 +151,6 @@           , Vk.range  = Vk.WHOLE_SIZE           } -    writeSets =-      Vector.singleton writeSet0b0- data SunInput = SunInput   { siColor :: Vec4 @@ -213,7 +180,12 @@  type Process = Worker.Cell SunInput ("bounding box" ::: Transform, Sun) -spawn1 :: MonadUnliftIO m => SunInput -> m Process+spawn1+  :: ( MonadResource m+     , MonadUnliftIO m+     )+  => SunInput+  -> m Process spawn1 = Worker.spawnCell mkSun  mkSun :: SunInput -> ("bounding box" ::: Transform, Sun)

@@ -1,25 +1,19 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE DeriveAnyClass #-}+ module Render.Font.EvanwSdf.Model-  ( Model-  , VertexAttrs-  , InstanceAttrs(..)-  , vkInstanceAttrs-  , InstanceBuffer+  ( InstanceAttrs(..)   ) where  import RIO -import Foreign (Storable(..))-import Geomancy (Vec2, Vec4)-import Geomancy.Vec3 qualified as Vec3+import Foreign.Storable.Generic (GStorable)+import Geomancy (Vec4) import Vulkan.Core10 qualified as Vk-import Vulkan.NamedType ((:::)) -import Resource.Buffer qualified as Buffer-import Resource.Model qualified as Model--type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs--type VertexAttrs = "uv" ::: Vec2+import Engine.Vulkan.Format (HasVkFormat(..))+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)  data InstanceAttrs = InstanceAttrs   { vertRect     :: Vec4@@ -33,43 +27,21 @@   , smoothing    :: Float   , outlineWidth :: Float   }-  deriving (Eq, Show)--vkInstanceAttrs :: [Vk.Format]-vkInstanceAttrs =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- Quad scale+offset-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- UV scale+offset-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- Color-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline color--  , Vk.FORMAT_R32G32_SINT         -- Sampler + texture IDs--  , Vk.FORMAT_R32G32_SFLOAT       -- Smoothing + outline width-  ]+  deriving (Eq, Show, Generic) -instance Storable InstanceAttrs where-  alignment ~_ = 4-  sizeOf ~_ = 16 + 16 + 16 + 16 + 4 + 4 + 4 + 4+-- XXX: Fine, the layout matches+instance GStorable InstanceAttrs -  peek ptr = do-    vertRect     <- peekByteOff ptr  0 -- +16-    fragRect     <- peekByteOff ptr 16 -- +16-    color        <- peekByteOff ptr 32 -- +16-    outlineColor <- peekByteOff ptr 48 -- +16-    samplerId    <- peekByteOff ptr 64 -- +4-    textureId    <- peekByteOff ptr 68 -- +4-    smoothing    <- peekByteOff ptr 72 -- +4-    outlineWidth <- peekByteOff ptr 76 -- +4-    pure InstanceAttrs{..}+instance HasVkFormat InstanceAttrs where+  getVkFormat =+    [ Vk.FORMAT_R32G32B32A32_SFLOAT -- Quad scale+offset+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- UV scale+offset+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- Color+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline color -  poke ptr InstanceAttrs{..} = do-    pokeByteOff ptr  0 vertRect-    pokeByteOff ptr 16 fragRect-    pokeByteOff ptr 32 color-    pokeByteOff ptr 48 outlineColor-    pokeByteOff ptr 64 samplerId-    pokeByteOff ptr 68 textureId-    pokeByteOff ptr 72 smoothing-    pokeByteOff ptr 76 outlineWidth+    , Vk.FORMAT_R32G32_SINT         -- Sampler + texture IDs+    , Vk.FORMAT_R32G32_SFLOAT       -- Smoothing + outline width+    ] -type InstanceBuffer stage = Buffer.Allocated stage InstanceAttrs+instance HasVertexInputBindings InstanceAttrs where+  vertexInputBindings = [instanceFormat @InstanceAttrs]

@@ -16,7 +16,7 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag) import Render.DescSets.Set0 (Scene) import Render.Font.EvanwSdf.Code qualified as Code@@ -31,7 +31,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 = do@@ -40,20 +40,16 @@     multisample     (config tset0) -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts = Tagged @'[Scene] [set0]   , Graphics.cStages      = stageSpirv-  , Graphics.cVertexInput = vertexInput+  , Graphics.cVertexInput = Graphics.vertexInput @Pipeline   , Graphics.cDepthTest   = False   , Graphics.cDepthWrite  = False   , Graphics.cBlend       = True   , Graphics.cCull        = Vk.CULL_MODE_NONE   }-  where-    vertexInput = Graphics.vertexInput-      [ (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceAttrs)-      ]  stageCode :: Graphics.StageCode stageCode = Graphics.basicStages Code.vert Code.frag

@@ -11,14 +11,16 @@ import Data.Bits ((.|.)) import Data.Vector qualified as Vector import Vulkan.Core10 qualified as Vk-import Vulkan.Utils.Debug qualified as Debug import Vulkan.Zero (zero) -import Engine.Types.RefCounted (RefCounted, newRefCounted, releaseRefCounted, resourceTRefCount)+import Engine.Types.RefCounted (RefCounted, releaseRefCounted, resourceTRefCount)+import Engine.Types.RefCounted qualified as RefCounted import Engine.Vulkan.Types (HasVulkan(..), HasSwapchain(..), HasRenderPass(..), RenderPass(..), MonadVulkan) import Render.Pass (usePass) import Resource.Image (AllocatedImage) import Resource.Image qualified as Image+import Resource.Region qualified as Region+import Resource.Vulkan.Named qualified as Named  -- * Simple MSAA-enabled pass @@ -51,10 +53,15 @@   => swapchain   -> m ForwardMsaa allocateMsaa swapchain = do-  logDebug "Allocating ForwardMsaa resources"   (_rpKey, renderPass) <- allocateRenderPassMsaa swapchain-  (refcounted, color, depth, framebuffers) <- allocateFramebufferMsaa swapchain renderPass +  (release, resources) <- RefCounted.wrapped $ Region.run do+    Region.logDebug+      "Allocating ForwardMsaa resources"+      "Releasing ForwardMsaa resources"+    allocateFramebufferMsaa swapchain renderPass+  let (color, depth, framebuffers) = resources+   pure ForwardMsaa     { fmRenderPass   = renderPass     , fmRenderArea   = fullSurface@@ -62,7 +69,7 @@     , fmColor        = color     , fmDepth        = depth     , fmFrameBuffers = framebuffers-    , fmRelease      = refcounted+    , fmRelease      = release     }   where     fullSurface = Vk.Rect2D@@ -87,12 +94,17 @@   -> m ForwardMsaa updateMsaa swapchain old@ForwardMsaa{fmRelease, fmRenderPass} = do   releaseRefCounted fmRelease-  (refcounted, color, depth, framebuffers) <- allocateFramebufferMsaa swapchain fmRenderPass+  (release, resources) <- RefCounted.wrapped $ Region.run do+    Region.logDebug+      "Updating ForwardMsaa resources"+      "Releasing ForwardMsaa resources"+    allocateFramebufferMsaa swapchain fmRenderPass+  let (color, depth, framebuffers) = resources   pure old     { fmColor        = color     , fmDepth        = depth     , fmFrameBuffers = framebuffers-    , fmRelease      = refcounted+    , fmRelease      = release     , fmRenderArea   = fullSurface     }   where@@ -112,40 +124,51 @@   -> m (Resource.ReleaseKey, Vk.RenderPass) allocateRenderPassMsaa swapchain = do   device <- asks getDevice-  let++  res <- Vk.withRenderPass device createInfo Nothing Resource.allocate+  Named.object (snd res) "ForwardMSAA"+  pure res+  where     format = getSurfaceFormat swapchain     depthFormat = getDepthFormat swapchain     msaa = getMultisample swapchain +    onMsaa :: a -> a -> a+    onMsaa none more = case msaa of+      Vk.SAMPLE_COUNT_1_BIT ->+        none+      _mucho ->+        more+     attachments =-      [ color format msaa-      , depth depthFormat msaa-      , colorResolve format-      ]+      color :+      depth :+      onMsaa [] [colorResolve] -  res@(_key, object) <- Vk.withRenderPass device (createInfo attachments) Nothing Resource.allocate-  Debug.nameObject device object "ForwardMSAA"-  pure res-  where-    createInfo attachments = zero+    createInfo = zero       { Vk.attachments  = Vector.fromList attachments       , Vk.subpasses    = Vector.fromList [subpass]       , Vk.dependencies = Vector.fromList [colorDeps, depthDeps]       } -    color format msaa = zero+    -- | Main color-rendering attachment. Used as presentation when MSAA is disabled.+    color = zero       { Vk.format         = format       , Vk.samples        = msaa-      , Vk.finalLayout    = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL+      , Vk.finalLayout    = finalColorLayout       , Vk.loadOp         = Vk.ATTACHMENT_LOAD_OP_CLEAR       , Vk.storeOp        = Vk.ATTACHMENT_STORE_OP_DONT_CARE       , Vk.stencilLoadOp  = Vk.ATTACHMENT_LOAD_OP_DONT_CARE       , Vk.stencilStoreOp = Vk.ATTACHMENT_STORE_OP_DONT_CARE       , Vk.initialLayout  = Vk.IMAGE_LAYOUT_UNDEFINED       }+    finalColorLayout =+      onMsaa+        Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR+        Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL -    depth format msaa = zero-      { Vk.format         = format+    depth = zero+      { Vk.format         = depthFormat       , Vk.samples        = msaa       , Vk.loadOp         = Vk.ATTACHMENT_LOAD_OP_CLEAR       , Vk.storeOp        = Vk.ATTACHMENT_STORE_OP_DONT_CARE@@ -155,7 +178,8 @@       , Vk.finalLayout    = Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL       } -    colorResolve format = zero+    -- | Extra attachment to collect samples AND present.+    colorResolve = zero       { Vk.format      = format       , Vk.samples     = Vk.SAMPLE_COUNT_1_BIT       , Vk.finalLayout = Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR@@ -172,10 +196,12 @@           { Vk.attachment = 1           , Vk.layout     = Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL           }-      , Vk.resolveAttachments = Vector.singleton zero-          { Vk.attachment = 2-          , Vk.layout     = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL-          }+      , Vk.resolveAttachments =+          onMsaa mempty $+            Vector.singleton zero+            { Vk.attachment = 2+            , Vk.layout     = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL+            }       }      colorDeps = zero@@ -217,8 +243,7 @@ -- ** Framebuffer  type FramebuffersMsaa =-  ( RefCounted-  , Image.AllocatedImage+  ( Image.AllocatedImage   , Image.AllocatedImage   , Vector Vk.Framebuffer   )@@ -226,51 +251,45 @@ allocateFramebufferMsaa   :: ( Resource.MonadResource m      , MonadVulkan env m-     , HasLogFunc env      , HasSwapchain swapchain      )   => swapchain   -> Vk.RenderPass   -> m FramebuffersMsaa allocateFramebufferMsaa swapchain renderPass = do-  context <- ask-  let extent@Vk.Extent2D{width, height} = getSurfaceExtent swapchain--  (colorKey, color) <- Resource.allocate-    ( Image.create-        context-        (Just $ "ForwardMSAA.color")-        Vk.IMAGE_ASPECT_COLOR_BIT-        extent-        1-        1-        (getMultisample swapchain)-        (getSurfaceFormat swapchain)-        Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT-    )-    (Image.destroy context)+  color <- Image.allocate+    (Just "ForwardMSAA.color")+    Vk.IMAGE_ASPECT_COLOR_BIT+    (Image.inflateExtent extent 1)+    1+    1+    (getMultisample swapchain)+    (getSurfaceFormat swapchain)+    Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT -  (depthKey, depth) <- Resource.allocate-    ( Image.create-        context-        (Just $ "ForwardMSAA.depth")-        Vk.IMAGE_ASPECT_DEPTH_BIT-        extent-        1-        1-        (getMultisample swapchain)-        (getDepthFormat swapchain)-        Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT-    )-    (Image.destroy context)+  depth <- Image.allocate+    (Just "ForwardMSAA.depth")+    Vk.IMAGE_ASPECT_DEPTH_BIT+    (Image.inflateExtent extent 1)+    1+    1+    (getMultisample swapchain)+    (getDepthFormat swapchain)+    Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT    perView <- Vector.iforM (getSwapchainViews swapchain) \ix colorResolve -> do     let       attachments = Vector.fromList-        [ Image.aiImageView color-        , Image.aiImageView depth-        , colorResolve-        ]+        case getMultisample swapchain of+          Vk.SAMPLE_COUNT_1_BIT ->+            [ colorResolve+            , Image.aiImageView depth+            ]+          _ ->+            [ Image.aiImageView color+            , Image.aiImageView depth+            , colorResolve+            ]        fbCI = zero         { Vk.renderPass  = renderPass@@ -280,19 +299,12 @@         , Vk.layers      = 1         } -      device = getDevice context-    res <- Vk.withFramebuffer device fbCI Nothing Resource.allocate-    Debug.nameObject device (snd res) $+    device <- asks getDevice+    (_fbKey, fb) <- Vk.withFramebuffer device fbCI Nothing Resource.allocate+    Named.object fb $       "ForwardMSAA.FB:" <> fromString (show @Int ix)--    pure res--  let (framebufferKeys, framebuffers) = Vector.unzip perView-  releaseDebug <- toIO $ logDebug "Releasing ForwardMsaa resources"-  release <- newRefCounted do-    releaseDebug-    Resource.release colorKey-    Resource.release depthKey-    traverse_ Resource.release framebufferKeys+    pure fb -  pure (release, color, depth, framebuffers)+  pure (color, depth, perView)+  where+    extent@Vk.Extent2D{width, height} = getSurfaceExtent swapchain

@@ -1,21 +1,24 @@+{-# LANGUAGE DeriveAnyClass #-}+ module Render.Lit.Colored.Model   ( Model-+  , Vertex   , VertexAttrs(..)-  , vkVertexAttrs-   , InstanceAttrs   ) where  import RIO -import Foreign (Storable(..)) import Geomancy (Transform, Vec2, Vec4)+import Geomancy.Gl.Block (Block)+import Geomancy.Gl.Block qualified as Block import Geomancy.Vec3 qualified as Vec3 import Resource.Model qualified as Model-import Vulkan.Core10 qualified as Vk +import Engine.Vulkan.Format (HasVkFormat)+ type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  data VertexAttrs = VertexAttrs   { vaBaseColor         :: Vec4@@ -23,32 +26,7 @@   , vaMetallicRoughness :: Vec2   , vaNormal            :: Vec3.Packed   }-  deriving (Eq, Ord, Show, Generic)--instance Storable VertexAttrs where-  alignment ~_ = 4--  sizeOf ~_ = 16 + 16 + 8 + 12--  peek ptr = do-    vaBaseColor         <- peekByteOff ptr  0-    vaEmissiveColor     <- peekByteOff ptr 16-    vaMetallicRoughness <- peekByteOff ptr 32-    vaNormal            <- peekByteOff ptr 40-    pure VertexAttrs{..}--  poke ptr VertexAttrs{..} = do-    pokeByteOff ptr  0 vaBaseColor-    pokeByteOff ptr 16 vaEmissiveColor-    pokeByteOff ptr 32 vaMetallicRoughness-    pokeByteOff ptr 40 vaNormal+  deriving (Eq, Ord, Show, Generic, Block, HasVkFormat)+  deriving Storable via (Block.Packed VertexAttrs)  type InstanceAttrs = Transform--vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- vBaseColor         :: vec4-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- vEmissiveColor     :: vec4-  , Vk.FORMAT_R32G32_SFLOAT       -- vMetallicRoughness :: vec2-  , Vk.FORMAT_R32G32B32_SFLOAT    -- vNormal            :: vec3-  ]

@@ -18,13 +18,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Lit.Colored.Code qualified as Code import Render.Lit.Colored.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.InstanceAttrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -33,7 +33,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -49,7 +49,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateBlend multisample tset0 rp = do@@ -60,20 +60,14 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos-      , (Vk.VERTEX_INPUT_RATE_VERTEX, Model.vkVertexAttrs)-      , instanceTransform-      ] -configBlend :: Tagged Scene DsBindings -> Config+configBlend :: Tagged Scene DsLayoutBindings -> Config configBlend tset0 = (config tset0)   { Graphics.cBlend = True   }

@@ -26,6 +26,10 @@   }   deriving (Eq, Ord, Show, Generic) +{- XXX: The derived instance has padding, but its okay here.+It is only used for intermediate storage.+The instance uses per-vertex material data.+-} instance GStorable Material  instance Zero Material where

@@ -166,6 +166,8 @@         vec3 normals = pow(normalsColor, vec3(1.0/2.2)) * 2.0 - 1.0;          normal = normalize(fTBN * normals);+      } else {+        normal = normalize(normal);       }        ${litMain}

@@ -1,32 +1,26 @@-{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}+{-# LANGUAGE DeriveAnyClass #-}  module Render.Lit.Material.Model   ( Model+  , Vertex   , VertexAttrs(..)-  , vkVertexAttrs-   , InstanceAttrs-  -- , InstanceBuffers(..)--  -- , TextureParams(..)-  -- , vkInstanceTexture--  -- , allocateInstancesWith-  , Transform   , Material   ) where  import RIO -import Foreign (Storable(..)) import Geomancy (Transform, Vec2) import Geomancy.Vec3 qualified as Vec3-import Vulkan.Core10 qualified as Vk+import Geomancy.Gl.Block (Block)+import Geomancy.Gl.Block qualified as Block -import Resource.Model qualified as Model+import Engine.Vulkan.Format (HasVkFormat) import Render.Lit.Material (Material)+import Resource.Model qualified as Model  type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  data VertexAttrs = VertexAttrs   { vaTexCoord0 :: Vec2@@ -35,35 +29,7 @@   , vaTangent   :: Vec3.Packed   , vaMaterial  :: Word32   }-  deriving (Eq, Ord, Show, Generic)--instance Storable VertexAttrs where-  alignment ~_ = 4--  sizeOf ~_ = 8 + 8 + 12 + 12 + 4--  peek ptr = do-    vaTexCoord0 <- peekByteOff ptr 0-    vaTexCoord1 <- peekByteOff ptr 8-    vaNormal    <- peekByteOff ptr 16-    vaTangent   <- peekByteOff ptr 28-    vaMaterial  <- peekByteOff ptr 40-    pure VertexAttrs{..}--  poke ptr VertexAttrs{..} = do-    pokeByteOff ptr  0 vaTexCoord0-    pokeByteOff ptr  8 vaTexCoord1-    pokeByteOff ptr 16 vaNormal-    pokeByteOff ptr 28 vaTangent-    pokeByteOff ptr 40 vaMaterial--vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32_SFLOAT    -- vTexCoord0 :: vec2-  , Vk.FORMAT_R32G32_SFLOAT    -- vTexCoord1 :: vec2-  , Vk.FORMAT_R32G32B32_SFLOAT -- vNormal    :: vec3-  , Vk.FORMAT_R32G32B32_SFLOAT -- vTangent   :: vec3-  , Vk.FORMAT_R32_UINT         -- vMaterial  :: uint-  ]+  deriving (Eq, Ord, Show, Generic, Block, HasVkFormat)+  deriving Storable via (Block.Packed VertexAttrs)  type InstanceAttrs = Transform

@@ -18,13 +18,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Lit.Material.Code qualified as Code import Render.Lit.Material.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.InstanceAttrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -33,7 +33,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -49,7 +49,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateBlend multisample tset0 rp = do@@ -60,22 +60,16 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   , Graphics.cDepthWrite   = False -- XXX: Lit pipelines require depth pre-pass   , Graphics.cDepthCompare = Vk.COMPARE_OP_EQUAL   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos -- vPosition-      , (Vk.VERTEX_INPUT_RATE_VERTEX, Model.vkVertexAttrs)-      , instanceTransform-      ] -configBlend :: Tagged Scene DsBindings -> Config+configBlend :: Tagged Scene DsLayoutBindings -> Config configBlend tset0 = (config tset0)   { Graphics.cBlend =       True

@@ -1,162 +1,32 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE DeriveAnyClass #-}+ module Render.Lit.Textured.Model   ( Model+  , Vertex   , VertexAttrs(..)-  , vkVertexAttrs -  , InstanceAttrs(..)-  , InstanceBuffers(..)--  , TextureParams(..)-  , vkInstanceTexture--  , allocateInstancesWith-  , Transform+  , module Render.Unlit.Textured.Model   ) where  import RIO-+import Render.Unlit.Textured.Model hiding (Model, Vertex, VertexAttrs) -import Foreign (Storable(..))-import Geomancy (Transform, Vec2, Vec4)+import Foreign.Storable.Generic (GStorable)+import Geomancy (Vec2) import Geomancy.Vec3 qualified as Vec3-import RIO.Vector.Storable qualified as VectorS-import UnliftIO.Resource (MonadResource, ReleaseKey, allocate)-import Vulkan.Core10 qualified as Vk-import Vulkan.Zero (Zero(..)) -import Resource.Buffer qualified as Buffer+import Engine.Vulkan.Format (HasVkFormat) import Resource.Model qualified as Model  type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  data VertexAttrs = VertexAttrs   { vaTexCoord :: Vec2   , vaNormal   :: Vec3.Packed   }-  deriving (Eq, Ord, Show, Generic)--instance Storable VertexAttrs where-  alignment ~_ = 4--  sizeOf ~_ = 8 + 12--  peek ptr = do-    vaTexCoord <- peekByteOff ptr 0-    vaNormal   <- peekByteOff ptr 8-    pure VertexAttrs{..}--  poke ptr VertexAttrs{..} = do-    pokeByteOff ptr 0 vaTexCoord-    pokeByteOff ptr 8 vaNormal--vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32_SFLOAT    -- vTexCoord :: vec2-  , Vk.FORMAT_R32G32B32_SFLOAT -- vNormal   :: vec3-  ]--data InstanceAttrs = InstanceAttrs-  { textureParams :: TextureParams-  , transformMat4 :: Transform-  }--instance Zero InstanceAttrs where-  zero = InstanceAttrs-    { textureParams = zero-    , transformMat4 = mempty-    }--data InstanceBuffers textureStage transformStage = InstanceBuffers-  { ibTexture   :: InstanceTexture textureStage-  , ibTransform :: InstanceTransform transformStage-  }--type InstanceTexture stage = Buffer.Allocated stage TextureParams--type InstanceTransform stage = Buffer.Allocated stage Transform--instance Model.HasVertexBuffers (InstanceBuffers textureStage transformStage) where-  type VertexBuffersOf (InstanceBuffers textureStage transformStage) = InstanceAttrs--  {-# INLINE getVertexBuffers #-}-  getVertexBuffers InstanceBuffers{..} =-    [ Buffer.aBuffer ibTexture-    , Buffer.aBuffer ibTransform-    ]--  {-# INLINE getInstanceCount #-}-  getInstanceCount InstanceBuffers{..} =-    min-      (Buffer.aUsed ibTexture)-      (Buffer.aUsed ibTransform)--data TextureParams = TextureParams-  { tpScale     :: Vec2-  , tpOffset    :: Vec2-  , tpGamma     :: Vec4-  , tpSamplerId :: Int32-  , tpTextureId :: Int32-  }-  deriving (Show)--instance Zero TextureParams where-  zero = TextureParams-    { tpScale     = 1-    , tpOffset    = 0-    , tpGamma     = 1.0-    , tpSamplerId = minBound-    , tpTextureId = minBound-    }--instance Storable TextureParams where-  alignment ~_ = 8--  sizeOf ~_ = 8 + 8 + 16 + 4 + 4--  poke ptr TextureParams{..} = do-    pokeByteOff ptr  0 tpScale-    pokeByteOff ptr  8 tpOffset-    pokeByteOff ptr 16 tpGamma-    pokeByteOff ptr 32 tpSamplerId-    pokeByteOff ptr 36 tpTextureId--  peek ptr = do-    tpScale     <- peekByteOff ptr  0-    tpOffset    <- peekByteOff ptr  8-    tpGamma     <- peekByteOff ptr 16-    tpSamplerId <- peekByteOff ptr 32-    tpTextureId <- peekByteOff ptr 36-    pure TextureParams{..}--vkInstanceTexture :: [Vk.Format]-vkInstanceTexture =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4-  , Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2-  ]--allocateInstancesWith-  :: ( MonadResource m-     , MonadUnliftIO m-     )-  => (Vk.BufferUsageFlagBits -> Int -> VectorS.Vector TextureParams -> m (InstanceTexture texture))-  -> (Vk.BufferUsageFlagBits -> Int -> VectorS.Vector Transform -> m (InstanceTransform transform))-  -> (forall stage a . Buffer.Allocated stage a -> m ())-  -> [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers texture transform)-allocateInstancesWith createTextures createTransforms bufferDestroy instances = do-  ul <- askUnliftIO-  allocate (create ul) (destroy ul)-  where-    textures   = VectorS.fromList $ map textureParams instances-    transforms = VectorS.fromList $ map transformMat4 instances-    numInstances = VectorS.length textures--    create (UnliftIO ul) = ul do-      ibTexture   <- createTextures   Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances textures-      ibTransform <- createTransforms Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances transforms-      pure InstanceBuffers{..}+  deriving (Eq, Ord, Show, Generic, HasVkFormat) -    destroy (UnliftIO ul) InstanceBuffers{..} = ul do-      bufferDestroy ibTexture-      bufferDestroy ibTransform+instance GStorable VertexAttrs

@@ -18,13 +18,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Lit.Textured.Code qualified as Code import Render.Lit.Textured.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.Attrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -33,7 +33,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -49,7 +49,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateBlend multisample tset0 rp = do@@ -60,23 +60,16 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   , Graphics.cDepthWrite   = False -- XXX: Lit pipelines require depth pre-pass   , Graphics.cDepthCompare = Vk.COMPARE_OP_EQUAL   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos -- vPosition-      , (Vk.VERTEX_INPUT_RATE_VERTEX,   Model.vkVertexAttrs)-      , (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceTexture)-      , instanceTransform-      ] -configBlend :: Tagged Scene DsBindings -> Config+configBlend :: Tagged Scene DsLayoutBindings -> Config configBlend tset0 = (config tset0)   { Graphics.cBlend      = True   , Graphics.cDepthCompare = Vk.COMPARE_OP_LESS_OR_EQUAL

@@ -0,0 +1,183 @@+{-# LANGUAGE OverloadedLists #-}++module Render.Pass.Compose+  ( Compose(..)+  , allocate+  , update+  , usePass+  ) where++import RIO++import Control.Monad.Trans.Resource qualified as Resource+import Data.Bits ((.|.))+import Data.Vector qualified as Vector+import Vulkan.Core10 qualified as Vk+import Vulkan.Utils.Debug qualified as Debug+import Vulkan.Zero (zero)++import Engine.Types.RefCounted (RefCounted, releaseRefCounted, resourceTRefCount)+import Engine.Types.RefCounted qualified as RefCounted+import Engine.Vulkan.Types (HasSwapchain(..), HasRenderPass(..), MonadVulkan, RenderPass(..), getDevice)+import Render.Pass (usePass)+import Resource.Region qualified as Region++-- | Composition/postprocessing/presentation pass+--+-- Can be used to transfer images from "Render.Pass.Offscreen.Offscreen" passes and tonemapping.+--+-- Color attachments are derived from swapchain.+-- The pass optmized for image transfer: it has no depth attachment and does not clear.+-- Use image blitting that convers the whole area or a fullscreen shader.+data Compose = Compose+  { renderPass   :: Vk.RenderPass+  , frameBuffers :: Vector Vk.Framebuffer+  , renderArea   :: Vk.Rect2D+  , clear        :: Vector Vk.ClearValue+  , release      :: RefCounted+  }++instance HasRenderPass Compose where+  getRenderPass   = renderPass+  getFramebuffers = frameBuffers+  getClearValues  = clear+  getRenderArea   = renderArea++instance RenderPass Compose where+  updateRenderpass = update+  refcountRenderpass = resourceTRefCount . release++allocate+  :: ( Resource.MonadResource m+     , MonadVulkan env m+     , HasLogFunc env+     , HasSwapchain swapchain+     )+  => swapchain+  -> m Compose+allocate swapchain = do+  renderPass <- allocateRenderPass format+  (refcounted, framebuffers) <- RefCounted.wrapped $ Region.run do+    Region.logDebug+      "Allocating Compose resources"+      "Releasing Compose resources"+    allocateFramebufferSwapchain swapchain renderPass++  pure Compose+    { renderPass   = renderPass+    , renderArea   = fullSurface+    , clear        = mempty+    , frameBuffers = framebuffers+    , release      = refcounted+    }+  where+    format = getSurfaceFormat swapchain++    fullSurface = Vk.Rect2D+      { Vk.offset = zero+      , Vk.extent = getSurfaceExtent swapchain+      }++update+  :: ( Resource.MonadResource m+     , MonadVulkan env m+     , HasSwapchain swapchain+     )+  => swapchain+  -> Compose+  -> m Compose+update swapchain old@Compose{release, renderPass} = do+  releaseRefCounted release+  (refcounted, framebuffers) <- RefCounted.wrapped $ Region.run do+    allocateFramebufferSwapchain swapchain renderPass+  pure old+    { frameBuffers = framebuffers+    , release      = refcounted+    , renderArea   = fullSurface+    }+  where+    fullSurface = Vk.Rect2D+      { Vk.offset = zero+      , Vk.extent = getSurfaceExtent swapchain+      }++-- ** Render pass++allocateRenderPass+  :: ( MonadVulkan env m+     , Resource.MonadResource m+     )+  => Vk.Format+  -> m Vk.RenderPass+allocateRenderPass format = do+  device <- asks getDevice+  (_key, rp) <- Vk.withRenderPass device createInfo Nothing Resource.allocate+  Debug.nameObject device rp "Compose"+  pure rp+  where+    createInfo = zero+      { Vk.attachments  = [color]+      , Vk.subpasses    = [subpass]+      , Vk.dependencies = [colorDeps]+      }++    color = zero+      { Vk.format      = format+      , Vk.samples     = Vk.SAMPLE_COUNT_1_BIT+      , Vk.loadOp      = Vk.ATTACHMENT_LOAD_OP_DONT_CARE+      , Vk.finalLayout = Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR+      }++    subpass = zero+      { Vk.pipelineBindPoint =+          Vk.PIPELINE_BIND_POINT_GRAPHICS+      , Vk.colorAttachments = Vector.singleton zero+          { Vk.attachment = 0+          , Vk.layout     = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL+          }+      }++    colorDeps = zero+      { Vk.srcSubpass    = Vk.SUBPASS_EXTERNAL+      , Vk.dstSubpass    = 0+      , Vk.srcStageMask  = colorOut+      , Vk.srcAccessMask = zero+      , Vk.dstStageMask  = colorOut+      , Vk.dstAccessMask = colorRW+      }+      where+        colorOut =+          Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT++        colorRW =+          Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT .|.+          Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT++-- ** Framebuffer++allocateFramebufferSwapchain+  :: ( Resource.MonadResource m+     , MonadVulkan env m+     , HasSwapchain swapchain+     )+  => swapchain+  -> Vk.RenderPass+  -> m (Vector Vk.Framebuffer)+allocateFramebufferSwapchain swapchain renderPass =+  Vector.iforM (getSwapchainViews swapchain) \ix colorView -> do+    let+      fbCI = zero+        { Vk.renderPass  = renderPass+        , Vk.width       = width+        , Vk.height      = height+        , Vk.attachments = [colorView]+        , Vk.layers      = 1+        }++    device <- asks getDevice+    (_key, fb) <- Vk.withFramebuffer device fbCI Nothing Resource.allocate+    Debug.nameObject device fb $+      "Compose.FB:" <> fromString (show @Int ix)+    pure fb+  where+    Vk.Extent2D{width, height} = getSurfaceExtent swapchain

@@ -20,13 +20,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert)-import Render.DescSets.Set0 (vertexPos, instanceTransform) import Render.DescSets.Sun (Sun) import Render.ShadowMap.Code qualified as Code+import Resource.Model (Vertex3d) -type Pipeline = Graphics.Pipeline '[Sun] () Transform+type Pipeline = Graphics.Pipeline '[Sun] (Vertex3d ()) Transform type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -45,7 +45,7 @@   :: ( HasVulkan env      , HasRenderPass renderpass      )-  => Tagged Sun DsBindings+  => Tagged Sun DsLayoutBindings   -> renderpass   -> Settings   -> ResourceT (RIO env) Pipeline@@ -57,19 +57,14 @@     rp   pure p -config :: Tagged Sun DsBindings -> Settings -> Config+config :: Tagged Sun DsLayoutBindings -> Settings -> Config config (Tagged set0) Settings{..} = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Sun] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   , Graphics.cDepthBias    = depthBias   , Graphics.cCull         = cull   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos-      , instanceTransform-      ]  stageSpirv :: Graphics.StageSpirv stageSpirv = Graphics.vertexOnly vertSpirv

@@ -18,11 +18,14 @@ import Vulkan.Zero (zero) import Vulkan.CStruct.Extends (pattern (:&), pattern (::&)) -import Engine.Types.RefCounted (RefCounted, newRefCounted, resourceTRefCount)+import Engine.Types.RefCounted (RefCounted, resourceTRefCount)+import Engine.Types.RefCounted qualified as RefCounted import Engine.Vulkan.Types (HasVulkan(..), HasSwapchain(..), HasRenderPass(..), RenderPass(..), MonadVulkan) import Render.Pass (usePass) import Resource.Image (AllocatedImage) import Resource.Image qualified as Image+import Resource.Region qualified as Region+import Resource.Vulkan.Named qualified as Named  -- * Depth-only pass for shadowmapping pipelines @@ -57,9 +60,13 @@   -> "light count" ::: Word32   -> m ShadowMap allocate context mapSize layerCount = do-  logDebug "Allocating ShadowMap resources"   (_rpKey, renderPass) <- allocateRenderPass context (2 ^ layerCount - 1) 0-  (refcounted, depthImage, framebuffer) <- allocateFramebuffer context extent layerCount renderPass+  (release, resources) <- RefCounted.wrapped $ Region.run do+    Region.logDebug+      "Allocating ShadowMap resources"+      "Releasing ShadowMap resources"+    allocateFramebuffer context extent layerCount renderPass+  let (depthImage, framebuffer) = resources    pure ShadowMap     { smRenderPass  = renderPass@@ -69,7 +76,7 @@     , smClear       = clear     , smDepthImage  = depthImage     , smFrameBuffer = framebuffer-    , smRelease     = refcounted+    , smRelease     = release     }   where     extent = Vk.Extent2D{width=mapSize, height=mapSize}@@ -162,15 +169,13 @@ -- ** Framebuffer  type Framebuffers =-  ( RefCounted-  , Image.AllocatedImage+  ( Image.AllocatedImage   , Vk.Framebuffer   )  allocateFramebuffer   :: ( Resource.MonadResource m      , MonadVulkan env m-     , HasLogFunc env      , HasSwapchain swapchain      )   => swapchain@@ -179,21 +184,15 @@   -> Vk.RenderPass   -> m Framebuffers allocateFramebuffer swapchain extent layerCount renderPass = do-  context <- ask--  (depthKey, depth) <- Resource.allocate-    ( Image.create-        context-        (Just "ShadowMap.depth")-        Vk.IMAGE_ASPECT_DEPTH_BIT-        extent-        1-        layerCount-        Vk.SAMPLE_COUNT_1_BIT-        (getDepthFormat swapchain)-        (Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT .|. Vk.IMAGE_USAGE_SAMPLED_BIT)-    )-    (Image.destroy context)+  depth <- Image.allocate+    (Just "ShadowMap.depth")+    Vk.IMAGE_ASPECT_DEPTH_BIT+    (Image.inflateExtent extent 1)+    1+    layerCount+    Vk.SAMPLE_COUNT_1_BIT+    (getDepthFormat swapchain)+    (Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT .|. Vk.IMAGE_USAGE_SAMPLED_BIT)    let     attachments = Vector.fromList@@ -216,14 +215,8 @@       , Vk.layers      = fbNumLayers       } -    device = getDevice context-  (framebufferKey, framebuffer) <- Vk.withFramebuffer device fbCI Nothing Resource.allocate-  Debug.nameObject device framebuffer "ShadowMap.FB"--  releaseDebug <- toIO $ logDebug "Releasing ShadowMap resources"-  release <- newRefCounted do-    releaseDebug-    Resource.release depthKey-    Resource.release framebufferKey+  device <- asks getDevice+  (_framebufferKey, framebuffer) <- Vk.withFramebuffer device fbCI Nothing Resource.allocate+  Named.object framebuffer "ShadowMap.FB" -  pure (release, depth, framebuffer)+  pure (depth, framebuffer)

@@ -17,7 +17,7 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag) import Render.DescSets.Set0 (Scene) import Render.Skybox.Code qualified as Code@@ -31,7 +31,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 = do@@ -40,7 +40,7 @@     multisample     (config tset0) -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cStages      = stageSpirv   , Graphics.cDescLayouts = Tagged @'[Scene] [set0]

@@ -1,9 +1,9 @@+{-# LANGUAGE DeriveAnyClass #-}+ module Render.Unlit.Colored.Model   ( Model-+  , Vertex   , VertexAttrs-  , vkVertexAttrs-   , rgbF   , black   , white@@ -16,19 +16,14 @@ import Geomancy (Transform, Vec4, vec4) import Geomancy.Vec3 qualified as Vec3 import Resource.Model qualified as Model-import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::))  type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  type VertexAttrs = "RGBA" ::: Vec4  type InstanceAttrs = Transform--vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- vColor :: vec4-  ]  {-# INLINE rgbF #-} rgbF :: Float -> Float -> Float -> VertexAttrs

@@ -18,13 +18,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Unlit.Colored.Code qualified as Code import Render.Unlit.Colored.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.InstanceAttrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -34,7 +34,7 @@      )   => Bool   -> Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate useDepth multisample tset0 rp = do@@ -51,7 +51,7 @@      )   => Bool   -> Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateWireframe useDepth multisample tset0 rp = do@@ -62,21 +62,15 @@     rp   pure p -config :: Bool -> Tagged Scene DsBindings -> Config+config :: Bool -> Tagged Scene DsLayoutBindings -> Config config useDepth (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   , Graphics.cBlend        = True   , Graphics.cDepthTest    = useDepth   , Graphics.cDepthWrite   = useDepth   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos-      , (Vk.VERTEX_INPUT_RATE_VERTEX, Model.vkVertexAttrs)-      , instanceTransform-      ]  stageCode  :: Graphics.StageCode stageCode = Graphics.basicStages Code.vert Code.frag@@ -90,7 +84,7 @@ fragSpirv :: ByteString fragSpirv = $(compileFrag Code.frag) -configWireframe :: Bool -> Tagged Scene DsBindings -> Config+configWireframe :: Bool -> Tagged Scene DsLayoutBindings -> Config configWireframe useDepth tset0 = (config useDepth tset0)   { Graphics.cTopology = Vk.PRIMITIVE_TOPOLOGY_LINE_LIST   }

@@ -0,0 +1,61 @@+module Render.Unlit.Line2d.Code+  ( vert+  , frag+  ) where++import RIO++import Render.Code (Code, glsl)+import Render.DescSets.Set0.Code (set0binding0)++vert :: Code+vert = fromString+  [glsl|+    #version 450++    ${set0binding0}++    layout(location = 0) in vec3 vPosition;++    layout(location = 2) in vec4 iPositionA;+    layout(location = 1) in vec4 iColorA;++    layout(location = 4) in vec4 iPositionB;+    layout(location = 3) in vec4 iColorB;++    layout(location = 0) out vec4 fColor;++    void main() {+      vec2 xBasis = normalize(iPositionB.xy - iPositionA.xy);+      vec2 yBasis = vec2(-xBasis.y, xBasis.x);++      float width = mix(iPositionA.w, iPositionB.w, vPosition.z);+      fColor = mix(iColorA, iColorB, vPosition.z);++      vec2 offsetA = iPositionA.xy + width * (vPosition.x * xBasis + vPosition.y * yBasis);+      vec2 offsetB = iPositionB.xy + width * (vPosition.x * xBasis + vPosition.y * yBasis);++      vec2 point = mix(offsetA, offsetB, vPosition.z);++      vec4 fPosition = vec4(point, 0, 1);++      gl_Position+        = scene.projection+        * scene.view+        * fPosition;+    }+  |]++frag :: Code+frag = fromString+  [glsl|+    #version 450++    layout(location = 0) in vec4 fColor;++    layout(location = 0) out vec4 oColor;++    void main() {+      oColor = fColor;+    }+  |]

@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedLists #-}++module Render.Unlit.Line2d.Draw where++import RIO++import Vulkan.Core10 qualified as Vk+import Vulkan.NamedType ((:::))++import Engine.Vulkan.Types (Bound(..))+import Render.Unlit.Line2d.Model qualified as Model+import Resource.Buffer qualified as Buffer++batch+  :: (MonadIO m, Foldable t)+  => Vk.CommandBuffer+  -> Model.Segment+  -> Buffer.Allocated s Model.InstanceAttrs+  -> t ("firstInstance" ::: Word32, "instanceCount" ::: Word32)+  -> Bound dsl vertices instances m ()+batch cmd vertices points ranges =+  when (Buffer.aUsed points >= 2) do -- XXX: at least one segment to draw+    bind cmd vertices points+    -- TODO: check bindings+    Bound $+      traverse_ (segments cmd vertices) ranges++single+  :: MonadIO m+  => Vk.CommandBuffer+  -> Model.Segment+  -> Buffer.Allocated s Model.InstanceAttrs+  -> Bound dsl vertices instances m ()+single cmd vertices points =+  batch cmd vertices points $+    Just+      ( 0+      , Buffer.aUsed points+      )++bind+  :: MonadIO io+  => Vk.CommandBuffer+  -> Model.Segment+  -> Model.Buffer s+  -> io ()+bind cmd vertices points = do+  Vk.cmdBindVertexBuffers+    cmd+    0+    buffers+    offsets+  where+    buffers =+      [ Buffer.aBuffer vertices+      , Buffer.aBuffer points+      , Buffer.aBuffer points+      ]++    offsets =+      [ 0+      , 0+      , 4*4 + 4*4 -- vec4, vec4+      ]++segments+  :: MonadIO io+  => Vk.CommandBuffer+  -> Buffer.Allocated s a+  -> ("firstInstance" ::: Word32, "instanceCount" ::: Word32)+  -> io ()+segments cmd vertices (offset, size) =+  when (numSegments > 0) $+    Vk.cmdDraw+      cmd+      vertexCount+      instanceCount+      firstVertex+      firstInstance+  where+    firstVertex = 0+    vertexCount = Buffer.aUsed vertices++    numSegments = size - 1+    firstInstance = offset+    instanceCount = numSegments

@@ -0,0 +1,201 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE OverloadedLists #-}++module Render.Unlit.Line2d.Model+  ( Segment++  , Vertex+  , createVertices+  , verticesRoundRound+  , Points++  , point+  , InstanceAttrs(..)++  , Buffer+  , Observer+  , Buffer.observeCoherentResize_++  , Batches(..)+  , BatchObserver+  , newBatchObserver+  , observeCoherentBatches+  ) where++import RIO++import Control.Monad.Trans.Resource qualified as Resource+import Data.Vector.Generic qualified as Generic+import Foreign.Storable.Generic (GStorable)+import Geomancy (Vec2, Vec4, vec3)+import Geomancy.Vec3 qualified as Vec3+import RIO.Vector qualified as Vector+import RIO.Vector.Storable qualified as Storable+import Vulkan.Core10 qualified as Vk+import Vulkan.NamedType ((:::))++import Engine.Vulkan.Format (HasVkFormat(..))+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)+import Engine.Vulkan.Types (MonadVulkan, Queues)+import Engine.Worker qualified as Worker+import Resource.Buffer qualified as Buffer+import Resource.Model qualified as Model++type Segment = Buffer.Allocated 'Buffer.Staged Vec3.Packed+type Vertex = Model.Vertex3d ()++createVertices+  :: MonadVulkan env m+  => Maybe Text+  -> Queues Vk.CommandPool+  -> Float+  -> m Segment+createVertices label pools resolution = do+  Buffer.createStaged+    label+    pools+    Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT+    (Storable.length vertices)+    vertices+  where+    vertices = verticesRoundRound resolution++{- |+  Generate mesh for the round joints / round caps special case.++  With a bit of vertex shader code it allows drawing a batch of+  smooth lines in one call.+-}+verticesRoundRound :: Float -> Storable.Vector Vec3.Packed+verticesRoundRound resolution =+  Storable.fromList . map Vec3.Packed $+    mconcat+      [ segment+      , leftSemi+      , rightSemi+      ]+  where+    segment =+      [ vec3 0 (-0.5) 0+      , vec3 0 (-0.5) 1+      , vec3 0   0.5  1+      , vec3 0 (-0.5) 0+      , vec3 0   0.5  1+      , vec3 0   0.5  0+      ]++    leftSemi = do+      step <- [0..resolution]+      let+        theta0 = pi / 2 + (step + 0) * pi / resolution+        theta1 = pi / 2 + (step + 1) * pi / resolution+        a = vec3 0 0 0+        b = vec3 (cos theta0) (sin theta0) 0 * 0.5+        c = vec3 (cos theta1) (sin theta1) 0 * 0.5+      [ a, b, c ]++    rightSemi = do+      step <- [0..resolution]+      let+        theta0 = 3 * pi / 2 + (step + 0) * pi / resolution+        theta1 = 3 * pi / 2 + (step + 1) * pi / resolution+        a = vec3 0 0 0+        b = vec3 (cos theta0) (sin theta0) 2 * 0.5+        c = vec3 (cos theta1) (sin theta1) 2 * 0.5+      [ a, b, c ]++type Points = Storable.Vector InstanceAttrs++point :: Float -> Vec4 -> Vec2 -> InstanceAttrs+point width color position = InstanceAttrs+  { color    = color+  , position = Vec3.Packed (Vec3.fromVec2 position 0)+  , width    = width+  }++data InstanceAttrs = InstanceAttrs+  { color    :: Vec4++  , position :: Vec3.Packed+  , width    :: Float+  } deriving (Eq, Show, Generic)++-- XXX: okay, the layout matches+instance GStorable InstanceAttrs++instance HasVkFormat InstanceAttrs where+  getVkFormat =+    [ Vk.FORMAT_R32G32B32A32_SFLOAT -- color+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- position+width+    ]++instance HasVertexInputBindings InstanceAttrs where+  vertexInputBindings =+    -- XXX: instance buffer is bound 2 times with a shift+    replicate 2 $ instanceFormat @InstanceAttrs++type Buffer s = Buffer.Allocated s InstanceAttrs++type Observer = Buffer.ObserverCoherent InstanceAttrs+type BatchObserver = Worker.ObserverIO (Buffer 'Buffer.Coherent, Ranges)+type Ranges = [(Word32, Word32)]++newtype Batches v a = Batches [v a]+  deriving (Eq, Show, Ord, Functor, Foldable, Traversable, Semigroup, Monoid)++newBatchObserver+  :: ( MonadVulkan env m+     , Resource.MonadResource m+     )+  => "initial size" ::: Int+  -> m BatchObserver+newBatchObserver initialSize = do+  initialBuffer <- Buffer.createCoherent+    (Just "Line2D")+    Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT+    initialSize+    mempty+  observer <- Worker.newObserverIO (initialBuffer, [])++  context <- ask+  void $! Resource.register do+    (currentBuffer, _ranges) <- Worker.readObservedIO observer+    Buffer.destroy context currentBuffer++  pure (observer :: BatchObserver)++observeCoherentBatches+  :: ( Worker.GetOutput output ~ Batches Storable.Vector InstanceAttrs+     , Worker.HasOutput output+     , MonadVulkan env m+     )+  => output+  -> BatchObserver+  -> m ()+observeCoherentBatches source observer =+  Worker.observeIO_ source observer \(buf, _ranges) (Batches batches) -> do+    let segments = filterSegments batches+    buf' <- Buffer.updateCoherentResize_ buf $+      Storable.concat segments+    pure (buf', toRanges segments)++filterSegments+  :: Generic.Vector v a+  => [v a]+  -> [v a]+filterSegments = filter \v ->+  Vector.length v >= 2++toRanges+  :: ( Generic.Vector v a+     , Integral i+     )+  => [v a]+  -> [(i, i)]+toRanges = collect . filter (not . Vector.null)+  where+    collect v = Vector.toList @Vector $ Vector.zip offsets sizes+      where+        sizes = Vector.fromList $ map (fromIntegral . Vector.length) v+        offsets = Vector.scanl' (+) 0 sizes

@@ -0,0 +1,69 @@+module Render.Unlit.Line2d.Pipeline+  ( Pipeline+  , allocate++  , Config+  , config++  , stageCode+  , stageSpirv+  ) where++import RIO++import Control.Monad.Trans.Resource (MonadResource, ResourceT)+import Data.Tagged (Tagged(..))+import Vulkan.Core10 qualified as Vk++import Engine.Vulkan.Pipeline.Graphics qualified as Graphics+import Engine.Vulkan.Types (DsLayoutBindings, HasRenderPass(..), MonadVulkan)+import Render.Code (compileVert, compileFrag)+import Render.DescSets.Set0 (Scene)+import Render.Unlit.Line2d.Code qualified as Code+import Render.Unlit.Line2d.Model qualified as Model+import Resource.Region qualified as Region++type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.InstanceAttrs+type Config = Graphics.Configure Pipeline+type instance Graphics.Specialization Pipeline = ()++allocate+  :: ( MonadVulkan env m+     , MonadResource m+     , HasRenderPass renderpass+     )+  => Bool+  -> Vk.SampleCountFlagBits+  -> Tagged Scene DsLayoutBindings+  -> renderpass+  -> ResourceT m Pipeline+allocate useDepth multisample tset0 rp =+  Region.local $+    Graphics.allocate+      Nothing+      multisample+      (config useDepth tset0)+      rp++config :: Bool -> Tagged Scene DsLayoutBindings -> Config+config useDepth (Tagged set0) = Graphics.baseConfig+  { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]+  , Graphics.cStages       = stageSpirv+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline+  , Graphics.cBlend        = True+  , Graphics.cDepthTest    = useDepth+  , Graphics.cDepthWrite   = useDepth+  , Graphics.cCull         = Vk.CULL_MODE_NONE+  }++stageCode  :: Graphics.StageCode+stageCode = Graphics.basicStages Code.vert Code.frag++stageSpirv :: Graphics.StageSpirv+stageSpirv = Graphics.basicStages vertSpirv fragSpirv++vertSpirv :: ByteString+vertSpirv = $(compileVert Code.vert)++fragSpirv :: ByteString+fragSpirv = $(compileFrag Code.frag)

@@ -19,14 +19,15 @@     layout(location = 1) in  vec4 iFrag;     layout(location = 2) in  vec4 iTint;     layout(location = 3) in  vec4 iOutline;-    layout(location = 4) in ivec2 iTextureIds;+    layout(location = 4) in  vec4 iAnimation;     layout(location = 5) in uvec2 iTextureSize;+    layout(location = 6) in ivec2 iTextureIds;      layout(location = 0)      out  vec2 fTexCoord;     layout(location = 1) flat out  vec4 fTint;     layout(location = 2) flat out  vec4 fOutline;-    layout(location = 3) flat out ivec2 fTextureIds;-    layout(location = 4) flat out uvec2 fTextureSize;+    layout(location = 3) flat out  vec2 fStepSize;+    layout(location = 4) flat out ivec2 fTextureIds;      vec2 positions[6] = vec2[](       vec2(-0.5, -0.5),@@ -49,6 +50,12 @@     );      void main() {+      // pass-through+      fTint = iTint;+      fOutline = iOutline;+      fTextureIds = iTextureIds;+      fStepSize = 1.0 / vec2(iTextureSize);+       vec2 pos = positions[gl_VertexIndex];        gl_Position@@ -59,10 +66,17 @@       vec2 uv = texCoords[gl_VertexIndex];       fTexCoord = iFrag.xy + uv * iFrag.zw; -      fTint = iTint;-      fOutline = iOutline;-      fTextureIds = iTextureIds;-      fTextureSize = iTextureSize;+      float time = 0;+      float frame = 0;+      if (iAnimation[0] > 1) {+        time = scene.tweaks.a + iAnimation[3];+        frame = mod(trunc(time * iAnimation[1]), iAnimation[0]) - 1.0;+        fTexCoord +=+          vec2(+            frame * iFrag.z + frame * iAnimation[2] / float(iTextureSize.x),+            0+          );+      }     }   |] @@ -78,8 +92,8 @@     layout(location = 0)      in  vec2 fTexCoord;     layout(location = 1) flat in  vec4 fTint;     layout(location = 2) flat in  vec4 fOutline;-    layout(location = 3) flat in ivec2 fTextureIds;-    layout(location = 4) flat in uvec2 fTextureSize;+    layout(location = 3) flat in  vec2 fStepSize;+    layout(location = 4) flat in ivec2 fTextureIds;      layout(location = 0) out vec4 outColor; @@ -87,17 +101,16 @@     layout(constant_id=1) const bool  doOutline = false;      vec4 tap(vec2 uv) {-      return texture(+      return textureLod(         sampler2D(           textures[nonuniformEXT(fTextureIds.t)],           samplers[nonuniformEXT(fTextureIds.s)]         ),-        fTexCoord + uv+        fTexCoord + uv,+        0       );     } -    vec2 step_size = 1.0 / vec2(fTextureSize);-     void main() {       vec4 texel = tap(vec2(0)); @@ -113,10 +126,10 @@         if (fOutline.a > 0.0 && texel.a < 1.0) {           float alpha = 0.0; -          alpha += tap(vec2(step_size.x,  0.0)         ).a / 4.0;-          alpha += tap(vec2(-step_size.x, 0.0)         ).a / 4.0;-          alpha += tap(vec2(0.0,          step_size.y) ).a / 4.0;-          alpha += tap(vec2(0.0,          -step_size.y)).a / 4.0;+          alpha += tap(vec2(fStepSize.x,  0.0)         ).a / 4.0;+          alpha += tap(vec2(-fStepSize.x, 0.0)         ).a / 4.0;+          alpha += tap(vec2(0.0,          fStepSize.y) ).a / 4.0;+          alpha += tap(vec2(0.0,          -fStepSize.y)).a / 4.0;            outColor += fOutline * alpha;         }

@@ -7,13 +7,15 @@   , fromTexture   , fromAtlas -  , vkInstanceAttrs+  , animate_   ) where  import RIO +import Engine.Vulkan.Format (HasVkFormat(..))+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat) import Foreign.Storable.Generic (GStorable)-import Geomancy (Vec2, Vec4, UVec2, withUVec2, vec2)+import Geomancy (Vec2, Vec4, UVec2, vec2, vec4, withUVec2, withVec2) import Geomancy.Vec4 qualified as Vec4 import Render.Samplers qualified as Samplers import Resource.Buffer qualified as Buffer@@ -21,10 +23,9 @@ import Resource.Image.Atlas qualified as Atlas import RIO.Vector.Storable qualified as Storable import Vulkan.Core10 qualified as Vk+import Vulkan.NamedType ((:::)) import Vulkan.Zero (Zero(..)) -type StorableAttrs = Storable.Vector InstanceAttrs- data InstanceAttrs = InstanceAttrs   { vertRect :: Vec4   , fragRect :: Vec4@@ -32,12 +33,15 @@   , tint    :: Vec4   , outline :: Vec4 +  , animation :: Vec4 -- direction xy, number of frames, speed++  , textureSize :: UVec2   , samplerId :: Int32   , textureId :: Int32-  , textureSize :: UVec2   }   deriving (Show, Generic) +-- XXX: okay, the layout matches instance GStorable InstanceAttrs  instance Zero InstanceAttrs where@@ -48,22 +52,30 @@     , tint    = 0     , outline = 0 +    , animation = 0++    , textureSize = 0     , samplerId = 0     , textureId = 0-    , textureSize = 0     } -vkInstanceAttrs :: [Vk.Format]-vkInstanceAttrs =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- Quad scale+offset-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- UV scale+offset-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- Tint-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline (when enabled)+instance HasVkFormat InstanceAttrs where+  getVkFormat =+    [ Vk.FORMAT_R32G32B32A32_SFLOAT -- Quad scale+offset+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- UV scale+offset+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- Tint+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- Outline (when enabled) -  , Vk.FORMAT_R32G32_SINT -- Sampler + texture IDs-  , Vk.FORMAT_R32G32_UINT -- Texture size-  ]+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- Linear animation direction/duration, num frames, phase +    , Vk.FORMAT_R32G32_UINT -- Texture size+    , Vk.FORMAT_R32G32_SINT -- Sampler + texture IDs+    ]++instance HasVertexInputBindings InstanceAttrs where+  vertexInputBindings = [instanceFormat @InstanceAttrs]++type StorableAttrs = Storable.Vector InstanceAttrs type InstanceBuffer stage = Buffer.Allocated stage InstanceAttrs  fromTexture@@ -80,9 +92,11 @@     , tint    = 1     , outline = 0 +    , animation = 0++    , textureSize = 0     , samplerId = sampler     , textureId = texture-    , textureSize = 0     }  fromAtlas@@ -95,14 +109,16 @@ fromAtlas texture atlas scale atlasPos worldPos =   InstanceAttrs     { vertRect = Vec4.fromVec22 worldPos (tileSize * scale)-    , fragRect = Vec4.fromVec22 (atlasPos * uvScale) uvScale+    , fragRect = Vec4.fromVec22 ((atlasPos + tileMargins / tileSize) * uvScale) uvScale      , tint    = 1     , outline = 0 +    , animation = 0++    , textureSize = Atlas.sizePx atlas     , samplerId = Samplers.nearest Samplers.indices     , textureId = texture-    , textureSize = Atlas.sizePx atlas     }    where@@ -111,3 +127,25 @@     tileSize =       withUVec2 (Atlas.tileSizePx atlas) \tw th ->         vec2 (fromIntegral tw) (fromIntegral th)++    tileMargins =+      withUVec2 (Atlas.marginPx atlas) \mx my ->+        withVec2 atlasPos \px py ->+          vec2 (fromIntegral mx * px) (fromIntegral my * py)++-- | Simple animation controller with left-to-right linear cycle.+animate_+  :: "margin" ::: Float+  -> "num.frames" ::: Int+  -> "frame duration" ::: Float+  -> "phase" ::: Float+  -> InstanceAttrs+  -> InstanceAttrs+animate_ margin numFrames frameDuration phase attrs = attrs+  { animation =+        vec4+          (fromIntegral numFrames)+          frameDuration+          margin+          phase+  }

@@ -17,7 +17,7 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag) import Render.DescSets.Set0 (Scene) import Render.Unlit.Sprite.Code qualified as Code@@ -34,7 +34,7 @@   => Vk.SampleCountFlagBits   -> Maybe Float   -> Bool-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample discardAlpha outline set0 = do@@ -46,13 +46,13 @@ config   :: Maybe Float   -> Bool-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> Config config discardAlpha outline (Tagged set0) =   Graphics.baseConfig     { Graphics.cStages         = stageSpirv     , Graphics.cDescLayouts    = Tagged @'[Scene] [set0]-    , Graphics.cVertexInput    = vertexInput+    , Graphics.cVertexInput    = Graphics.vertexInput @Pipeline     , Graphics.cDepthTest      = False     , Graphics.cDepthWrite     = False     , Graphics.cBlend          = True@@ -60,10 +60,6 @@     , Graphics.cSpecialization = specs     }   where-    vertexInput = Graphics.vertexInput-      [ (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceAttrs)-      ]-     specs =       ( fromMaybe 0.0 discardAlpha       , outline

@@ -1,113 +1,112 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedRecordDot #-}+ module Render.Unlit.Textured.Model   ( Model+  , Vertex   , VertexAttrs-  , vkVertexAttrs -  , InstanceAttrs(..)-  , instanceAttrs--  , StorableAttrs-  , storableAttrs1+  , AttrsF(..)+  , Attrs+  , attrs -  , InstanceBuffers(..)+  , Stores+  , attrStores+  , stores1+  , Buffers    , TextureParams(..)-  , vkInstanceTexture -  , allocateInstancesWith-  , allocateInstancesCoherent-  , allocateInstancesCoherent_-  , updateCoherentResize_-  , Transform+  , ObserverCoherent   ) where  import RIO -import Foreign (Storable(..)) import Geomancy (Transform, Vec2, Vec4) import Geomancy.Vec3 qualified as Vec3 import RIO.Vector.Storable qualified as Storable-import UnliftIO.Resource (MonadResource, ReleaseKey, ResourceT, allocate) import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::)) import Vulkan.Zero (Zero(..))+import Geomancy.Gl.Block (Block)+import Geomancy.Gl.Block qualified as Block -import Engine.Vulkan.Types (HasVulkan)+import Engine.Types (HKD)+import Engine.Vulkan.Format (HasVkFormat(..))+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)+import Engine.Worker qualified as Worker import Resource.Buffer qualified as Buffer import Resource.Model qualified as Model+import Resource.Model.Observer qualified as Observer  type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  type VertexAttrs = "uv" ::: Vec2 -vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32_SFLOAT -- vTexCoord :: vec2-  ]---- | Data for a single element.-data InstanceAttrs = InstanceAttrs-  { textureParams :: TextureParams-  , transformMat4 :: Transform+data AttrsF f = Attrs+  { params     :: HKD f TextureParams+  , transforms :: HKD f Transform   }+  deriving (Generic) -instance Zero InstanceAttrs where-  zero = InstanceAttrs-    { textureParams = zero-    , transformMat4 = mempty+type Attrs = AttrsF Identity+deriving instance Show Attrs++instance HasVertexInputBindings Attrs where+  vertexInputBindings =+    [ instanceFormat @TextureParams+    , instanceFormat @Transform+    ]++type Stores = AttrsF Storable.Vector+deriving instance Show Stores++type Buffers = AttrsF (Buffer.Allocated 'Buffer.Coherent)+deriving instance Show Buffers+instance Observer.VertexBuffers Buffers+type ObserverCoherent = Worker.ObserverIO Buffers++instance Observer.UpdateCoherent Buffers Stores++instance Model.HasVertexBuffers Buffers where+  type VertexBuffersOf Buffers = Attrs++instance Zero Attrs where+  zero = Attrs+    { params = zero+    , transforms = mempty     } -instanceAttrs :: Int32 -> Int32 -> [Transform] -> InstanceAttrs-instanceAttrs samplerId textureId transforms = InstanceAttrs-  { textureParams = zero+attrs :: Int32 -> Int32 -> [Transform] -> Attrs+attrs samplerId textureId transforms = Attrs+  { params = zero       { tpSamplerId = samplerId       , tpTextureId = textureId       }-  , transformMat4 = mconcat transforms+  , transforms = mconcat transforms   } --- | Intermediate data to be shipped.-type StorableAttrs =-  ( Storable.Vector TextureParams-  , Storable.Vector Transform-  )+attrStores :: Foldable t => t Attrs -> Stores+attrStores source = Attrs+  { params = Storable.fromList $ map (.params) $ toList source+  , transforms = Storable.fromList $ map (.transforms) $ toList source+  } -storableAttrs1 :: Int32 -> Int32 -> [Transform] -> StorableAttrs-storableAttrs1 samplerId textureId transforms =-  ( Storable.singleton textureParams-  , Storable.singleton transformMat4-  )+stores1 :: Int32 -> Int32 -> [Transform] -> Stores+stores1 samplerId textureId transforms =+  Attrs+    { params = Storable.singleton attrs1.params+    , transforms = Storable.singleton attrs1.transforms+    }   where-    InstanceAttrs{..} = instanceAttrs+    attrs1 = attrs       samplerId       textureId       transforms --- | GPU-bound data.-data InstanceBuffers textureStage transformStage = InstanceBuffers-  { ibTexture   :: InstanceTexture textureStage-  , ibTransform :: InstanceTransform transformStage-  }--type InstanceTexture stage = Buffer.Allocated stage TextureParams--type InstanceTransform stage = Buffer.Allocated stage Transform--instance Model.HasVertexBuffers (InstanceBuffers textureStage transformStage) where-  type VertexBuffersOf (InstanceBuffers textureStage transformStage) = InstanceAttrs--  {-# INLINE getVertexBuffers #-}-  getVertexBuffers InstanceBuffers{..} =-    [ Buffer.aBuffer ibTexture-    , Buffer.aBuffer ibTransform-    ]--  {-# INLINE getInstanceCount #-}-  getInstanceCount InstanceBuffers{..} =-    min-      (Buffer.aUsed ibTexture)-      (Buffer.aUsed ibTransform)- data TextureParams = TextureParams   { tpScale     :: Vec2   , tpOffset    :: Vec2@@ -115,7 +114,8 @@   , tpSamplerId :: Int32   , tpTextureId :: Int32   }-  deriving (Show)+  deriving (Generic, Show, Block)+  deriving Storable via (Block.Packed TextureParams)  instance Zero TextureParams where   zero = TextureParams@@ -126,91 +126,9 @@     , tpTextureId = minBound     } -instance Storable TextureParams where-  alignment ~_ = 4--  sizeOf ~_ = 8 + 8 + 16 + 4 + 4--  poke ptr TextureParams{..} = do-    pokeByteOff ptr  0 tpScale-    pokeByteOff ptr  8 tpOffset-    pokeByteOff ptr 16 tpGamma-    pokeByteOff ptr 32 tpSamplerId-    pokeByteOff ptr 36 tpTextureId--  peek ptr = do-    tpScale     <- peekByteOff ptr  0-    tpOffset    <- peekByteOff ptr  8-    tpGamma     <- peekByteOff ptr 16-    tpSamplerId <- peekByteOff ptr 32-    tpTextureId <- peekByteOff ptr 36-    pure TextureParams{..}--vkInstanceTexture :: [Vk.Format]-vkInstanceTexture =-  [ Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4-  , Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4-  , Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2-  ]--allocateInstancesWith-  :: ( MonadResource m-     , MonadUnliftIO m-     )-  => (Vk.BufferUsageFlagBits -> Int -> Storable.Vector TextureParams -> m (InstanceTexture texture))-  -> (Vk.BufferUsageFlagBits -> Int -> Storable.Vector Transform -> m (InstanceTransform transform))-  -> (forall stage a . Buffer.Allocated stage a -> m ())-  -> [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers texture transform)-allocateInstancesWith createTextures createTransforms bufferDestroy instances = do-  ul <- askUnliftIO-  allocate (create ul) (destroy ul)-  where-    textures   = Storable.fromList $ map textureParams instances-    transforms = Storable.fromList $ map transformMat4 instances-    numInstances = Storable.length textures--    create (UnliftIO ul) = ul do-      ibTexture   <- createTextures   Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances textures-      ibTransform <- createTransforms Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances transforms-      pure InstanceBuffers{..}--    destroy (UnliftIO ul) InstanceBuffers{..} = ul do-      bufferDestroy ibTexture-      bufferDestroy ibTransform--allocateInstancesCoherent-  :: ( MonadReader env m-     , HasVulkan env-     , MonadResource m-     , MonadUnliftIO m-     )-  => [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent instances = do-  context <- ask-  allocateInstancesWith-    (Buffer.createCoherent context)-    (Buffer.createCoherent context)-    (Buffer.destroy context)-    instances--allocateInstancesCoherent_-  :: (HasVulkan env)-  => Int-  -> ResourceT (RIO env) (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent_ n =-  fmap snd $ allocateInstancesCoherent (replicate n zero)--updateCoherentResize_-  :: ( HasVulkan context-     , MonadUnliftIO m-     )-  => context-  -> InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent-  -> (Storable.Vector TextureParams, Storable.Vector Transform)-  -> m (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-updateCoherentResize_ context InstanceBuffers{..} (textures, transforms) =-  InstanceBuffers-    <$> Buffer.updateCoherentResize_ context ibTexture textures-    <*> Buffer.updateCoherentResize_ context ibTransform transforms+instance HasVkFormat TextureParams where+  getVkFormat =+    [ Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4+    , Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4+    , Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2+    ]

@@ -18,13 +18,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Unlit.Textured.Code qualified as Code import Render.Unlit.Textured.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.Attrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -33,7 +33,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -49,7 +49,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateBlend multisample tset0 rp = do@@ -60,21 +60,14 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos -- vPosition-      , (Vk.VERTEX_INPUT_RATE_VERTEX,   Model.vkVertexAttrs)-      , (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceTexture)-      , instanceTransform-      ] -configBlend :: Tagged Scene DsBindings -> Config+configBlend :: Tagged Scene DsLayoutBindings -> Config configBlend tset0 = (config tset0)   { Graphics.cBlend      = True   , Graphics.cDepthWrite = False

@@ -27,15 +27,19 @@     layout(location = 5) in vec2  iMapTextureSize;     layout(location = 6) in vec2  iTilesetTextureSize;     layout(location = 7) in vec2  iTileSize;+    layout(location = 8) in vec2  iTilesetOffset;+    layout(location = 9) in vec2  iTilesetBorder;      // transformMat-    layout(location = 8) in mat4 iModel;+    layout(location = 10) in mat4 iModel;      layout(location = 0)      out  vec2 fTexCoord;     layout(location = 1)      out  vec2 fPixCoord;     layout(location = 2) flat out ivec4 fTextureIds;-    layout(location = 3) flat out  vec2 fTilesetTextureSize;+    layout(location = 3) flat out  vec2 fTilesetTextureSizeInv;     layout(location = 4) flat out  vec2 fTileSize;+    layout(location = 5) flat out  vec2 fTilesetOffset;+    layout(location = 6) flat out  vec2 fTilesetBorder;      void main() {       vec4 fPosition = iModel * vec4(vPosition, 1.0);@@ -49,8 +53,10 @@       fTexCoord = fPixCoord / iMapTextureSize / iTileSize;        fTextureIds = iTextureIds;-      fTilesetTextureSize = iTilesetTextureSize;+      fTilesetTextureSizeInv = 1.0 / iTilesetTextureSize;       fTileSize = iTileSize;+      fTilesetOffset = iTilesetOffset * fTilesetTextureSizeInv;+      fTilesetBorder = iTilesetBorder * fTilesetTextureSizeInv;     }   |] @@ -68,13 +74,15 @@      // combined: tileset, tileset sampler, map, repeat     layout(location = 2) flat in ivec4 fTextureIds;-    layout(location = 3) flat in vec2 fTilesetTextureSize;+    layout(location = 3) flat in vec2 fTilesetTextureSizeInv;     layout(location = 4) flat in vec2 fTileSize;+    layout(location = 5) flat in vec2 fTilesetOffset;+    layout(location = 6) flat in vec2 fTilesetBorder;      layout(location = 0) out vec4 oColor;      int tilesetTextureIx = fTextureIds[0];-    int tilesetSamplerIx = fTextureIds[1];+    int tilesetSamplerIx = fTextureIds[1]; // XXX: can have repeat, but not mips     int mapTextureIx     = fTextureIds[2];     int repeatTiles      = fTextureIds[3]; @@ -86,24 +94,43 @@         discard;       } -      vec4 map = texture(+      vec4 map = textureLod(         sampler2D(           textures[nonuniformEXT(mapTextureIx)],           samplers[$samplerId]         ),-        fTexCoord+        fTexCoord,+        0       ); -      vec2 spriteOffset = floor(map.xy * 256.0) * fTileSize;+      vec2 tilePos = floor(map.xy * 256.0);+      vec2 spriteOffset = tilePos * fTileSize;+       vec2 spriteCoord = mod(fPixCoord, fTileSize);-      vec2 spriteUV = round(spriteOffset + spriteCoord) / fTilesetTextureSize;+      uint flags = uint(map.w * 256.0); -      oColor = texture(+      // XXX: Anti-diagonal flip first, to allow rotation with H/V flips+      if ((flags & 0x20) == 0x20)+        spriteCoord = spriteCoord.yx;+      if ((flags & 0x40) == 0x40)+        spriteCoord.x = fTileSize.x - spriteCoord.x;+      if ((flags & 0x80) == 0x80)+        spriteCoord.y = fTileSize.y - spriteCoord.y;++      vec2 tilesetPadding = fTilesetOffset + tilePos * fTilesetBorder;++      vec2 spriteUV =+        spriteOffset * fTilesetTextureSizeInv ++        spriteCoord * fTilesetTextureSizeInv ++        tilesetPadding;++      oColor = textureLod(         sampler2D(           textures[nonuniformEXT(tilesetTextureIx)],           samplers[nonuniformEXT(tilesetSamplerIx)]         ),-        spriteUV+        spriteUV,+        0       );     }   |]

@@ -1,92 +1,77 @@+{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}++{-# LANGUAGE DeriveAnyClass #-}+ module Render.Unlit.TileMap.Model   ( Model-  , VertexAttrs-  , vkVertexAttrs -  , InstanceAttrs(..)-  -- , instanceAttrs--  , StorableAttrs-  -- , storableAttrs1+    -- * Vertex data+  , Vertex+  , VertexAttrs -  , InstanceBuffers(..)+    -- * Instance data+  , AttrsF(..)+  , Attrs+  , Stores+  , Buffers    , TileMapParams(..)-  , vkInstanceTileMap -  , allocateInstancesWith-  , allocateInstancesCoherent-  , allocateInstancesCoherent_-  , updateCoherentResize_-  , Transform+  , ObserverCoherent   ) where  import RIO -import Foreign (Storable(..))+import Foreign.Storable.Generic (GStorable) import Geomancy (IVec4, Transform, Vec2) import Geomancy.Vec3 qualified as Vec3 import RIO.Vector.Storable qualified as Storable-import UnliftIO.Resource (MonadResource, ReleaseKey, ResourceT, allocate)-import Vulkan.Core10 qualified as Vk import Vulkan.NamedType ((:::)) import Vulkan.Zero (Zero(..)) -import Engine.Vulkan.Types (HasVulkan)+import Engine.Types (HKD)+import Engine.Vulkan.Format (HasVkFormat)+import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)+import Engine.Worker qualified as Worker import Resource.Buffer qualified as Buffer import Resource.Model qualified as Model+import Resource.Model.Observer qualified as Observer +-- XXX: Can be a quad, full screen-triangle or fancy-shaped viewport. type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs+type Vertex = Model.Vertex3d VertexAttrs  type VertexAttrs = "uv" ::: Vec2 -vkVertexAttrs :: [Vk.Format]-vkVertexAttrs =-  [ Vk.FORMAT_R32G32_SFLOAT -- vTexCoord :: vec2-  ]---- | Data for a single element.-data InstanceAttrs = InstanceAttrs-  { tilemapParams :: TileMapParams-  , transformMat4 :: Transform+data AttrsF f = Attrs+  { params     :: HKD f TileMapParams+  , transforms :: HKD f Transform   }--instance Zero InstanceAttrs where-  zero = InstanceAttrs-    { tilemapParams = zero-    , transformMat4 = mempty-    }---- | Intermediate data to be shipped.-type StorableAttrs =-  ( Storable.Vector TileMapParams-  , Storable.Vector Transform-  )+  deriving (Generic) --- | GPU-bound data.-data InstanceBuffers tilemapStage transformStage = InstanceBuffers-  { ibTileMap   :: InstanceTileMap tilemapStage-  , ibTransform :: InstanceTransform transformStage-  }+type Attrs = AttrsF Identity+deriving instance Show Attrs+-- XXX: not correct, but shouldn't be needed+-- instance GStorable Attrs -type InstanceTileMap stage = Buffer.Allocated stage TileMapParams+instance HasVertexInputBindings Attrs where+  vertexInputBindings =+    [ instanceFormat @TileMapParams+    , instanceFormat @Transform+    ] -type InstanceTransform stage = Buffer.Allocated stage Transform+type Stores = AttrsF Storable.Vector+deriving instance Show Stores -instance Model.HasVertexBuffers (InstanceBuffers tilemapStage transformStage) where-  type VertexBuffersOf (InstanceBuffers tilemapStage transformStage) = InstanceAttrs+type Buffers = AttrsF (Buffer.Allocated 'Buffer.Coherent)+deriving instance Show Buffers+instance Observer.VertexBuffers Buffers+type ObserverCoherent = Worker.ObserverIO Buffers -  {-# INLINE getVertexBuffers #-}-  getVertexBuffers InstanceBuffers{..} =-    [ Buffer.aBuffer ibTileMap-    , Buffer.aBuffer ibTransform-    ]+instance Observer.UpdateCoherent Buffers Stores -  {-# INLINE getInstanceCount #-}-  getInstanceCount InstanceBuffers{..} =-    min-      (Buffer.aUsed ibTileMap)-      (Buffer.aUsed ibTransform)+instance Model.HasVertexBuffers Buffers where+  type VertexBuffersOf Buffers = Attrs  data TileMapParams = TileMapParams   { tmpTextureIds         :: IVec4@@ -95,9 +80,14 @@   , tmpMapTextureSize     :: Vec2   , tmpTilesetTextureSize :: Vec2   , tmpTileSize           :: Vec2+  , tmpTilesetOffset      :: Vec2+  , tmpTilesetBorder      :: Vec2   }-  deriving (Show)+  deriving (Generic, Show, HasVkFormat) +-- XXX: okay, the layout matches+instance GStorable TileMapParams+ instance Zero TileMapParams where   zero = TileMapParams     { tmpTextureIds         = 0@@ -106,98 +96,6 @@     , tmpMapTextureSize     = 1     , tmpTilesetTextureSize = 1     , tmpTileSize           = 1+    , tmpTilesetOffset      = 0+    , tmpTilesetBorder      = 0     }--instance Storable TileMapParams where-  alignment ~_ = 4--  sizeOf ~_ = 16 + 8 + 8 + 8 + 8 + 8--  poke ptr TileMapParams{..} = do-    pokeByteOff ptr  0 tmpTextureIds-    pokeByteOff ptr 16 tmpViewOffset-    pokeByteOff ptr 24 tmpViewportSize-    pokeByteOff ptr 32 tmpMapTextureSize-    pokeByteOff ptr 40 tmpTilesetTextureSize-    pokeByteOff ptr 48 tmpTileSize--  peek ptr = do-    tmpTextureIds         <- peekByteOff ptr  0-    tmpViewOffset         <- peekByteOff ptr 16-    tmpViewportSize       <- peekByteOff ptr 24-    tmpMapTextureSize     <- peekByteOff ptr 32-    tmpTilesetTextureSize <- peekByteOff ptr 48-    tmpTileSize           <- peekByteOff ptr 56-    pure TileMapParams{..}--vkInstanceTileMap :: [Vk.Format]-vkInstanceTileMap =-  [ Vk.FORMAT_R32G32B32A32_SINT -- tmpTextureIds         :: IVec4-  , Vk.FORMAT_R32G32_SFLOAT     -- tmpViewOffset         :: Vec2-  , Vk.FORMAT_R32G32_SFLOAT     -- tmpViewportSize       :: Vec2-  , Vk.FORMAT_R32G32_SFLOAT     -- tmpMapTextureSize     :: Vec2-  , Vk.FORMAT_R32G32_SFLOAT     -- tmpTilesetTextureSize :: Vec2-  , Vk.FORMAT_R32G32_SFLOAT     -- tmpTileSize           :: Vec2-  ]--allocateInstancesWith-  :: ( MonadResource m-     , MonadUnliftIO m-     )-  => (Vk.BufferUsageFlagBits -> Int -> Storable.Vector TileMapParams -> m (InstanceTileMap texture))-  -> (Vk.BufferUsageFlagBits -> Int -> Storable.Vector Transform -> m (InstanceTransform transform))-  -> (forall stage a . Buffer.Allocated stage a -> m ())-  -> [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers texture transform)-allocateInstancesWith createTextures createTransforms bufferDestroy instances = do-  ul <- askUnliftIO-  allocate (create ul) (destroy ul)-  where-    textures   = Storable.fromList $ map tilemapParams instances-    transforms = Storable.fromList $ map transformMat4 instances-    numInstances = Storable.length textures--    create (UnliftIO ul) = ul do-      ibTileMap   <- createTextures   Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances textures-      ibTransform <- createTransforms Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT numInstances transforms-      pure InstanceBuffers{..}--    destroy (UnliftIO ul) InstanceBuffers{..} = ul do-      bufferDestroy ibTileMap-      bufferDestroy ibTransform--allocateInstancesCoherent-  :: ( MonadReader env m-     , HasVulkan env-     , MonadResource m-     , MonadUnliftIO m-     )-  => [InstanceAttrs]-  -> m (ReleaseKey, InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent instances = do-  context <- ask-  allocateInstancesWith-    (Buffer.createCoherent context)-    (Buffer.createCoherent context)-    (Buffer.destroy context)-    instances--allocateInstancesCoherent_-  :: (HasVulkan env)-  => Int-  -> ResourceT (RIO env) (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-allocateInstancesCoherent_ n =-  fmap snd $ allocateInstancesCoherent (replicate n zero)--updateCoherentResize_-  :: ( HasVulkan context-     , MonadUnliftIO m-     )-  => context-  -> InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent-  -> (Storable.Vector TileMapParams, Storable.Vector Transform)-  -> m (InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-updateCoherentResize_ context InstanceBuffers{..} (textures, transforms) =-  InstanceBuffers-    <$> Buffer.updateCoherentResize_ context ibTileMap textures-    <*> Buffer.updateCoherentResize_ context ibTransform transforms

@@ -17,13 +17,13 @@ import Vulkan.Core10 qualified as Vk  import Engine.Vulkan.Pipeline.Graphics qualified as Graphics-import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)+import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..)) import Render.Code (compileVert, compileFrag)-import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)+import Render.DescSets.Set0 (Scene) import Render.Unlit.TileMap.Code qualified as Code import Render.Unlit.TileMap.Model qualified as Model -type Pipeline = Graphics.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs+type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.Attrs type Config = Graphics.Configure Pipeline type instance Graphics.Specialization Pipeline = () @@ -32,7 +32,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocate multisample tset0 rp = do@@ -48,7 +48,7 @@      , HasRenderPass renderpass      )   => Vk.SampleCountFlagBits-  -> Tagged Scene DsBindings+  -> Tagged Scene DsLayoutBindings   -> renderpass   -> ResourceT (RIO env) Pipeline allocateBlend multisample tset0 rp = do@@ -59,21 +59,14 @@     rp   pure p -config :: Tagged Scene DsBindings -> Config+config :: Tagged Scene DsLayoutBindings -> Config config (Tagged set0) = Graphics.baseConfig   { Graphics.cDescLayouts  = Tagged @'[Scene] [set0]   , Graphics.cStages       = stageSpirv-  , Graphics.cVertexInput  = vertexInput+  , Graphics.cVertexInput  = Graphics.vertexInput @Pipeline   }-  where-    vertexInput = Graphics.vertexInput-      [ vertexPos-      , (Vk.VERTEX_INPUT_RATE_VERTEX,   Model.vkVertexAttrs)-      , (Vk.VERTEX_INPUT_RATE_INSTANCE, Model.vkInstanceTileMap)-      , instanceTransform-      ] -configBlend :: Tagged Scene DsBindings -> Config+configBlend :: Tagged Scene DsLayoutBindings -> Config configBlend tset0 = (config tset0)   { Graphics.cBlend      = True   , Graphics.cDepthWrite = False

@@ -1,11 +1,9 @@ module Resource.Font   ( Config(..)-  , allocateCollection   , collectionTextures    , Font(..)-  , allocateFont-+  , allocate   ) where  import RIO@@ -19,8 +17,7 @@ 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+import Resource.Texture.Ktx2 qualified as Ktx2  -- * General collection tools @@ -30,23 +27,6 @@   }   deriving (Show) -allocateCollection-  :: ( Traversable collection-     , MonadVulkan env m-     , HasLogFunc env-     , MonadThrow m-     , Resource.MonadResource m-     , HasCallStack-     )-  => Queues Vk.CommandPool-  -> collection Config-  -> m (Resource.ReleaseKey, collection Font)-allocateCollection pools collection = do-  collected <- for collection $-    withFrozenCallStack $ allocateFont pools-  key <- Resource.register $ traverse_ Resource.release $ fmap fst collected-  pure (key, fmap snd collected)- collectionTextures :: Foldable collection => collection Font -> Vector (Texture Flat) collectionTextures = Vector.fromList . map texture . toList @@ -57,7 +37,7 @@   , texture   :: Texture Flat   } -allocateFont+allocate   :: ( HasCallStack      , MonadVulkan env m      , HasLogFunc env@@ -66,18 +46,12 @@      )   => Queues Vk.CommandPool   -> Config-  -> m (Resource.ReleaseKey, Font)-allocateFont pools Config{..} = do-  context <- ask-+  -> m Font+allocate pools Config{..} = do   container <- withFrozenCallStack $     EvanW.load configContainer -  createTexture <- toIO $ withFrozenCallStack $-    Ktx1.load pools configTexture--  (textureKey, texture) <- Resource.allocate-    createTexture-    (Texture.destroy context)+  texture <- withFrozenCallStack $+    Ktx2.load pools configTexture -  pure (textureKey, Font{..})+  pure Font{..}

@@ -46,7 +46,7 @@   usePass (Basic.rpForwardMsaa fRenderpass) imageIndex cb do     Swapchain.setDynamicFullscreen cb fSwapchainResources -    Set0.withBoundSet0 frSceneUi pWireframe cb do+    Set0.withBoundSet0 frSceneUi pUnlitTexturedBlend cb do       -- Render UI       Graphics.bind cb pUnlitTexturedBlend do         Draw.indexed cb (UI.quadUV ui) background

@@ -5,6 +5,8 @@  import RIO +import UnliftIO.Resource (MonadResource)+ import Engine.Camera qualified as Camera import Engine.Worker qualified as Worker import Render.DescSets.Set0 (Scene(..), emptyScene)@@ -12,7 +14,8 @@ type Process = Worker.Merge Scene  spawn-  :: ( MonadUnliftIO m+  :: ( MonadResource m+     , MonadUnliftIO m      , Worker.HasOutput projection      , Worker.GetOutput projection ~ Camera.Projection 'Camera.Orthographic      )

@@ -27,17 +27,17 @@ 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 qualified as Texture-import Resource.Texture.Ktx1 qualified as Ktx1+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.Types (FrameResources(..), RunState(..)) import Stage.Loader.Scene qualified as Scene+import Stage.Loader.Types (FrameResources(..), RunState(..)) import Stage.Loader.UI qualified as UI  bootstrap@@ -46,7 +46,7 @@   -> (Source, Source)   -> ((Text -> StageSetupRIO ()) -> StageSetupRIO loaded)   -> (loaded -> StackStage)-  -> ( (Setup Vector Vector loaded -> Engine.StackStage)+  -> ( Setup Vector Vector loaded -> Engine.StackStage      , Engine.StageSetupRIO (Setup Vector Vector loaded)      ) bootstrap titleMessage (smallFont, largeFont) (bgPath, spinnerPath) loadAction nextStage =@@ -55,15 +55,8 @@     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 Source-      (textureKey, textures) <- Texture.allocateCollectionWith-        (Ktx1.load pools)-        texturePaths+      fonts <- traverse (Font.allocate pools) [smallFont, largeFont]+      textures <- traverse (Ktx2.load pools) [bgPath, spinnerPath]        let         fontContainers = fmap Font.container fonts@@ -85,12 +78,6 @@           , largeFont = \fs -> fs ! 1           } -      loaderKey <- Resource.register $-        traverse_ @[] Resource.release-          [ fontKey-          , textureKey-          ]-       logDebug "Finished bootstrapping loader"       pure Setup{..} @@ -98,7 +85,6 @@   { loadAction :: (Text -> StageSetupRIO ()) -> StageSetupRIO loaded   , nextStage  :: loaded -> StackStage   , uiSettings :: UI.Settings textures fonts-  , loaderKey  :: Resource.ReleaseKey   }  stackStageBootstrap@@ -138,8 +124,7 @@      allocatePipelines swapchain rps = do       logDebug "Allocating loader pipelines"-      (_, samplers) <- Samplers.allocate-        (Swapchain.getAnisotropy swapchain)+      samplers <- Samplers.allocate (Swapchain.getAnisotropy swapchain)       Basic.allocatePipelines         (sceneBinds samplers)         (Swapchain.getMultisample swapchain)@@ -168,21 +153,18 @@   -> UI.Settings textures fonts   -> StageSetupRIO (Resource.ReleaseKey, RunState) initialRunState loadAction nextStage uiSettings =-  withPools \pools -> do-    (projectionKey, rsProjectionP) <- Worker.registered-      Camera.spawnOrthoPixelsCentered--    (sceneUiKey, rsSceneUiP) <- Worker.registered $-      Scene.spawn rsProjectionP+  withPools \pools -> Region.run do+    rsProjectionP <- Camera.spawnOrthoPixelsCentered -    context <- ask+    rsSceneUiP <- Scene.spawn rsProjectionP -    rsQuadUV <- Model.createStagedL context pools (Quad.toVertices Quad.texturedQuad) Nothing-    quadKey <- Resource.register $ Model.destroyIndexed context rsQuadUV+    rsQuadUV <- Model.createStagedL (Just "rsQuadUV") pools (Quad.toVertices Quad.texturedQuad) Nothing+    Model.registerIndexed_ rsQuadUV -    (screenKey, screenBoxP) <- Worker.registered Layout.trackScreen+    screenBoxP <- Layout.trackScreen -    (uiKey, rsUI) <- UI.spawn pools screenBoxP uiSettings+    rsUI <- Region.local $+      UI.spawn pools screenBoxP uiSettings      let       updateProgress text = do@@ -191,16 +173,7 @@           { Message.inputText = text           } -    releaseKeys <- Resource.register $-      traverse_ @[] Resource.release-        [ projectionKey-        , sceneUiKey-        , quadKey-        , screenKey-        , uiKey-        ]--    switcher <- async do+    switcher <- lift $ async do       loader <- async do         logDebug "Starting load action"         try (loadAction updateProgress) >>= \case@@ -229,7 +202,7 @@     -- XXX: propagate exceptions from loader threads     link switcher -    pure (releaseKeys, RunState{..})+    pure RunState{..}  initialFrameResources   :: (Traversable fonts, Traversable textures)

@@ -15,7 +15,6 @@ 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@@ -30,6 +29,8 @@ import Resource.Combined.Textures qualified as CombinedTextures import Resource.Font.EvanW qualified as EvanW import Resource.Model qualified as Model+import Resource.Model.Observer qualified as Observer+import Resource.Region qualified as Region import Resource.Texture (Texture, Flat)  data Settings fonts textures = Settings@@ -51,31 +52,24 @@   , progressInput :: Worker.Var Message.Input   , progressP     :: Message.Process -  , backgroundP :: Worker.Merge StorableAttrs-  , spinnerP    :: Worker.Merge StorableAttrs+  , backgroundP :: Worker.Merge UnlitTextured.Stores+  , spinnerP    :: Worker.Merge UnlitTextured.Stores    , 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+spawn pools screenBoxP Settings{..} = Region.run do   paddingVar <- Worker.newVar 16-  (screenPaddedKey, screenPaddedP) <- Worker.registered $-    Layout.padAbs screenBoxP paddingVar+  screenPaddedP <- 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] ->@@ -83,24 +77,20 @@     _ ->       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+  titleP <- Worker.newVar title >>= Message.spawn titleBoxP+  subtitleP <- Worker.newVar subtitle >>= Message.spawn subtitleBoxP    progressInput <- Worker.newVar progress-  (progressKey, progressP) <- Worker.registered $-    Message.spawn progressBoxP progressInput+  progressP <- Message.spawn progressBoxP progressInput    -- Splash -  (backgroundBoxKey, backgroundBoxP) <- Worker.registered $-    Layout.fitPlaceAbs Layout.Center 1.0 screenBoxP+  backgroundBoxP <- Layout.fitPlaceAbs Layout.Center 1.0 screenBoxP -  (backgroundKey, backgroundP) <- Worker.registered $+  backgroundP <-     Worker.spawnMerge1       ( \box ->-          UnlitTextured.storableAttrs1+          UnlitTextured.stores1               (Samplers.linear Samplers.indices)               backgroundIx               [Layout.boxTransformAbs box]@@ -109,20 +99,20 @@    -- Spinner -  (spinnerTransformTimeKey, spinnerTransformTimeP) <- Worker.registered $+  spinnerTransformTimeP <-     Worker.spawnTimed_ True 100 mempty do       t <- getMonotonicTime       pure $ Transform.rotateZ (realToFrac t) -  (spinnerTransformBoxKey, spinnerTransformBoxP) <- Worker.registered $+  spinnerTransformBoxP <-     Worker.spawnMerge1       (Layout.boxTransformAbs . snd . Layout.boxFitScale 64)       subtitleBoxP -  (spinnerKey, spinnerP) <- Worker.registered $+  spinnerP <-     Worker.spawnMerge2       ( \place turn ->-          UnlitTextured.storableAttrs1+          UnlitTextured.stores1               (Samplers.linear Samplers.indices)               spinnerIx               [turn, place]@@ -132,22 +122,14 @@    -- 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-    ]+  quadUV <- Model.createStagedL+    (Just "quadUV")+    pools+    (Quad.toVertices Quad.texturedQuad)+    Nothing+  Model.registerIndexed_ quadUV -  pure (key, UI{..})+  pure UI{..}   where     title = Message.Input       { inputText         = titleMessage@@ -187,8 +169,8 @@  data Observer = Observer   { messages   :: [Message.Observer]-  , background :: Worker.ObserverIO (UnlitTextured.InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)-  , spinner    :: Worker.ObserverIO (UnlitTextured.InstanceBuffers 'Buffer.Coherent 'Buffer.Coherent)+  , background :: UnlitTextured.ObserverCoherent+  , spinner    :: UnlitTextured.ObserverCoherent   }  newObserver :: UI -> ResourceT (Engine.StageRIO st) Observer@@ -200,12 +182,8 @@     , progressP     ] -  let-    newBufferObserver1 =-      UnlitTextured.allocateInstancesCoherent_ 1 >>= Worker.newObserverIO--  background <- newBufferObserver1-  spinner <- newBufferObserver1+  background <- Observer.newCoherent 1 "background"+  spinner <- Observer.newCoherent 1 "spinner"    pure Observer{..} @@ -218,10 +196,5 @@   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+  Observer.observeCoherent backgroundP background+  Observer.observeCoherent spinnerP spinner