gpu-vulkan-middle 0.1.0.66 → 0.1.0.67

raw patch · 11 files changed

+161/−10 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• gpu-vulkan-middle.cabal +1/−1
• src/Gpu/Vulkan/CommandBuffer/Middle.hs +4/−0
• src/Gpu/Vulkan/CommandBuffer/Middle/Internal.hs +20/−1
• src/Gpu/Vulkan/CommandBuffer/Middle/Internal.hs-boot +14/−2
• src/Gpu/Vulkan/Enum.hsc +7/−0
• src/Gpu/Vulkan/Middle.hs +2/−1
• src/Gpu/Vulkan/Middle/Internal.hsc +69/−2
• src/Gpu/Vulkan/Queue/Middle.hs +1/−1
• src/Gpu/Vulkan/Queue/Middle/Internal.hs +13/−2
• src/Gpu/Vulkan/Semaphore/Middle.hs +4/−0
• src/Gpu/Vulkan/Semaphore/Middle/Internal.hsc +26/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gpu-vulkan-middle-version:        0.1.0.66+version:        0.1.0.67 synopsis:       Medium wrapper for Vulkan API description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan-middle#readme> category:       GPU

@@ -10,6 +10,10 @@  	begin, end, reset, BeginInfo(..), InheritanceInfo(..), +	-- * SUBMIT INFO++	SubmitInfo(..)+ 	) where  import Gpu.Vulkan.CommandBuffer.Middle.Internal

@@ -10,10 +10,14 @@ {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.CommandBuffer.Middle.Internal (+ 	C(..), 	AllocateInfo(..), allocateCs, freeCs, -	BeginInfo(..), InheritanceInfo(..), begin, end, reset+	BeginInfo(..), InheritanceInfo(..), begin, end, reset,++	SubmitInfo(..), submitInfoToCore+ 	) where  import Foreign.Ptr@@ -151,3 +155,18 @@ 	(length &&& ((\(C _ cb) -> cb) <$>) -> (cc, cs)) = allocaArray cc \pcs -> do 		pokeArray pcs cs 		C.freeCs dvc cp (fromIntegral cc) pcs++data SubmitInfo mn = SubmitInfo {+	submitInfoNext :: TMaybe.M mn,+	submitInfoCommandBuffer :: C,+	submitInfoDeviceMask :: Word32 }++submitInfoToCore :: WithPoked (TMaybe.M mn) =>+	SubmitInfo mn -> (C.SubmitInfo -> IO r) -> IO ()+submitInfoToCore SubmitInfo {+	submitInfoNext = mnxt,+	submitInfoCommandBuffer = C _ c, submitInfoDeviceMask = dm } f =+	withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') ->+	f C.SubmitInfo {+		C.submitInfoSType = (), C.submitInfoPNext = pnxt',+		C.submitInfoCommandBuffer = c, C.submitInfoDeviceMask = dm }

@@ -1,11 +1,17 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE DataKinds, PolyKinds #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RoleAnnotations #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.CommandBuffer.Middle.Internal (-	C(..)+	C(..), SubmitInfo, submitInfoToCore 	) where +import Foreign.Storable.PeekPoke+import Data.Kind+import Data.TypeLevel.Maybe qualified as TMaybe import Data.IORef  import qualified Gpu.Vulkan.CommandBuffer.Core as C@@ -14,3 +20,9 @@ data C = C { 	cPipeline :: IORef Pipeline.C.P, 	unC :: C.C }++type role SubmitInfo nominal+data SubmitInfo (s :: Maybe Type)++submitInfoToCore :: WithPoked (TMaybe.M mn) =>+	SubmitInfo mn -> (C.SubmitInfo -> IO r) -> IO ()

