gpu-vulkan 0.1.0.161 → 0.1.0.162

raw patch · 8 files changed

+281/−87 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• gpu-vulkan.cabal +2/−1
• src/Gpu/Vulkan.hs +2/−0
• src/Gpu/Vulkan/CommandBuffer.hs +6/−83
• src/Gpu/Vulkan/CommandBuffer/Internal.hs +139/−0
• src/Gpu/Vulkan/Internal.hs +81/−2
• src/Gpu/Vulkan/Queue.hs +6/−1
• src/Gpu/Vulkan/Semaphore.hs +4/−0
• src/Gpu/Vulkan/Semaphore/Internal.hs +41/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gpu-vulkan-version:        0.1.0.161+version:        0.1.0.162 synopsis:       Vulkan library description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan#readme> category:       GPU@@ -110,6 +110,7 @@       Gpu.Vulkan.BufferView.Internal       Gpu.Vulkan.ColorComponent.Enum       Gpu.Vulkan.CommandBuffer.Enum+      Gpu.Vulkan.CommandBuffer.Internal       Gpu.Vulkan.CommandBuffer.Type       Gpu.Vulkan.CommandPool.Enum       Gpu.Vulkan.CommandPool.Type

@@ -23,6 +23,8 @@ 	SubmitInfo(..), 	SubmitInfoListToMiddle, SemaphorePipelineStageFlags(..), +	SubmitInfo2(..), SubmitInfo2ListToMiddle,+ 	-- * PROPERTIES  	LayerProperties(..),

@@ -1,12 +1,3 @@-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}-{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.CommandBuffer (@@ -25,85 +16,17 @@  	-- * BEGIN AND RESET -	begin, reset, M.BeginInfo(..), M.InheritanceInfo(..),+	begin, reset, BeginInfo(..), InheritanceInfo(..), +	-- * SUBMIT INFO++	SubmitInfo(..), SubmitInfoListToMiddle,+ 	-- * ENUM  	module Gpu.Vulkan.CommandBuffer.Enum  	) where -import Foreign.Storable.PeekPoke-import Control.Exception-import Data.TypeLevel.Maybe qualified as TMaybe-import Data.TypeLevel.List qualified as TLength-import Data.HeteroParList qualified as HeteroParList-import Data.Word--import Gpu.Vulkan.CommandBuffer.Type+import Gpu.Vulkan.CommandBuffer.Internal import Gpu.Vulkan.CommandBuffer.Enum--import qualified Gpu.Vulkan.Device.Type as Device-import qualified Gpu.Vulkan.CommandPool.Type as CommandPool-import qualified Gpu.Vulkan.CommandBuffer.Middle as M--allocateCs :: (-	WithPoked (TMaybe.M mn), TLength.Length c, HeteroParList.FromList c ) =>-	Device.D sd -> AllocateInfo mn scp c ->-	(forall scb . HeteroParList.LL (C scb) c -> IO a) -> IO a-allocateCs (Device.D dvc) ai f = bracket-	(M.allocateCs dvc $ allocateInfoToMiddle ai)-	(M.freeCs dvc-		. (\(CommandPool.C cp) -> cp) $ allocateInfoCommandPool ai)-	(f . HeteroParList.fromList (HeteroParList.Dummy . C))--allocateList :: WithPoked (TMaybe.M mn) =>-	Device.D sd -> AllocateInfoList mn scp ->-	(forall scb . [C scb] -> IO a) -> IO a-allocateList (Device.D dvc) ai f = bracket-	(M.allocateCs dvc $ allocateInfoToMiddleList ai)-	(M.freeCs dvc-		. (\(CommandPool.C cp) -> cp) $ allocateInfoCommandPoolList ai)-	(f . (C <$>))--data AllocateInfo mn scp (c :: [()]) = AllocateInfo {-	allocateInfoNext :: TMaybe.M mn,-	allocateInfoCommandPool :: CommandPool.C scp,-	allocateInfoLevel :: Level }--data AllocateInfoList mn scp = AllocateInfoList {-	allocateInfoNextList :: TMaybe.M mn,-	allocateInfoCommandPoolList :: CommandPool.C scp,-	allocateInfoLevelList :: Level,-	allocateInfoCommandBufferCountList :: Word32 }--deriving instance Show (TMaybe.M mn) => Show (AllocateInfo mn s c)--allocateInfoToMiddle :: forall n s c . TLength.Length c =>-	AllocateInfo n s c -> M.AllocateInfo n-allocateInfoToMiddle AllocateInfo {-	allocateInfoNext = mnxt,-	allocateInfoCommandPool = CommandPool.C cp,-	allocateInfoLevel = lvl } = M.AllocateInfo {-	M.allocateInfoNext = mnxt,-	M.allocateInfoCommandPool = cp,-	M.allocateInfoLevel = lvl,-	M.allocateInfoCommandBufferCount = TLength.length @_ @c }--allocateInfoToMiddleList :: AllocateInfoList n s -> M.AllocateInfo n-allocateInfoToMiddleList AllocateInfoList {-	allocateInfoNextList = mnxt,-	allocateInfoCommandPoolList = CommandPool.C cp,-	allocateInfoLevelList = lvl,-	allocateInfoCommandBufferCountList = c } = M.AllocateInfo {-	M.allocateInfoNext = mnxt,-	M.allocateInfoCommandPool = cp,-	M.allocateInfoLevel = lvl,-	M.allocateInfoCommandBufferCount = c }--begin :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M ii)) =>-	C s -> M.BeginInfo mn ii -> IO a -> IO a-begin (C cb) bi act = bracket_ (M.begin cb bi) (M.end cb) act--reset :: C sc -> ResetFlags -> IO ()-reset (C cb) rfs = M.reset cb rfs

