diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Changelog for keid-core +## 0.1.3.0 + +- Changed mesh codec to use `Serialise` class instead of `Storable`. +- Replaced RIO in resource loaders with constraints. +- Added `Render.Pass` base module and `Render.Pass.Offscreen`. +- `Resource.Image.AllocatedImage` got format and subresource information. +- Removed `Resource.Image.createColorResource`, `Resource.Image.createDepthResource`. + * Added unified `Resource.Image.create` instead. + * Function names shortened to match qulified import style. + ## 0.1.2.0 - Added `Resource.Source` type to mix external and embedded byte sources. diff --git a/keid-core.cabal b/keid-core.cabal --- a/keid-core.cabal +++ b/keid-core.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: keid-core -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Core parts of Keid engine. category: Game Engine author: IC Rainbow @@ -57,6 +57,8 @@ Render.Code Render.Code.Noise Render.Draw + Render.Pass + Render.Pass.Offscreen Render.Samplers Resource.Buffer Resource.Collection @@ -157,6 +159,7 @@ , resourcet , rio >=0.1.12.0 , rio-app + , serialise , tagged , template-haskell , text diff --git a/src/Engine/Vulkan/Types.hs b/src/Engine/Vulkan/Types.hs --- a/src/Engine/Vulkan/Types.hs +++ b/src/Engine/Vulkan/Types.hs @@ -58,16 +58,6 @@ getDevice = getDevice . fst getAllocator = getAllocator . fst -instance (HasSwapchain context) => HasSwapchain (a, context) where - getSurfaceExtent = getSurfaceExtent . snd - getSurfaceFormat = getSurfaceFormat . snd - getDepthFormat = getDepthFormat . snd - getMultisample = getMultisample . snd - getAnisotropy = getAnisotropy . snd - getSwapchainViews = getSwapchainViews . snd - getMinImageCount = getMinImageCount . snd - getImageCount = getImageCount . snd - -- TODO getPipelineCache :: {- HasVulkan ctx => -} ctx -> Vk.PipelineCache getPipelineCache _ctx = Vk.NULL_HANDLE diff --git a/src/Render/Pass.hs b/src/Render/Pass.hs new file mode 100644 --- /dev/null +++ b/src/Render/Pass.hs @@ -0,0 +1,28 @@ +module Render.Pass + ( usePass + + , beginInfo + ) where + +import RIO + +import RIO.Vector.Partial ((!)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Zero (zero) + +import Engine.Vulkan.Types (HasRenderPass(..)) + +usePass :: (MonadIO io, HasRenderPass a) => a -> Word32 -> Vk.CommandBuffer -> io r -> io r +usePass render imageIndex cb = + Vk.cmdUseRenderPass + cb + (beginInfo render imageIndex) + Vk.SUBPASS_CONTENTS_INLINE + +beginInfo :: HasRenderPass a => a -> Word32 -> Vk.RenderPassBeginInfo '[] +beginInfo rp imageIndex = zero + { Vk.renderPass = getRenderPass rp + , Vk.framebuffer = getFramebuffers rp ! fromIntegral imageIndex + , Vk.renderArea = getRenderArea rp + , Vk.clearValues = getClearValues rp + } diff --git a/src/Render/Pass/Offscreen.hs b/src/Render/Pass/Offscreen.hs new file mode 100644 --- /dev/null +++ b/src/Render/Pass/Offscreen.hs @@ -0,0 +1,347 @@ +{-# LANGUAGE OverloadedLists #-} + +module Render.Pass.Offscreen + ( Settings(..) + , allocate + , Offscreen(..) + , colorTexture + , colorCube + , depthTexture + , depthCube + ) 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.Core11.Promoted_From_VK_KHR_multiview qualified as Khr +import Vulkan.CStruct.Extends (pattern (:&), pattern (::&)) +import Vulkan.Utils.Debug qualified as Debug +import Vulkan.Zero (zero) + +import Engine.Types.RefCounted (RefCounted, newRefCounted, resourceTRefCount) +import Engine.Vulkan.Types (HasVulkan(..), HasRenderPass(..), RenderPass(..), MonadVulkan) +import Resource.Image (AllocatedImage) +import Resource.Image qualified as Image +import Resource.Texture (CubeMap, Flat, Texture(..)) + +{- XXX: Consider spec wrt. parameters and intended use! + +https://www.khronos.org/registry/vulkan/specs/1.2-extensions/man/html/vkCmdBlitImage.html +-} +data Settings = Settings + { sLabel :: Text + , sExtent :: Vk.Extent2D + , sFormat :: Vk.Format + , sDepthFormat :: Vk.Format + , sLayers :: Word32 + , sMultiView :: Bool -- ^ Makes sense only for multiple layers. + , sSamples :: Vk.SampleCountFlagBits -- ^ Multisample prevents mipmapping and cubes. + , sMipMap :: Bool + } + deriving (Eq, Show) + +data Offscreen = Offscreen + { oRenderPass :: Vk.RenderPass + , oExtent :: Vk.Extent2D + , oColor :: AllocatedImage + , oDepth :: AllocatedImage + , oLayers :: Word32 + , oMipLevels :: Word32 + + , oFrameBuffer :: Vk.Framebuffer + , oRenderArea :: Vk.Rect2D + , oClear :: Vector Vk.ClearValue + , oRelease :: RefCounted + } + +instance HasRenderPass Offscreen where + getRenderPass = oRenderPass + getFramebuffers = Vector.replicate 10 . oFrameBuffer + getClearValues = oClear + getRenderArea = oRenderArea + +instance RenderPass Offscreen where + allocateRenderpass_ = error "Don't allocate Offscreen via class" + updateRenderpass = error "Don't recreate Offscreen on resize" + + refcountRenderpass = resourceTRefCount . oRelease + +colorTexture :: Offscreen -> Texture Flat +colorTexture Offscreen{..} = Texture + { tFormat = Image.aiFormat oColor + , tMipLevels = oMipLevels + , tLayers = oLayers + , tAllocatedImage = oColor + } + +colorCube :: Offscreen -> Texture CubeMap +colorCube Offscreen{..} = Texture + { tFormat = Image.aiFormat oColor + , tMipLevels = oMipLevels + , tLayers = oLayers -- TODO: get from type param + , tAllocatedImage = oColor + } + +depthTexture :: Offscreen -> Texture Flat +depthTexture Offscreen{..} = Texture + { tFormat = Image.aiFormat oDepth + , tMipLevels = oMipLevels + , tLayers = oLayers + , tAllocatedImage = oDepth + } + +depthCube :: Offscreen -> Texture CubeMap +depthCube Offscreen{..} = Texture + { tFormat = Image.aiFormat oDepth + , tMipLevels = oMipLevels + , tLayers = oLayers -- TODO: get from type param + , tAllocatedImage = oDepth + } + +allocate + :: ( Resource.MonadResource m + , MonadVulkan env m + , HasLogFunc env + ) + => Settings + -> m Offscreen +allocate settings@Settings{..} = do + logDebug $ "Allocating Offscreen resources for " <> display sLabel + + (_rpKey, renderPass) <- allocateRenderPass settings + + (refcounted, color, depth, framebuffer) <- allocateFramebuffer settings renderPass + + pure Offscreen + { oRenderPass = renderPass + , oRenderArea = fullSurface + , oExtent = sExtent + , oMipLevels = 1 + , oLayers = sLayers + , oClear = clear + , oColor = color + , oDepth = depth + , oFrameBuffer = framebuffer + , oRelease = refcounted + } + where + fullSurface = Vk.Rect2D + { Vk.offset = zero + , Vk.extent = sExtent + } + + clear = Vector.fromList + [ Vk.Color $ Vk.Float32 0 0 0 1 + , Vk.DepthStencil (Vk.ClearDepthStencilValue 1.0 0) + ] + +-- ** Render pass + +allocateRenderPass + :: ( MonadVulkan env m + , Resource.MonadResource m + ) + => Settings + -> m (Resource.ReleaseKey, Vk.RenderPass) +allocateRenderPass settings = do + device <- asks getDevice + + res <- + if sMultiView settings then + Vk.withRenderPass device createInfoMulti Nothing Resource.allocate + else + Vk.withRenderPass device createInfo Nothing Resource.allocate + Debug.nameObject device (snd res) $ "Offscreen:" <> encodeUtf8 (sLabel settings) + pure res + where + createInfo = + zero + { Vk.attachments = Vector.fromList [color, depth] + , Vk.subpasses = Vector.fromList [subpass] + , Vk.dependencies = deps + } + + createInfoMulti = + createInfo + ::& Khr.RenderPassMultiviewCreateInfo + { Khr.viewMasks = [2 ^ sLayers settings - 1] + , Khr.viewOffsets = [] + , Khr.correlationMasks = [0] + } + :& () + + color = zero + { Vk.format = sFormat settings + , Vk.samples = sSamples settings + , Vk.initialLayout = Vk.IMAGE_LAYOUT_UNDEFINED + , Vk.finalLayout = Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL + , Vk.loadOp = Vk.ATTACHMENT_LOAD_OP_CLEAR + , Vk.storeOp = Vk.ATTACHMENT_STORE_OP_STORE + , Vk.stencilLoadOp = Vk.ATTACHMENT_LOAD_OP_DONT_CARE + , Vk.stencilStoreOp = Vk.ATTACHMENT_STORE_OP_DONT_CARE + } + + depth = zero + { Vk.format = sDepthFormat settings + , Vk.samples = sSamples settings + , Vk.initialLayout = Vk.IMAGE_LAYOUT_UNDEFINED + , Vk.finalLayout = Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL + , 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 + } + + 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 + } + , Vk.depthStencilAttachment = Just zero + { Vk.attachment = 1 + , Vk.layout = Vk.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL + } + } + + {- BUG: Validation Error: [ SYNC-HAZARD-READ_AFTER_WRITE ] + + vkCmdDraw: Hazard READ_AFTER_WRITE for VkImageView 0x2c0a7b0[], + in VkCommandBuffer 0x3297680[], + and VkPipeline 0x3203390[Global.Render.EnvCube.Pipeline], + VkDescriptorSet 0x3248050[], + type: VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE, + imageLayout: VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL, + binding #3, index 5. + Access info ( + usage: SYNC_FRAGMENT_SHADER_SHADER_STORAGE_READ, + prior_usage: SYNC_COLOR_ATTACHMENT_OUTPUT_COLOR_ATTACHMENT_WRITE, + write_barriers: 0, + command: vkCmdBeginRenderPass, + seq_no: 26, + reset_no: 1 + ). + -} + deps = + [ zero + { Vk.dependencyFlags = Vk.DEPENDENCY_BY_REGION_BIT + , Vk.srcSubpass = Vk.SUBPASS_EXTERNAL + , Vk.dstSubpass = 0 + , Vk.srcStageMask = Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT + , Vk.dstStageMask = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT .|. Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT .|. Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT + , Vk.srcAccessMask = Vk.ACCESS_SHADER_READ_BIT .|. Vk.ACCESS_SHADER_WRITE_BIT + , Vk.dstAccessMask = Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT .|. Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT + } + , zero + { Vk.dependencyFlags = Vk.DEPENDENCY_BY_REGION_BIT + , Vk.srcSubpass = 0 + , Vk.dstSubpass = Vk.SUBPASS_EXTERNAL + , Vk.srcStageMask = Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT .|. Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT .|. Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT + , Vk.dstStageMask = Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT + , Vk.srcAccessMask = Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT .|. Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT + , Vk.dstAccessMask = Vk.ACCESS_SHADER_READ_BIT + } + ] + +-- ** Framebuffer + +type FramebufferOffscreen = + ( RefCounted + , Image.AllocatedImage + , Image.AllocatedImage + , Vk.Framebuffer + ) + +allocateFramebuffer + :: ( Resource.MonadResource m + , MonadVulkan env m + , HasLogFunc env + ) + => Settings + -> Vk.RenderPass + -> m FramebufferOffscreen +allocateFramebuffer Settings{..} renderPass = do + context <- ask + let device = getDevice context + let + Vk.Extent2D{width, height} = sExtent + mipLevels = extentMips sExtent + + (colorKey, color) <- Resource.allocate + ( Image.create + context + (Just $ sLabel <> ".color") + Vk.IMAGE_ASPECT_COLOR_BIT + sExtent + (if sMipMap then mipLevels else 1) + sLayers + sSamples + sFormat + (Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT .|. Vk.IMAGE_USAGE_SAMPLED_BIT) + ) + (Image.destroy context) + + (depthKey, depth) <- Resource.allocate + ( Image.create + context + (Just $ sLabel <> ".depth") + Vk.IMAGE_ASPECT_DEPTH_BIT + sExtent + (if sMipMap then mipLevels else 1) + sLayers + sSamples + sDepthFormat + (Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT .|. Vk.IMAGE_USAGE_SAMPLED_BIT) + ) + (Image.destroy context) + + let + attachments = Vector.fromList + [ Image.aiImageView color + , Image.aiImageView depth + ] + + {- XXX: + If the render pass uses multiview, then layers must be one and each attachment + requires a number of layers that is greater than the maximum bit index set in + the view mask in the subpasses in which it is used. + -} + fbNumLayers = + if sMultiView then + 1 + else + sLayers + + fbCI = zero + { Vk.renderPass = renderPass + , Vk.width = width + , Vk.height = height + , Vk.attachments = attachments + , Vk.layers = fbNumLayers + } + + (framebufferKey, framebuffer) <- Vk.withFramebuffer device fbCI Nothing Resource.allocate + Debug.nameObject device framebuffer $ encodeUtf8 sLabel <> ".FB" + + releaseDebug <- toIO $ logDebug "Releasing Offscreen resources" + release <- newRefCounted do + releaseDebug + Resource.release colorKey + Resource.release depthKey + Resource.release framebufferKey + + pure (release, color, depth, framebuffer) + +extentMips :: Num t => Vk.Extent2D -> t +extentMips Vk.Extent2D{width, height} = go 1 (min width height) + where + go levels = \case + 0 -> + levels + 1 -> + levels + side -> + go (levels + 1) (side `div` 2) diff --git a/src/Render/Samplers.hs b/src/Render/Samplers.hs --- a/src/Render/Samplers.hs +++ b/src/Render/Samplers.hs @@ -25,14 +25,14 @@ import Resource.Collection qualified as Collection data Collection a = Collection - { linearMipRepeat :: a - , linearMip :: a - , linearRepeat :: a - , linear :: a - , nearestMipRepeat :: a - , nearestMip :: a - , nearestRepeat :: a - , nearest :: a + { linearMipRepeat :: a -- 0 + , linearMip :: a -- 1 + , linearRepeat :: a -- 2 + , linear :: a -- 3 + , nearestMipRepeat :: a -- 4 + , nearestMip :: a -- 5 + , nearestRepeat :: a -- 6 + , nearest :: a -- 7 } deriving stock (Show, Functor, Foldable, Traversable, Generic, Generic1) deriving Applicative via (Co Collection) diff --git a/src/Resource/Image.hs b/src/Resource/Image.hs --- a/src/Resource/Image.hs +++ b/src/Resource/Image.hs @@ -1,4 +1,11 @@ -module Resource.Image where +module Resource.Image + ( AllocatedImage(..) + , create + , destroy + , subresource + , transitionLayout + , copyBufferToImage + ) where import RIO @@ -11,137 +18,65 @@ import Vulkan.Zero (zero) import VulkanMemoryAllocator qualified as VMA -import Engine.Vulkan.Types (HasVulkan(..), HasSwapchain(..), Queues(..)) +import Engine.Vulkan.Types (HasVulkan(..), Queues(..)) import Resource.CommandBuffer (oneshot_) data AllocatedImage = AllocatedImage - { aiAllocation :: VMA.Allocation - , aiImage :: Vk.Image - , aiImageView :: Vk.ImageView + { aiAllocation :: VMA.Allocation + , aiFormat :: Vk.Format + , aiImage :: Vk.Image + , aiImageView :: Vk.ImageView + , aiImageRange :: Vk.ImageSubresourceRange } deriving (Show) -createColorResource +create :: ( MonadIO io , HasVulkan ctx - , HasSwapchain ctx ) => ctx + -> Maybe Text + -> Vk.ImageAspectFlags -> Vk.Extent2D + -> "mip levels" ::: Word32 + -> "stored layers" ::: Word32 + -> Vk.SampleCountFlagBits + -> Vk.Format + -> Vk.ImageUsageFlags -> io AllocatedImage -createColorResource context Vk.Extent2D{width, height} = do +create context mlabel aspect Vk.Extent2D{width, height} mipLevels numLayers samples format usage = do let device = getDevice context allocator = getAllocator context - format = getSurfaceFormat context - msaa = getMultisample context (image, allocation, _info) <- VMA.createImage allocator - (imageCI format msaa) - imageAllocationCI - Debug.nameObject device image "ColorResource.image" - - imageView <- Vk.createImageView - device - (imageViewCI image format) - Nothing - Debug.nameObject device image "ColorResource.view" - - pure AllocatedImage - { aiAllocation = allocation - , aiImage = image - , aiImageView = imageView - } - where - imageCI format msaa = zero - { Vk.imageType = Vk.IMAGE_TYPE_2D - , Vk.format = format - , Vk.extent = Vk.Extent3D width height 1 - , Vk.mipLevels = 1 - , Vk.arrayLayers = 1 - , Vk.tiling = Vk.IMAGE_TILING_OPTIMAL - , Vk.initialLayout = Vk.IMAGE_LAYOUT_UNDEFINED - , Vk.usage = Vk.IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT .|. Vk.IMAGE_USAGE_COLOR_ATTACHMENT_BIT - , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE - , Vk.samples = msaa - } - - imageAllocationCI = zero - { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY - , VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT - } - - imageViewCI image format = zero - { Vk.image = image - , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D - , Vk.format = format - , Vk.components = zero - , Vk.subresourceRange = subr - } - - subr = zero - { Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT - , Vk.baseMipLevel = 0 - , Vk.levelCount = 1 - , Vk.baseArrayLayer = 0 - , Vk.layerCount = 1 - } - -createDepthResource - :: ( MonadIO io - , HasVulkan context - , HasSwapchain context - ) - => context - -> Vk.Extent2D - -> "shadowmap layers" ::: Maybe Word32 - -> io AllocatedImage -createDepthResource context Vk.Extent2D{width, height} depthLayers = do - let - device = getDevice context - allocator = getAllocator context - - depthFormat = getDepthFormat context - msaa = getMultisample context - - (samples, usage, numLayers) = - case depthLayers of - Nothing -> - ( msaa - , Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT - , 1 - ) - Just nl -> - ( Vk.SAMPLE_COUNT_1_BIT - , Vk.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT .|. - Vk.IMAGE_USAGE_SAMPLED_BIT - , nl - ) - - (image, allocation, _info) <- VMA.createImage - allocator - (imageCI depthFormat usage samples numLayers) + imageCI imageAllocationCI - Debug.nameObject device image "DepthResource.image" + for_ mlabel \label -> + Debug.nameObject device image $ encodeUtf8 label <> ".label" imageView <- Vk.createImageView device - (imageViewCI depthFormat image numLayers) + (imageViewCI image) Nothing - Debug.nameObject device image "DepthResource.view" + for_ mlabel \label -> + Debug.nameObject device image $ encodeUtf8 label <> ".view" pure AllocatedImage { aiAllocation = allocation + , aiFormat = format , aiImage = image , aiImageView = imageView + , aiImageRange = subr } where - imageCI format usage samples numLayers = zero + imageCI = zero { Vk.imageType = Vk.IMAGE_TYPE_2D + , Vk.flags = createFlags , Vk.format = format , Vk.extent = Vk.Extent3D width height 1 - , Vk.mipLevels = 1 + , Vk.mipLevels = mipLevels , Vk.arrayLayers = numLayers , Vk.tiling = Vk.IMAGE_TILING_OPTIMAL , Vk.initialLayout = Vk.IMAGE_LAYOUT_UNDEFINED @@ -155,54 +90,53 @@ , VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT } - imageViewCI format image numLayers = zero + imageViewCI image = zero { Vk.image = image , Vk.viewType = viewType , Vk.format = format , Vk.components = zero - , Vk.subresourceRange = subr numLayers + , Vk.subresourceRange = subr } - where - viewType = - if numLayers > 1 then - Vk.IMAGE_VIEW_TYPE_2D_ARRAY - else - Vk.IMAGE_VIEW_TYPE_2D - subr numLayers = zero - { Vk.aspectMask = Vk.IMAGE_ASPECT_DEPTH_BIT - , Vk.baseMipLevel = 0 - , Vk.levelCount = 1 - , Vk.baseArrayLayer = 0 - , Vk.layerCount = numLayers - } + (createFlags, viewType) = + case numLayers of + 1 -> + (zero, Vk.IMAGE_VIEW_TYPE_2D) + 6 -> + (Vk.IMAGE_CREATE_CUBE_COMPATIBLE_BIT, Vk.IMAGE_VIEW_TYPE_CUBE) + _ -> + (zero, Vk.IMAGE_VIEW_TYPE_2D_ARRAY) -destroyAllocatedImage + subr = subresource aspect mipLevels numLayers + +destroy :: ( MonadIO io , HasVulkan context ) => context -> AllocatedImage -> io () -destroyAllocatedImage context AllocatedImage{..} = do +destroy context AllocatedImage{..} = do -- traceM "destroyAllocatedImage" Vk.destroyImageView (getDevice context) aiImageView Nothing VMA.destroyImage (getAllocator context) aiImage aiAllocation -------------------------------------------- -transitionImageLayout - :: (HasVulkan context) +transitionLayout + :: ( HasVulkan context + , MonadUnliftIO m + ) => context -> Queues Vk.CommandPool -> Vk.Image -> "mip levels" ::: Word32 -> "layer count" ::: Word32 -> Vk.Format - -> ("old" ::: Vk.ImageLayout) - -> ("new" ::: Vk.ImageLayout) - -> RIO env () -transitionImageLayout ctx pool image mipLevels layerCount format old new = + -> "old" ::: Vk.ImageLayout + -> "new" ::: Vk.ImageLayout + -> m () +transitionLayout ctx pool image mipLevels layerCount format old new = case (old, new) of (Vk.IMAGE_LAYOUT_UNDEFINED, Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL) -> oneshot_ ctx pool qTransfer \buf -> @@ -269,6 +203,27 @@ , Vk.subresourceRange = subresource aspectMask mipLevels layerCount } +-- imageBarrier cb oldLayout newLayout aspectMask srcStage srcMask dstStage dstMask image mipLevels layerCount = +-- Vk.cmdPipelineBarrier +-- cb +-- srcStage +-- dstStage +-- zero +-- mempty +-- mempty +-- (Vector.singleton barrier) +-- where +-- barrier = SomeStruct zero +-- { Vk.srcAccessMask = srcMask +-- , Vk.dstAccessMask = dstMask +-- , Vk.oldLayout = oldLayout +-- , Vk.newLayout = newLayout +-- , Vk.srcQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED +-- , Vk.dstQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED +-- , Vk.image = image +-- , Vk.subresourceRange = subresource aspectMask mipLevels layerCount +-- } + subresource :: Vk.ImageAspectFlags -> "mip levels" ::: Word32 @@ -283,7 +238,11 @@ } copyBufferToImage - :: (HasVulkan context, Foldable t, Integral deviceSize) + :: ( HasVulkan context + , Foldable t + , Integral deviceSize + , MonadUnliftIO m + ) => context -> Queues Vk.CommandPool -> Vk.Buffer @@ -291,7 +250,7 @@ -> "base extent" ::: Vk.Extent3D -> "mip offsets" ::: t deviceSize -> "layer count" ::: Word32 - -> RIO env () + -> m () copyBufferToImage ctx pool src dst Vk.Extent3D{..} mipOffsets layerCount = oneshot_ ctx pool qTransfer \cmd -> Vk.cmdCopyBufferToImage cmd src dst Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL $ diff --git a/src/Resource/Mesh/Codec.hs b/src/Resource/Mesh/Codec.hs --- a/src/Resource/Mesh/Codec.hs +++ b/src/Resource/Mesh/Codec.hs @@ -3,6 +3,7 @@ import RIO import Codec.Compression.Zstd qualified as Zstd +import Codec.Serialise qualified as CBOR import Crypto.Hash.MD5 qualified as MD5 import Data.Binary.Get (runGet) import Data.Binary.Get qualified as Get @@ -10,6 +11,7 @@ import Data.Binary.Put qualified as Put import Data.ByteString.Internal qualified as BSI import Data.ByteString.Unsafe (unsafePackCStringLen) +import Data.Typeable (typeRep, typeRepTyCon) import Data.Vector qualified as Vector import Data.Vector.Generic qualified as Generic import Data.Vector.Storable qualified as Storable @@ -21,16 +23,15 @@ import UnliftIO.Resource (MonadResource) import UnliftIO.Resource qualified as Resource import Vulkan.Core10 qualified as Vk -import Data.Typeable -import Engine.Vulkan.Types (HasVulkan, Queues) +import Engine.Vulkan.Types (MonadVulkan, Queues) import Resource.Buffer qualified as Buffer import Resource.Model qualified as Model -- * Format meta pattern VER_BREAKS :: Word8 -pattern VER_BREAKS = 2 +pattern VER_BREAKS = 3 pattern VER_TWEAKS :: Word8 pattern VER_TWEAKS = 0 @@ -45,7 +46,7 @@ , Generic.Vector vn nodes , Storable attrs , Storable nodes - , Storable meta + , CBOR.Serialise meta , HasLogFunc env ) => FilePath @@ -68,7 +69,7 @@ (nodDigest, nodCompressed) <- encodeItems nodes logDebug $ "Node digest: " <> displayShow nodDigest - (metDigest, metCompressed) <- encodeItems $ Storable.singleton meta + let (metSize, metDigest, metCompressed) = encodeCBOR meta logDebug $ "Meta digest: " <> displayShow metDigest withFile fp WriteMode \out -> do @@ -102,7 +103,7 @@ Put.putWord32le . fromIntegral $ ByteString.length nodCompressed -- 0x30 + 4 + 4 - Put.putWord32le . fromIntegral $ Foreign.sizeOf (error "sizeOf" :: meta) + Put.putWord32le $ fromIntegral metSize Put.putWord32le . fromIntegral $ ByteString.length metCompressed -- 0x38 + 4 + 4 @@ -155,21 +156,30 @@ !zBuf = Zstd.compress Zstd.maxCLevel buf pure (bufHash, zBuf) +encodeCBOR :: CBOR.Serialise a => a -> (Int, ByteString, ByteString) +encodeCBOR stuff = + ( ByteString.length buf + , MD5.hash buf + , Zstd.compress Zstd.maxCLevel buf + ) + where + buf = BSL.toStrict (CBOR.serialise stuff) + -- * Decoding loadIndexed :: ( Storable attrs , Storable nodes - , Storable meta + , CBOR.Serialise meta , Show meta , Typeable nodes - , HasVulkan env , HasLogFunc env - , MonadResource (RIO env) + , MonadResource m + , MonadVulkan env m ) => Queues Vk.CommandPool -> FilePath - -> RIO env + -> m ( Resource.ReleaseKey , (meta, Storable.Vector nodes, Model.Indexed 'Buffer.Staged Vec3.Packed attrs) ) @@ -185,15 +195,17 @@ pure (key, (meta, nodes, indexed)) loadBlobs - :: forall attrs env nodes meta + :: forall attrs env nodes meta m . ( Storable attrs - , Storable meta + , CBOR.Serialise meta , Storable nodes , Typeable nodes , HasLogFunc env + , MonadReader env m + , MonadIO m ) => FilePath - -> RIO env + -> m ( meta , Storable.Vector nodes , ( Storable.Vector Vec3.Packed @@ -233,7 +245,7 @@ sizeOfMeta <- fmap fromIntegral Get.getWord32le lenMeta <- fmap fromIntegral Get.getWord32le - guardEq "Meta size" (Foreign.sizeOf (error "sizeOf" :: meta)) sizeOfMeta + -- guardEq "Meta size" (Foreign.sizeOf (error "sizeOf" :: meta)) sizeOfMeta _reserved32 <- Get.getWord32le _reserved32 <- Get.getWord32le @@ -267,10 +279,11 @@ indices <- decodeItems "Indices" indDigest (Just numIndices) zIndices attrs <- decodeItems "Attributes" attDigest (Just numPositions) zAttrs nodes <- decodeItems "Nodes" nodDigest Nothing zNodes - meta <- decodeItems "Metadata" metDigest (Just 1) zMetas - pure (verTweaks, Storable.head meta, nodes, (positions, indices, attrs)) + meta <- decodeCBOR "Metadata" metDigest sizeOfMeta zMetas + pure (verTweaks, meta, nodes, (positions, indices, attrs)) + let (verTweaks, meta, nodes, blobs) = runGet getter blob when (verTweaks /= VER_TWEAKS) $ @@ -324,6 +337,33 @@ pure items where itemSize = Foreign.sizeOf @item undefined + +decodeCBOR + :: ( CBOR.Serialise a + , MonadFail m + ) + => String + -> ByteString + -> Int + -> ByteString + -> m a +decodeCBOR label digest expectedSize zBytes = + case Zstd.decompress zBytes of + Zstd.Error err -> + fail $ label <> ": zstd error (" <> err <> ")" + Zstd.Skip -> + fail $ label <> ": empty zstd" + Zstd.Decompress bytes -> do + guardEq (label <> " size") expectedSize (ByteString.length bytes) + guardEq (label <> " hash") digest (MD5.hash bytes) + case CBOR.deserialiseOrFail (BSL.fromStrict bytes) of + Right value -> + pure value + Left (CBOR.DeserialiseFailure _off err) -> + fail $ unlines + [ label <> " deserialise failure:" + , err + ] -- * Utils diff --git a/src/Resource/Mesh/Types.hs b/src/Resource/Mesh/Types.hs --- a/src/Resource/Mesh/Types.hs +++ b/src/Resource/Mesh/Types.hs @@ -23,17 +23,27 @@ , sizeAa , HasRange(..) + + , encodeStorable + , decodeStorable ) where import RIO +import Codec.Serialise qualified as CBOR +import Codec.Serialise.Decoding qualified as CBOR (Decoder, decodeBytes) +import Codec.Serialise.Encoding qualified as CBOR (Encoding) import Control.Foldl qualified as L +import Data.ByteString.Unsafe qualified as BS +import Data.Typeable (typeRep, typeRepTyCon) import Foreign (Storable(..), castPtr) +import Foreign qualified import Foreign.Storable.Generic (GStorable) import Geomancy (Transform(..), Vec2, Vec4, withVec3) import Geomancy.Mat4 qualified as Mat4 import Geomancy.Vec3 qualified as Vec3 import RIO.Vector.Storable qualified as Storable +import System.IO.Unsafe (unsafePerformIO) import Vulkan.Zero (Zero(..)) import Resource.Model (IndexRange(..)) @@ -74,6 +84,8 @@ pokeElemOff (castPtr ptr) 1 aaY pokeElemOff (castPtr ptr) 2 aaZ +instance (CBOR.Serialise a) => CBOR.Serialise (AxisAligned a) + -- * Whole-scene metadata data Meta = Meta @@ -106,6 +118,27 @@ Mat4.toListRowMajor (mTransformBB b) ] +instance CBOR.Serialise Meta where + encode Meta{..} = mconcat + [ CBOR.encode mOpaqueIndices + , CBOR.encode mBlendedIndices + , CBOR.encode mOpaqueNodes + , CBOR.encode mBlendedNodes + , encodeStorable mBoundingSphere + , encodeStorable mTransformBB + , CBOR.encode mMeasurements + ] + + decode = do + mOpaqueIndices <- CBOR.decode + mBlendedIndices <- CBOR.decode + mOpaqueNodes <- CBOR.decode + mBlendedNodes <- CBOR.decode + mBoundingSphere <- decodeStorable + mTransformBB <- decodeStorable + mMeasurements <- CBOR.decode + pure Meta{..} + -- * Scene parts data NodeGroup @@ -223,6 +256,8 @@ pokeByteOff ptr 8 mMean pokeByteOff ptr 12 mStd +instance CBOR.Serialise Measurements + {-# INLINEABLE middleAa #-} middleAa :: AxisAligned Measurements -> AxisAligned Float middleAa = fmap middle @@ -303,3 +338,45 @@ adjustRange tn@TexturedNode{tnNode} newFirstIndex = tn { tnNode = adjustRange tnNode newFirstIndex } + +-- | CBOR.encode helper for storable types (vectors, etc.) +{-# NOINLINE encodeStorable #-} +encodeStorable :: forall a . Storable a => a -> CBOR.Encoding +encodeStorable x = unsafePerformIO do + ptr <- Foreign.malloc @a + poke ptr x + buf <- BS.unsafePackMallocCStringLen + ( Foreign.castPtr ptr + , Foreign.sizeOf (undefined :: a) + ) + pure $ CBOR.encode buf + +-- | CBOR.decode helper for storable types (vectors, etc.) +decodeStorable :: forall a s . (Storable a, Typeable a) => CBOR.Decoder s a +decodeStorable = do + buf <- CBOR.decodeBytes + case fromBuf buf of + Left err -> + fail err + Right !res -> + pure res + where + expected = + Foreign.sizeOf (undefined :: a) + + {-# NOINLINE fromBuf #-} + fromBuf :: ByteString -> Either String a + fromBuf buf = + unsafePerformIO $ + BS.unsafeUseAsCStringLen buf \(ptr, len) -> + if len == expected then do + !res <- Foreign.peek (Foreign.castPtr ptr) + pure $ Right res + else + pure . Left $ mconcat + [ "Storable size mismatch for " + , show (typeRepTyCon . typeRep $ Proxy @a) + , " (expected: ", show expected + , ", got: ", show len + , ")" + ] diff --git a/src/Resource/Model.hs b/src/Resource/Model.hs --- a/src/Resource/Model.hs +++ b/src/Resource/Model.hs @@ -2,6 +2,7 @@ import RIO +import Codec.Serialise qualified as CBOR import Data.List qualified as List import Data.Vector.Storable qualified as Storable import Foreign (Storable(..)) @@ -65,7 +66,9 @@ { irFirstIndex :: Word32 , irIndexCount :: Word32 } - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic) + +instance CBOR.Serialise IndexRange instance Storable IndexRange where alignment ~_ = 4 diff --git a/src/Resource/Texture.hs b/src/Resource/Texture.hs --- a/src/Resource/Texture.hs +++ b/src/Resource/Texture.hs @@ -40,7 +40,7 @@ import Engine.Vulkan.Types (HasVulkan(getDevice), MonadVulkan, Queues) import Resource.Collection qualified as Collection -import Resource.Image (AllocatedImage(..), destroyAllocatedImage, subresource) +import Resource.Image (AllocatedImage(..)) import Resource.Image qualified as Image data TextureError @@ -128,7 +128,7 @@ destroy :: (MonadIO io, HasVulkan context) => context -> Texture a -> io () destroy context Texture{tAllocatedImage} = - destroyAllocatedImage context tAllocatedImage + Image.destroy context tAllocatedImage createImageView :: (MonadIO io, HasVulkan context) @@ -156,7 +156,7 @@ Vk.IMAGE_VIEW_TYPE_2D colorRange = - subresource Vk.IMAGE_ASPECT_COLOR_BIT mipLevels arrayLayers + Image.subresource Vk.IMAGE_ASPECT_COLOR_BIT mipLevels arrayLayers imageCI :: Vk.Format -> Vk.Extent3D -> Word32 -> Word32 -> Vk.ImageCreateInfo '[] imageCI format extent mipLevels arrayLayers = zero diff --git a/src/Resource/Texture/Ktx1.hs b/src/Resource/Texture/Ktx1.hs --- a/src/Resource/Texture/Ktx1.hs +++ b/src/Resource/Texture/Ktx1.hs @@ -16,8 +16,7 @@ import Vulkan.Utils.FromGL qualified as FromGL import VulkanMemoryAllocator qualified as VMA -import Engine.Types (StageRIO) -import Engine.Vulkan.Types (HasVulkan(..), Queues) +import Engine.Vulkan.Types (HasVulkan(..), MonadVulkan, Queues) import Resource.Image (AllocatedImage(..)) import Resource.Image qualified as Image import Resource.Source (Source(..)) @@ -26,19 +25,29 @@ import Resource.Texture qualified as Texture load - :: (TextureLayers a, Typeable a, HasCallStack) + :: ( TextureLayers a + , MonadVulkan env m + , MonadThrow m + , HasLogFunc env + , Typeable a + , HasCallStack + ) => Queues Vk.CommandPool -> Source - -> StageRIO st (Texture a) + -> m (Texture a) load pool source = withFrozenCallStack $ Source.load (loadBytes pool) source loadBytes - :: TextureLayers a + :: ( TextureLayers a + , MonadVulkan env m + , MonadThrow m + , HasLogFunc env + ) => Queues Vk.CommandPool -> ByteString - -> StageRIO st (Texture a) + -> m (Texture a) loadBytes pool bytes = do case Ktx1.fromByteString bytes of Left (offset, err) -> do @@ -48,11 +57,15 @@ loadKtx1 pool ktx1 loadKtx1 - :: forall a st - . (TextureLayers a) + :: forall a m env + . ( TextureLayers a + , MonadVulkan env m + , MonadThrow m + , HasLogFunc env + ) => Queues Vk.CommandPool -> Ktx1.Ktx - -> StageRIO st (Texture a) + -> m (Texture a) loadKtx1 pool Ktx1.Ktx{header, images=ktxImages} = do context <- ask let vma = getAllocator context @@ -122,7 +135,7 @@ (Texture.imageCI format extent mipLevels numLayers) Texture.imageAllocationCI - Image.transitionImageLayout + Image.transitionLayout context pool image @@ -185,7 +198,7 @@ -- XXX: staging buffer is gone - Image.transitionImageLayout + Image.transitionLayout context pool image @@ -205,8 +218,10 @@ let allocatedImage = AllocatedImage { aiAllocation = allocation + , aiFormat = format , aiImage = image , aiImageView = imageView + , aiImageRange = Image.subresource Vk.IMAGE_ASPECT_COLOR_BIT mipLevels numLayers } pure Texture { tFormat = format