From f9097bca9c783b545c03faa10af0cb812741c2d8 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Tue, 16 Apr 2024 17:32:09 +0300 Subject: [PATCH] Fix for 9.6 (#516) --- examples/compute/Main.hs | 3 ++- examples/offscreen/Main.hs | 6 +++-- examples/sdl-triangle/Main.hs | 34 ++++++++++++++-------------- examples/timeline-semaphore/Main.hs | 4 ++-- generate-new/generate-new.cabal | 35 ++++++++++++++++------------- generate-new/package.yaml | 2 +- 6 files changed, 46 insertions(+), 38 deletions(-) diff --git a/examples/compute/Main.hs b/examples/compute/Main.hs index a9f087105..3842355a2 100644 --- a/examples/compute/Main.hs +++ b/examples/compute/Main.hs @@ -41,6 +41,7 @@ import Vulkan.Core10 as Vk hiding ( withBuffer , withImage ) +import qualified Vulkan.Core10.DeviceInitialization as DI import Vulkan.Dynamic ( DeviceCmds ( DeviceCmds , pVkGetDeviceProcAddr @@ -505,7 +506,7 @@ physicalDeviceInfo physicalDeviceInfo phys = runMaybeT $ do pdiTotalMemory <- do heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties phys - pure $ sum ((size :: MemoryHeap -> DeviceSize) <$> heaps) + pure $ sum (DI.size <$> heaps) pdiComputeQueueFamilyIndex <- do queueFamilyProperties <- getPhysicalDeviceQueueFamilyProperties phys let isComputeQueue q = diff --git a/examples/offscreen/Main.hs b/examples/offscreen/Main.hs index d295eb091..0bd742524 100644 --- a/examples/offscreen/Main.hs +++ b/examples/offscreen/Main.hs @@ -46,6 +46,8 @@ import qualified Language.C.Types as C import Vulkan.CStruct.Extends import Vulkan.Core10 as Vk hiding ( withImage ) +import qualified Vulkan.Core10.DeviceInitialization as DI +import qualified Vulkan.Core10.Image as SL import Vulkan.Dynamic ( DeviceCmds ( DeviceCmds , pVkGetDeviceProcAddr @@ -571,7 +573,7 @@ render = do let pixelAddr :: Int -> Int -> Ptr Word32 pixelAddr x y = plusPtr (mappedData cpuImageAllocationInfo) - ( fromIntegral (offset (cpuImageLayout :: SubresourceLayout)) + ( fromIntegral (SL.offset cpuImageLayout) + (y * fromIntegral (rowPitch cpuImageLayout)) + (x * sizeOf (0 :: Word32)) ) @@ -738,7 +740,7 @@ physicalDeviceInfo physicalDeviceInfo phys = runMaybeT $ do pdiTotalMemory <- do heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties phys - pure $ sum ((size :: MemoryHeap -> DeviceSize) <$> heaps) + pure $ sum (DI.size <$> heaps) pdiGraphicsQueueFamilyIndex <- do queueFamilyProperties <- getPhysicalDeviceQueueFamilyProperties phys let isGraphicsQueue q = diff --git a/examples/sdl-triangle/Main.hs b/examples/sdl-triangle/Main.hs index 30d3684db..f3a8d60fe 100644 --- a/examples/sdl-triangle/Main.hs +++ b/examples/sdl-triangle/Main.hs @@ -34,10 +34,13 @@ import Say import System.Exit import Vulkan.CStruct.Extends import Vulkan.Core10 +import qualified Vulkan.Core10.DeviceInitialization as DI import Vulkan.Extensions.VK_EXT_debug_utils import Vulkan.Extensions.VK_EXT_validation_features import Vulkan.Extensions.VK_KHR_surface +import qualified Vulkan.Extensions.VK_KHR_surface as SF import Vulkan.Extensions.VK_KHR_swapchain +import qualified Vulkan.Extensions.VK_KHR_swapchain as SW import Vulkan.Utils.Debug import Vulkan.Utils.ShaderQQ.GLSL.Glslang ( vert , frag ) @@ -267,6 +270,7 @@ createGraphicsPipeline dev renderPass swapchainExtent _swapchainImageFormat = do shaderStages <- createShaders dev pipelineLayout <- withPipelineLayout dev zero Nothing allocate let + Extent2D {width = swapchainWidth, height = swapchainHeight} = swapchainExtent pipelineCreateInfo :: GraphicsPipelineCreateInfo '[] pipelineCreateInfo = zero { stages = shaderStages @@ -280,8 +284,8 @@ createGraphicsPipeline dev renderPass swapchainExtent _swapchainImageFormat = do [ Viewport { x = 0 , y = 0 - , width = realToFrac (width (swapchainExtent :: Extent2D)) - , height = realToFrac (height (swapchainExtent :: Extent2D)) + , width = realToFrac swapchainWidth + , height = realToFrac swapchainHeight , minDepth = 0 , maxDepth = 1 } @@ -333,14 +337,14 @@ createFramebuffers -> RenderPass -> Extent2D -> Managed (V.Vector Framebuffer) -createFramebuffers dev imageViews renderPass swapchainExtent = +createFramebuffers dev imageViews renderPass Extent2D {width, height} = for imageViews $ \imageView -> do let framebufferCreateInfo :: FramebufferCreateInfo '[] framebufferCreateInfo = zero { renderPass = renderPass , attachments = [imageView] - , width = width (swapchainExtent :: Extent2D) - , height = height (swapchainExtent :: Extent2D) + , width + , height , layers = 1 } withFramebuffer dev framebufferCreateInfo Nothing allocate @@ -493,11 +497,9 @@ createGraphicalDevice inst surface = do in zero { surface = surface - , minImageCount = minImageCount - (surfaceCaps :: SurfaceCapabilitiesKHR) - + 1 - , imageFormat = (format :: SurfaceFormatKHR -> Format) surfaceFormat - , imageColorSpace = colorSpace surfaceFormat + , minImageCount = SF.minImageCount surfaceCaps + 1 + , imageFormat = SF.format surfaceFormat + , imageColorSpace = SF.colorSpace surfaceFormat , imageExtent = case currentExtent (surfaceCaps :: SurfaceCapabilitiesKHR) @@ -522,8 +524,8 @@ createGraphicalDevice inst surface = do , graphicsQueue , graphicsQueueFamilyIndex , presentQueue - , format (surfaceFormat :: SurfaceFormatKHR) - , imageExtent (swapchainCreateInfo :: SwapchainCreateInfoKHR '[]) + , SF.format surfaceFormat + , SW.imageExtent swapchainCreateInfo , swapchain ) @@ -571,7 +573,7 @@ pickGraphicalPhysicalDevice inst surface _requiredExtensions desiredFormat = do deviceScore :: MonadIO m => PhysicalDevice -> m Word64 deviceScore dev = do heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties dev - let totalSize = sum $ (size :: MemoryHeap -> DeviceSize) <$> heaps + let totalSize = sum $ DI.size <$> heaps pure totalSize deviceHasSwapchain :: MonadIO m => PhysicalDevice -> m Bool @@ -606,10 +608,8 @@ pickGraphicalPhysicalDevice inst surface _requiredExtensions desiredFormat = do _ | V.any (\f -> - format (f :: SurfaceFormatKHR) - == format (desiredFormat :: SurfaceFormatKHR) - && colorSpace (f :: SurfaceFormatKHR) - == colorSpace (desiredFormat :: SurfaceFormatKHR) + SF.format f == SF.format desiredFormat + && SF.colorSpace f == SF.colorSpace desiredFormat ) formats -> desiredFormat diff --git a/examples/timeline-semaphore/Main.hs b/examples/timeline-semaphore/Main.hs index 89e772449..2af737f4a 100644 --- a/examples/timeline-semaphore/Main.hs +++ b/examples/timeline-semaphore/Main.hs @@ -25,7 +25,7 @@ import UnliftIO ( Exception(displayException) ) import Vulkan.CStruct.Extends import Vulkan.Core10 -import Vulkan.Core12 +import qualified Vulkan.Core10.DeviceInitialization as DI import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore as Timeline import Vulkan.Exception @@ -160,7 +160,7 @@ physicalDeviceInfo phys = runMaybeT $ do empty pdiTotalMemory <- do heaps <- memoryHeaps <$> getPhysicalDeviceMemoryProperties phys - pure $ sum ((size :: MemoryHeap -> DeviceSize) <$> heaps) + pure $ sum (DI.size <$> heaps) (pdiQueueCreateInfos, getQueues) <- MaybeT $ assignQueues phys (MyQueues (QueueSpec 1 (const (pure . isComputeQueueFamily)))) diff --git a/generate-new/generate-new.cabal b/generate-new/generate-new.cabal index 7f87b5f29..f8e5d9c05 100644 --- a/generate-new/generate-new.cabal +++ b/generate-new/generate-new.cabal @@ -92,10 +92,11 @@ library BlockArguments ConstraintKinds DataKinds - DeriveFunctor + DeepSubsumption DeriveFoldable - DeriveTraversable + DeriveFunctor DeriveGeneric + DeriveTraversable DerivingVia DisambiguateRecordFields DuplicateRecordFields @@ -152,7 +153,7 @@ library , pandoc , parsec , parsers - , polysemy >=1.4 && <1.8 + , polysemy >=1.4 && <2 , pretty-show , prettyprinter , regex-applicative @@ -199,10 +200,11 @@ library khronos-spec BlockArguments ConstraintKinds DataKinds - DeriveFunctor + DeepSubsumption DeriveFoldable - DeriveTraversable + DeriveFunctor DeriveGeneric + DeriveTraversable DerivingVia DisambiguateRecordFields DuplicateRecordFields @@ -260,7 +262,7 @@ library khronos-spec , pandoc , parsec , parsers - , polysemy >=1.4 && <1.8 + , polysemy >=1.4 && <2 , pretty-show , prettyprinter , regex-applicative @@ -302,10 +304,11 @@ executable vk BlockArguments ConstraintKinds DataKinds - DeriveFunctor + DeepSubsumption DeriveFoldable - DeriveTraversable + DeriveFunctor DeriveGeneric + DeriveTraversable DerivingVia DisambiguateRecordFields DuplicateRecordFields @@ -364,7 +367,7 @@ executable vk , pandoc , parsec , parsers - , polysemy >=1.4 && <1.8 + , polysemy >=1.4 && <2 , pretty-show , prettyprinter , regex-applicative @@ -409,10 +412,11 @@ executable vma BlockArguments ConstraintKinds DataKinds - DeriveFunctor + DeepSubsumption DeriveFoldable - DeriveTraversable + DeriveFunctor DeriveGeneric + DeriveTraversable DerivingVia DisambiguateRecordFields DuplicateRecordFields @@ -471,7 +475,7 @@ executable vma , pandoc , parsec , parsers - , polysemy >=1.4 && <1.8 + , polysemy >=1.4 && <2 , pretty-show , prettyprinter , regex-applicative @@ -514,10 +518,11 @@ executable xr BlockArguments ConstraintKinds DataKinds - DeriveFunctor + DeepSubsumption DeriveFoldable - DeriveTraversable + DeriveFunctor DeriveGeneric + DeriveTraversable DerivingVia DisambiguateRecordFields DuplicateRecordFields @@ -576,7 +581,7 @@ executable xr , pandoc , parsec , parsers - , polysemy >=1.4 && <1.8 + , polysemy >=1.4 && <2 , pretty-show , prettyprinter , regex-applicative diff --git a/generate-new/package.yaml b/generate-new/package.yaml index 77e60dfe2..07c16f6bb 100644 --- a/generate-new/package.yaml +++ b/generate-new/package.yaml @@ -122,7 +122,7 @@ dependencies: - pandoc - parsec - parsers -- polysemy >= 1.4 && < 1.8 +- polysemy >= 1.4 && < 2 - pretty-show - prettyprinter - regex-applicative