@@ -0,0 +1,139 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures, TypeOperators #-}+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.CommandBuffer.Internal (++	-- * ALLOCATE++	C, GBinded, CBinded,++	-- ** Type Level List++	allocateCs, AllocateInfo(..),++	-- ** Value Level List++	allocateList, AllocateInfoList(..),++	-- * BEGIN AND RESET++	begin, reset, M.BeginInfo(..), M.InheritanceInfo(..),++	-- * SUBMIT INFO++	SubmitInfo(..), SubmitInfoListToMiddle(..)++	) where++import Foreign.Storable.PeekPoke+import Control.Exception+import Data.TypeLevel.Tuple.Uncurry+import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex+import Data.TypeLevel.Maybe qualified as TMaybe+import Data.TypeLevel.List qualified as TLength+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList+import Data.HeteroParList qualified as HeteroParList+import Data.Word++import Gpu.Vulkan.CommandBuffer.Type+import Gpu.Vulkan.CommandBuffer.Enum++import qualified Gpu.Vulkan.Device.Type as Device+import qualified Gpu.Vulkan.CommandPool.Type as CommandPool+import qualified Gpu.Vulkan.CommandBuffer.Middle as M++allocateCs :: (+	WithPoked (TMaybe.M mn), TLength.Length c, HeteroParList.FromList c ) =>+	Device.D sd -> AllocateInfo mn scp c ->+	(forall scb . HeteroParList.LL (C scb) c -> IO a) -> IO a+allocateCs (Device.D dvc) ai f = bracket+	(M.allocateCs dvc $ allocateInfoToMiddle ai)+	(M.freeCs dvc+		. (\(CommandPool.C cp) -> cp) $ allocateInfoCommandPool ai)+	(f . HeteroParList.fromList (HeteroParList.Dummy . C))++allocateList :: WithPoked (TMaybe.M mn) =>+	Device.D sd -> AllocateInfoList mn scp ->+	(forall scb . [C scb] -> IO a) -> IO a+allocateList (Device.D dvc) ai f = bracket+	(M.allocateCs dvc $ allocateInfoToMiddleList ai)+	(M.freeCs dvc+		. (\(CommandPool.C cp) -> cp) $ allocateInfoCommandPoolList ai)+	(f . (C <$>))++data AllocateInfo mn scp (c :: [()]) = AllocateInfo {+	allocateInfoNext :: TMaybe.M mn,+	allocateInfoCommandPool :: CommandPool.C scp,+	allocateInfoLevel :: Level }++data AllocateInfoList mn scp = AllocateInfoList {+	allocateInfoNextList :: TMaybe.M mn,+	allocateInfoCommandPoolList :: CommandPool.C scp,+	allocateInfoLevelList :: Level,+	allocateInfoCommandBufferCountList :: Word32 }++deriving instance Show (TMaybe.M mn) => Show (AllocateInfo mn s c)++allocateInfoToMiddle :: forall n s c . TLength.Length c =>+	AllocateInfo n s c -> M.AllocateInfo n+allocateInfoToMiddle AllocateInfo {+	allocateInfoNext = mnxt,+	allocateInfoCommandPool = CommandPool.C cp,+	allocateInfoLevel = lvl } = M.AllocateInfo {+	M.allocateInfoNext = mnxt,+	M.allocateInfoCommandPool = cp,+	M.allocateInfoLevel = lvl,+	M.allocateInfoCommandBufferCount = TLength.length @_ @c }++allocateInfoToMiddleList :: AllocateInfoList n s -> M.AllocateInfo n+allocateInfoToMiddleList AllocateInfoList {+	allocateInfoNextList = mnxt,+	allocateInfoCommandPoolList = CommandPool.C cp,+	allocateInfoLevelList = lvl,+	allocateInfoCommandBufferCountList = c } = M.AllocateInfo {+	M.allocateInfoNext = mnxt,+	M.allocateInfoCommandPool = cp,+	M.allocateInfoLevel = lvl,+	M.allocateInfoCommandBufferCount = c }++begin :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M ii)) =>+	C s -> M.BeginInfo mn ii -> IO a -> IO a+begin (C cb) bi act = bracket_ (M.begin cb bi) (M.end cb) act++reset :: C sc -> ResetFlags -> IO ()+reset (C cb) rfs = M.reset cb rfs++data SubmitInfo mn sc = SubmitInfo {+	submitInfoNext :: TMaybe.M mn,+	submitInfoCommandBuffer :: C sc,+	submitInfoDeviceMask :: Word32 }++class SubmitInfoListToMiddle mnscs where+	submitInfoListToMiddle ::+		HPList.PL (U2 SubmitInfo) mnscs ->+		HPList.PL M.SubmitInfo (TMapIndex.M0_2 mnscs)++instance SubmitInfoListToMiddle '[] where+	submitInfoListToMiddle HPList.Nil = HPList.Nil++instance SubmitInfoListToMiddle mnscs =>+	SubmitInfoListToMiddle (mnsc ': mnscs) where+	submitInfoListToMiddle (U2 si :** sis) =+		submitInfoToMiddle si :** submitInfoListToMiddle sis++submitInfoToMiddle :: SubmitInfo mn sc -> M.SubmitInfo mn+submitInfoToMiddle SubmitInfo {+	submitInfoNext = mnxt,+	submitInfoCommandBuffer = C c,+	submitInfoDeviceMask = dm } = M.SubmitInfo {+	M.submitInfoNext = mnxt,+	M.submitInfoCommandBuffer = c, M.submitInfoDeviceMask = dm }