@@ -3290,6 +3290,12 @@ 	("FormatR16g16S105Nv", #{const VK_FORMAT_R16G16_S10_5_NV}), 	("FormatMaxEnum", #{const VK_FORMAT_MAX_ENUM}) ] +enum "SubmitFlagBits" ''#{type VkSubmitFlagBits}+		[''Show, ''Eq, ''Storable, ''Bits] [+	("SubmitProtectedBit", #{const VK_SUBMIT_PROTECTED_BIT}),+	("SubmitProtectedBitKhr", #{const VK_SUBMIT_PROTECTED_BIT_KHR}),+	("SubmitFlagBitsMaxEnum", #{const VK_SUBMIT_FLAG_BITS_MAX_ENUM}) ]+ enum "AccessFlagBits" ''#{type VkAccessFlagBits} 		[''Show, ''Eq, ''Storable, ''Bits] [ 	("AccessFlagsZero", 0),@@ -3555,3 +3561,4 @@ type CullModeFlags = CullModeFlagBits type ShaderStageFlags = ShaderStageFlagBits type FormatFeatureFlags = FormatFeatureFlagBits+type SubmitFlags = SubmitFlagBits

@@ -13,7 +13,8 @@  	-- ** SubmitInfo -	SubmitInfo(..), SubmitInfoListToCore(..),+	SubmitInfo(..), SubmitInfoListToCore,+	SubmitInfo2(..), SubmitInfo2ListToCore,  	-- * PROPERTIES 

@@ -5,7 +5,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures, TypeOperators #-} {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE PatternSynonyms, ViewPatterns #-} {-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}@@ -25,7 +25,8 @@ 	C.ClearDepthStencilValue, pattern C.ClearDepthStencilValue, 	C.clearDepthStencilValueDepth, C.clearDepthStencilValueStencil, -	SubmitInfo(..), SubmitInfoListToCore(..), submitInfoToCore,+	SubmitInfo(..), SubmitInfoListToCore(..),+	SubmitInfo2(..), SubmitInfo2ListToCore(..),  	FormatProperties(..), formatPropertiesFromCore, @@ -58,6 +59,7 @@ import Control.Monad import Data.Kind import Data.Default+import Data.TypeLevel.Tuple.Uncurry import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.List qualified as TL import Data.HeteroParList qualified as HPList@@ -339,6 +341,71 @@ 		C.submitInfoPCommandBuffers = pcbs, 		C.submitInfoSignalSemaphoreCount = fromIntegral ssc, 		C.submitInfoPSignalSemaphores = psss }++data SubmitInfo2 mn wsas cbas ssas = SubmitInfo2 {+	submitInfo2Next :: TMaybe.M mn,+	submitInfo2Flags :: SubmitFlags,+	submitInfo2WaitSemaphoreInfos :: HPList.PL Semaphore.SubmitInfo wsas,+	submitInfo2CommandBufferInfos ::+		HPList.PL CommandBuffer.SubmitInfo cbas,+	submitInfo2SignalSemaphoreInfos :: HPList.PL Semaphore.SubmitInfo ssas }++class SubmitInfo2ListToCore si2as where+	submitInfo2ListToCore ::+		HeteroParList.PL (U4 SubmitInfo2) si2as ->+		([C.SubmitInfo2] -> IO a) -> IO ()++instance SubmitInfo2ListToCore '[] where+	submitInfo2ListToCore HPList.Nil f = void $ f []++instance (+	WithPoked (TMaybe.M mn),+	HPList.ToListWithCCpsM' WithPoked TMaybe.M wsas, TL.Length wsas,+	HPList.ToListWithCCpsM' WithPoked TMaybe.M cbas, TL.Length cbas,+	HPList.ToListWithCCpsM' WithPoked TMaybe.M ssas, TL.Length ssas,+	SubmitInfo2ListToCore si2as ) =>+	SubmitInfo2ListToCore ('(mn, wsas, cbas, ssas) ': si2as) where+	submitInfo2ListToCore (U4 si :** sis) f =+		submitInfo2ToCore si \csi ->+		submitInfo2ListToCore sis \csis -> f $ csi : csis++submitInfo2ToCore :: forall mn wsas cbas ssas r . (+	WithPoked (TMaybe.M mn),+	HPList.ToListWithCCpsM' WithPoked TMaybe.M wsas, TL.Length wsas,+	HPList.ToListWithCCpsM' WithPoked TMaybe.M cbas, TL.Length cbas,+	HPList.ToListWithCCpsM' WithPoked TMaybe.M ssas, TL.Length ssas+	) =>+	SubmitInfo2 mn wsas cbas ssas -> (C.SubmitInfo2 -> IO r) -> IO ()+submitInfo2ToCore SubmitInfo2 {+	submitInfo2Next = mnxt,+	submitInfo2Flags = SubmitFlagBits fs,+	submitInfo2WaitSemaphoreInfos = wss,+	submitInfo2CommandBufferInfos = cbs,+	submitInfo2SignalSemaphoreInfos = sss } f =+	withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') ->+	allocaArray wsc \pwss -> allocaArray cbc \pcbs ->+	allocaArray ssc \psss -> do+	HPList.withListWithCCpsM' @_ @WithPoked @TMaybe.M+		wss Semaphore.submitInfoToCore \cwss -> pokeArray pwss cwss+	HPList.withListWithCCpsM' @_ @WithPoked @TMaybe.M+		cbs CommandBuffer.submitInfoToCore \ccbs -> pokeArray pcbs ccbs+	HPList.withListWithCCpsM' @_ @WithPoked @TMaybe.M+		sss Semaphore.submitInfoToCore \csss -> pokeArray psss csss+	f C.SubmitInfo2 {+		C.submitInfo2SType = (),+		C.submitInfo2PNext = pnxt',+		C.submitInfo2Flags = fs,+		C.submitInfo2WaitSemaphoreInfoCount = wsc,+		C.submitInfo2PWaitSemaphoreInfos = pwss,+		C.submitInfo2CommandBufferInfoCount = cbc,+		C.submitInfo2PCommandBufferInfos = pcbs,+		C.submitInfo2SignalSemaphoreInfoCount = ssc,+		C.submitInfo2PSignalSemaphoreInfos = psss }+	where+	wsc, cbc, ssc :: Integral n => n+	wsc = TL.length @_ @wsas+	cbc = TL.length @_ @cbas+	ssc = TL.length @_ @ssas  data FormatProperties = FormatProperties { 	formatPropertiesLinearTilingFeatures :: FormatFeatureFlags,

@@ -4,7 +4,7 @@  	-- * SUBMIT AND WAIT IDLE -	submit, waitIdle, Q,+	submit, submit2, waitIdle, Q,  	-- * SPARSE RESOURCES 

@@ -13,7 +13,7 @@  	-- * SUBMIT AND WAIT IDLE -	submit, waitIdle, Q(..),+	submit, submit2, waitIdle, Q(..),  	-- * SPARSE RESOURCES @@ -26,10 +26,11 @@ import Foreign.Storable.PeekPoke import Control.Arrow import Control.Monad.Cont.MiscYj+import Data.TypeLevel.Tuple.Uncurry import Data.HeteroParList qualified as HeteroParList  import Gpu.Vulkan.Base.Middle-import Gpu.Vulkan.Middle+import Gpu.Vulkan.Middle.Internal import Gpu.Vulkan.Exception.Middle.Internal import Gpu.Vulkan.Exception.Enum import Gpu.Vulkan.Fence.Middle.Internal qualified as Fence.M@@ -56,6 +57,16 @@ 		r <- C.submit q (fromIntegral sic) psis 			$ Fence.M.maybeFToCore mf 		throwUnlessSuccess $ Result r++submit2 :: SubmitInfo2ListToCore sias =>+	Q -> HeteroParList.PL (U4 SubmitInfo2) sias -> Maybe Fence.M.F -> IO ()+submit2 (Q q) sis mf =+	submitInfo2ListToCore sis \csis -> let sic = length csis in+	allocaArray sic \psis -> do+	pokeArray psis csis+	r <- C.submit2 q (fromIntegral sic) psis+		$ Fence.M.maybeFToCore mf+	throwUnlessSuccess $ Result r  waitIdle :: Q -> IO () waitIdle (Q q) = throwUnlessSuccess . Result =<< C.waitIdle q

@@ -6,6 +6,10 @@  	create, destroy, S, CreateInfo(..), CreateFlags, +	-- * SUBMIT INFO++	SubmitInfo(..)+ 	) where  import Gpu.Vulkan.Semaphore.Middle.Internal