@@ -12,7 +12,7 @@  	-- * INFO -	-- ** ApplicationINfo+	-- ** ApplicationInfo  	M.ApplicationInfo(..), 	M.ApiVersion, M.makeApiVersion,@@ -23,6 +23,8 @@ 	SubmitInfo(..), 	SubmitInfoListToMiddle(..), SemaphorePipelineStageFlags(..), +	SubmitInfo2(..), SubmitInfo2ListToMiddle(..),+ 	-- * PROPERTIES  	LayerProperties(..), layerPropertiesFromMiddle,@@ -90,9 +92,10 @@  import Foreign.Storable.PeekPoke import Data.Kind-import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.Tuple.Uncurry import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex+import Data.TypeLevel.Maybe qualified as TMaybe+import Data.TypeLevel.List qualified as TList import Data.HeteroParList qualified as HeteroParList import Data.HeteroParList qualified as HPList import Data.HeteroParList (pattern (:**))@@ -101,6 +104,7 @@ import qualified Gpu.Vulkan.Middle as M import Gpu.Vulkan.Enum import qualified Gpu.Vulkan.Semaphore.Type as Semaphore+import qualified Gpu.Vulkan.Semaphore.Internal as Semaphore import qualified Gpu.Vulkan.Semaphore.Middle as Semaphore.M import qualified Gpu.Vulkan.CommandBuffer.Type as CommandBuffer import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline@@ -109,6 +113,8 @@ import {-# SOURCE #-} Gpu.Vulkan.Buffer.Internal qualified as Buffer import Gpu.Vulkan.Image.Internal qualified as Image +import Gpu.Vulkan.CommandBuffer.Internal qualified as CommandBuffer+ data SubmitInfo n sss ss ssss = SubmitInfo { 	submitInfoNext :: TMaybe.M n, 	submitInfoWaitSemaphoreDstStageMasks ::@@ -155,6 +161,79 @@ data SemaphorePipelineStageFlags ss = 	SemaphorePipelineStageFlags (Semaphore.S ss) Pipeline.StageFlags 	deriving Show++data SubmitInfo2 mn wsas cbas ssas = SubmitInfo2 {+	submitInfo2Next :: TMaybe.M mn,+	submitInfo2Flags :: SubmitFlags,+	submitInfo2WaitSemaphoreInfos ::+		HPList.PL (U2 Semaphore.SubmitInfo) wsas,+	submitInfo2CommandBufferInfos ::+		HPList.PL (U2 CommandBuffer.SubmitInfo) cbas,+	submitInfo2SignalSemaphoreInfos ::+		HPList.PL (U2 Semaphore.SubmitInfo) ssas }++class M.SubmitInfo2ListToCore (SubmitInfo2ArgsListToMiddle sias) => SubmitInfo2ListToMiddle sias where+	type family SubmitInfo2ArgsListToMiddle sias ::+		[(Maybe Type, [Maybe Type], [Maybe Type], [Maybe Type])]+	submitInfo2ListToMiddle ::+		HPList.PL (U4 SubmitInfo2) sias ->+		HPList.PL (U4 M.SubmitInfo2) (SubmitInfo2ArgsListToMiddle sias)++instance SubmitInfo2ListToMiddle '[] where+	type SubmitInfo2ArgsListToMiddle '[] = '[]+	submitInfo2ListToMiddle HPList.Nil = HPList.Nil++instance (+	WithPoked (TMaybe.M mn),+	TList.Length (TMapIndex.M0_2 wsas),+	TList.Length (TMapIndex.M0_2 cbas),+	TList.Length (TMapIndex.M0_2 ssas),+	HPList.ToListWithCCpsM' WithPoked TMaybe.M (TMapIndex.M0_2 wsas),+	HPList.ToListWithCCpsM' WithPoked TMaybe.M (TMapIndex.M0_2 cbas),+	HPList.ToListWithCCpsM' WithPoked TMaybe.M (TMapIndex.M0_2 ssas),+	Semaphore.SubmitInfoListToMiddle wsas,+	CommandBuffer.SubmitInfoListToMiddle cbas,+	Semaphore.SubmitInfoListToMiddle ssas,+	SubmitInfo2ListToMiddle sias ) =>+	SubmitInfo2ListToMiddle ('(mn, wsas, cbas, ssas) ': sias) where+	type SubmitInfo2ArgsListToMiddle ('(mn, wsas, cbas, ssas) ': sias) =+		'(mn,	TMapIndex.M0_2 wsas,+			TMapIndex.M0_2 cbas,+			TMapIndex.M0_2 ssas) ': SubmitInfo2ArgsListToMiddle sias+	submitInfo2ListToMiddle (U4 si :** sis) =+		U4 (submitInfo2ToMiddle si) :** submitInfo2ListToMiddle sis++{-+type family SubmitInfo2ArgsListToMiddle sias where+	SubmitInfo2ArgsListToMiddle '[] = '[]+	SubmitInfo2ArgsListToMiddle ('(mn, wsas, cbas, ssas) ': sias) =+		'(mn,	TMapIndex.M0_2 wsas,+			TMapIndex.M0_2 cbas,+			TMapIndex.M0_2 ssas) ': SubmitInfo2ArgsListToMiddle sias+			-}++submitInfo2ToMiddle :: (+	Semaphore.SubmitInfoListToMiddle wsas,+	CommandBuffer.SubmitInfoListToMiddle cbas,+	Semaphore.SubmitInfoListToMiddle ssas ) =>+	SubmitInfo2 mn wsas cbas ssas ->+	M.SubmitInfo2 mn (TMapIndex.M0_2 wsas)+		(TMapIndex.M0_2 cbas) (TMapIndex.M0_2 ssas)+submitInfo2ToMiddle SubmitInfo2 {+	submitInfo2Next = mnxt,+	submitInfo2Flags = fs,+	submitInfo2WaitSemaphoreInfos = wss,+	submitInfo2CommandBufferInfos = cbs,+	submitInfo2SignalSemaphoreInfos = sss+	} = M.SubmitInfo2 {+	M.submitInfo2Next = mnxt,+	M.submitInfo2Flags = fs,+	M.submitInfo2WaitSemaphoreInfos =+		Semaphore.submitInfoListToMiddle wss,+	M.submitInfo2CommandBufferInfos =+		CommandBuffer.submitInfoListToMiddle cbs,+	M.submitInfo2SignalSemaphoreInfos =+		Semaphore.submitInfoListToMiddle sss }  -- deriving instance (Show n, Show (HeteroParList SemaphorePipelineStageFlags sss)) => --	Show (SubmitInfo n sss s vs)

@@ -10,7 +10,7 @@  	-- * SUBMIT AND WAIT IDLE -	submit, M.waitIdle, M.Q,+	submit, submit2, M.waitIdle, M.Q,  	-- * TYPE SYNONYM @@ -55,6 +55,11 @@ 	HeteroParList.PL (U4 SubmitInfo) sias -> Maybe (Fence.F sf) -> IO () submit q sis mf = 	M.submit q (submitInfoListToMiddle sis) $ (\(Fence.F f) -> f) <$> mf++submit2 :: SubmitInfo2ListToMiddle sias => M.Q ->+	HeteroParList.PL (U4 SubmitInfo2) sias -> Maybe (Fence.F sf) -> IO ()+submit2 q sis mf =+	M.submit2 q (submitInfo2ListToMiddle sis) $ (\(Fence.F f) -> f) <$> mf  type Index = Word32 

@@ -10,6 +10,10 @@  	group, Group, create', unsafeDestroy, lookup, +	-- * SUBMIT INFO++	SubmitInfo(..), SubmitInfoListToMiddle+ 	) where  import Prelude hiding (lookup)

@@ -2,7 +2,10 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} @@ -16,6 +19,10 @@  	group, Group, create', unsafeDestroy, lookup, +	-- * SUBMIT INFO++	SubmitInfo(..), SubmitInfoListToMiddle(..),+ 	) where  import Prelude hiding (lookup)@@ -23,9 +30,12 @@ import Control.Concurrent.STM import Control.Concurrent.STM.TSem import Control.Exception+import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.ParMaybe qualified as TPMaybe import Data.TypeLevel.Tuple.Uncurry+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList import Data.Map qualified as Map import Data.Word @@ -36,6 +46,8 @@  import Gpu.Vulkan.Semaphore.Type +import qualified Gpu.Vulkan.Pipeline as Pipeline+ create :: (WithPoked (TMaybe.M mn), AllocationCallbacks.ToMiddle mac) => 	Device.D sd -> M.CreateInfo mn -> 	TPMaybe.M (U2 AllocationCallbacks.A) mac ->@@ -95,3 +107,32 @@  lookup :: Ord k => Group sd ma ss k -> k -> IO (Maybe (S ss)) lookup (Group _ _ _sem ss) k = atomically $ Map.lookup k <$> readTVar ss++data SubmitInfo mn ss = SubmitInfo {+	submitInfoNext :: TMaybe.M mn,+	submitInfoSemaphore :: S ss, submitInfoValue :: Word64,+	submitInfoStageMask :: Pipeline.StageFlags2,+	submitInfoDeviceIndex :: Word32 }++class SubmitInfoListToMiddle mnsss where+	submitInfoListToMiddle ::+		HPList.PL (U2 SubmitInfo) mnsss ->+		HPList.PL M.SubmitInfo (TMapIndex.M0_2 mnsss)++instance SubmitInfoListToMiddle '[] where+	submitInfoListToMiddle HPList.Nil = HPList.Nil++instance SubmitInfoListToMiddle mnsss =>+	SubmitInfoListToMiddle (mnss ': mnsss) where+	submitInfoListToMiddle (U2 si :** sis) =+		submitInfoToMiddle si :** submitInfoListToMiddle sis++submitInfoToMiddle :: SubmitInfo mn ss -> M.SubmitInfo mn+submitInfoToMiddle SubmitInfo {+	submitInfoNext = mnxt,+	submitInfoSemaphore = S s, submitInfoValue = v,+	submitInfoStageMask = sm, submitInfoDeviceIndex = di+	} = M.SubmitInfo {+	M.submitInfoNext = mnxt,+	M.submitInfoSemaphore = s, M.submitInfoValue = v,+	M.submitInfoStageMask = sm, M.submitInfoDeviceIndex = di }