@@ -14,6 +14,10 @@  	create, destroy, S(..), CreateInfo(..), CreateFlags, +	-- * SUBMIT INFO++	SubmitInfo(..), submitInfoToCore+ 	) where  import Foreign.Ptr@@ -34,6 +38,7 @@ import qualified Gpu.Vulkan.Semaphore.Core as C  import qualified Gpu.Vulkan.Device.Middle.Types as Device+import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline  #include <vulkan/vulkan.h> @@ -72,3 +77,24 @@ destroy :: Device.D -> S -> TPMaybe.M AllocationCallbacks.A md -> IO () destroy (Device.D dvc) (S s) mac = 	AllocationCallbacks.mToCore mac $ C.destroy dvc s++data SubmitInfo mn = SubmitInfo {+	submitInfoNext :: TMaybe.M mn,+	submitInfoSemaphore :: S,+	submitInfoValue :: Word64,+	submitInfoStageMask :: Pipeline.StageFlags2,+	submitInfoDeviceIndex :: Word32 }++submitInfoToCore :: WithPoked (TMaybe.M mn) =>+	SubmitInfo mn -> (C.SubmitInfo -> IO r) -> IO ()+submitInfoToCore SubmitInfo {+	submitInfoNext = mnxt,+	submitInfoSemaphore = S s, submitInfoValue = v,+	submitInfoStageMask = Pipeline.StageFlagBits2 sm,+	submitInfoDeviceIndex = di+	} f =+	withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') ->+	f C.SubmitInfo {+		C.submitInfoSType = (), C.submitInfoPNext = pnxt',+		C.submitInfoSemaphore = s, C.submitInfoValue = v,+		C.submitInfoStageMask = sm, C.submitInfoDeviceIndex = di }