diff --git a/gpu-vulkan-middle.cabal b/gpu-vulkan-middle.cabal --- a/gpu-vulkan-middle.cabal +++ b/gpu-vulkan-middle.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: gpu-vulkan-middle -version: 0.1.0.68 +version: 0.1.0.70 synopsis: Medium wrapper for Vulkan API description: Please see the README on GitHub at category: GPU diff --git a/src/Gpu/Vulkan/Cmd/Middle.hs b/src/Gpu/Vulkan/Cmd/Middle.hs --- a/src/Gpu/Vulkan/Cmd/Middle.hs +++ b/src/Gpu/Vulkan/Cmd/Middle.hs @@ -30,7 +30,7 @@ -- * COPY BUFFERS AND IMAGES - copyBuffer, copyBufferToImage, copyImageToBuffer, blitImage, + copyBuffer, copyBufferToImage, copyImageToBuffer, blitImage, blitImage2, -- * CLEAR COLOR IMAGE @@ -251,6 +251,13 @@ lift do (_, src) <- readIORef rsrc (_, dst) <- readIORef rdst C.blitImage cb src srcLyt dst dstLyt (fromIntegral bltc) pblts ft + +blitImage2 :: ( + WithPoked (TMaybe.M mn), + TList.Length ras, HPList.ToListWithCCpsM' WithPoked TMaybe.M ras ) => + CommandBuffer.M.C -> BlitImageInfo2 mn ras -> IO () +blitImage2 (CommandBuffer.M.C _ cb) bii = + blitImageInfo2ToCore bii \pcbii -> C.blitImage2 cb pcbii resetQueryPool :: CommandBuffer.M.C -> QueryPool.Q -> Word32 -> Word32 -> IO () resetQueryPool (CommandBuffer.M.C _ c) (QueryPool.Q q) fq qc = diff --git a/src/Gpu/Vulkan/Device/Middle/Internal.hsc b/src/Gpu/Vulkan/Device/Middle/Internal.hsc --- a/src/Gpu/Vulkan/Device/Middle/Internal.hsc +++ b/src/Gpu/Vulkan/Device/Middle/Internal.hsc @@ -33,7 +33,6 @@ import Foreign.Storable import Foreign.Storable.PeekPoke ( WithPoked, withPoked', withPtrS, pattern NullPtr ) -import Foreign.Storable.HeteroList import Foreign.C.Enum import Control.Arrow import Control.Monad.Cont @@ -44,7 +43,6 @@ import Data.List (genericLength) import Data.HeteroParList qualified as HeteroParList import Data.Word -import Data.Ix import Data.Text qualified as T import Data.Text.Foreign.MiscYj diff --git a/src/Gpu/Vulkan/Image/Middle.hs b/src/Gpu/Vulkan/Image/Middle.hs --- a/src/Gpu/Vulkan/Image/Middle.hs +++ b/src/Gpu/Vulkan/Image/Middle.hs @@ -20,7 +20,7 @@ -- * BLIT - Blit(..), SubresourceLayers(..), + Blit(..), Blit2(..), SubresourceLayers(..), -- * OTHERS diff --git a/src/Gpu/Vulkan/Image/Middle/Internal.hs b/src/Gpu/Vulkan/Image/Middle/Internal.hs --- a/src/Gpu/Vulkan/Image/Middle/Internal.hs +++ b/src/Gpu/Vulkan/Image/Middle/Internal.hs @@ -31,7 +31,7 @@ -- * BLIT - Blit(..), blitToCore, + Blit(..), blitToCore, Blit2(..), blit2ToCore, SubresourceLayers(..), subresourceLayersToCore, -- * OTHERS @@ -382,6 +382,32 @@ C.blitSrcOffsets = [sof, sot], C.blitDstSubresource = subresourceLayersToCore dsr, C.blitDstOffsets = [dof, dot] } + +data Blit2 mn = Blit2 { + blit2Next :: TMaybe.M mn, + blit2SrcSubresource :: SubresourceLayers, + blit2SrcOffsetFrom :: Offset3d, + blit2SrcOffsetTo :: Offset3d, + blit2DstSubresource :: SubresourceLayers, + blit2DstOffsetFrom :: Offset3d, + blit2DstOffsetTo :: Offset3d } + +deriving instance Show (TMaybe.M mn) => Show (Blit2 mn) + +blit2ToCore :: WithPoked (TMaybe.M mn) => Blit2 mn -> (C.Blit2 -> IO a) -> IO () +blit2ToCore Blit2 { + blit2Next = mnxt, + blit2SrcSubresource = ssr, + blit2SrcOffsetFrom = sof, blit2SrcOffsetTo = sot, + blit2DstSubresource = dsr, + blit2DstOffsetFrom = dof, blit2DstOffsetTo = dot } f = + withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') -> + f C.Blit2 { + C.blit2SType = (), C.blit2PNext = pnxt', + C.blit2SrcSubresource = subresourceLayersToCore ssr, + C.blit2SrcOffsets = [sof, sot], + C.blit2DstSubresource = subresourceLayersToCore dsr, + C.blit2DstOffsets = [dof, dot] } data Subresource = Subresource { subresourceAspectMask :: AspectFlags, diff --git a/src/Gpu/Vulkan/Middle.hs b/src/Gpu/Vulkan/Middle.hs --- a/src/Gpu/Vulkan/Middle.hs +++ b/src/Gpu/Vulkan/Middle.hs @@ -8,7 +8,8 @@ -- ** ApplicationInfo ApplicationInfo(..), - ApiVersion, makeApiVersion, + ApiVersion, + makeApiVersion, fromApiVersion, Variant, Major, Minor, Patch, apiVersion_1_0, apiVersion_1_1, apiVersion_1_2, apiVersion_1_3, -- ** SubmitInfo @@ -70,7 +71,7 @@ Size(..), - DependencyInfo(..) + DependencyInfo(..), BlitImageInfo2(..) ) where diff --git a/src/Gpu/Vulkan/Middle/Internal.hsc b/src/Gpu/Vulkan/Middle/Internal.hsc --- a/src/Gpu/Vulkan/Middle/Internal.hsc +++ b/src/Gpu/Vulkan/Middle/Internal.hsc @@ -12,7 +12,8 @@ module Gpu.Vulkan.Middle.Internal ( ApplicationInfo(..), applicationInfoToCore, - ApiVersion(..), makeApiVersion, + ApiVersion(..), + makeApiVersion, fromApiVersion, Variant, Major, Minor, Patch, apiVersion_1_0, apiVersion_1_1, apiVersion_1_2, apiVersion_1_3, LayerProperties(..), layerPropertiesFromCore, ExtensionProperties(..), extensionPropertiesFromCore, @@ -45,7 +46,8 @@ Size(..), - DependencyInfo(..), dependencyInfoToCore + DependencyInfo(..), dependencyInfoToCore, + BlitImageInfo2(..), blitImageInfo2ToCore ) where @@ -69,6 +71,7 @@ import Data.Word import Data.Text.Foreign.MiscYj import Data.Color.Internal +import Data.IORef import qualified Data.Text as T @@ -86,6 +89,7 @@ import qualified Gpu.Vulkan.Memory.Middle.Internal as Memory import {-# SOURCE #-} qualified Gpu.Vulkan.Buffer.Middle.Internal as Buffer import qualified Gpu.Vulkan.Image.Middle.Internal as Image +import qualified Gpu.Vulkan.Image.Enum as Image #include @@ -116,6 +120,13 @@ makeApiVersion :: Variant -> Major -> Minor -> Patch -> ApiVersion makeApiVersion v mj mn p = ApiVersion $ C.makeApiVersion v mj mn p +fromApiVersion :: ApiVersion -> (Variant, Major, Minor, Patch) +fromApiVersion (ApiVersion av) = let + vr = fromIntegral $ av `shiftR` 29 + mj = fromIntegral $ (av `shiftR` 22) .&. 0x7f + mn = fromIntegral $ (av `shiftR` 12) .&. 0x3ff + pt = fromIntegral $ av .&. 0xfff in (vr, mj, mn, pt) + applicationInfoToCore :: WithPoked (TMaybe.M mn) => ApplicationInfo mn -> (Ptr C.ApplicationInfo -> IO a) -> IO () applicationInfoToCore ApplicationInfo { @@ -472,3 +483,48 @@ mbc = TL.length @_ @mbs bmbc = TL.length @_ @bmbs imbc = TL.length @_ @imbs + +data BlitImageInfo2 mn ras = BlitImageInfo2 { + blitImageInfo2Next :: TMaybe.M mn, + blitImageInfo2SrcImage :: Image.I, + blitImageInfo2SrcImageLayout :: Image.Layout, + blitImageInfo2DstImage :: Image.I, + blitImageInfo2DstImageLayout :: Image.Layout, + blitImageInfo2Regions :: HPList.PL Image.Blit2 ras, + blitImageInfo2Filter :: Filter } + +blitImageInfo2ToCore :: + forall mn ras a . ( + TL.Length ras, HeteroParList.ToListWithCCpsM' WithPoked TMaybe.M ras + ) => + WithPoked (TMaybe.M mn) => + BlitImageInfo2 mn ras -> (Ptr C.BlitImageInfo2 -> IO a) -> IO () +blitImageInfo2ToCore BlitImageInfo2 { + blitImageInfo2Next = mnxt, + blitImageInfo2SrcImage = Image.I rsi, + blitImageInfo2SrcImageLayout = Image.Layout sil, + blitImageInfo2DstImage = Image.I rdi, + blitImageInfo2DstImageLayout = Image.Layout dil, + blitImageInfo2Regions = rs, + blitImageInfo2Filter = Filter flt + } f = + withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') -> + readIORef rsi >>= \(_, si) -> + readIORef rdi >>= \(_, di) -> + allocaArray rc \prs -> do + HPList.withListWithCCpsM' @_ @WithPoked @TMaybe.M + rs Image.blit2ToCore \crs -> pokeArray prs crs + let cbii = C.BlitImageInfo2 { + C.blitImageInfo2SType = (), + C.blitImageInfo2PNext = pnxt', + C.blitImageInfo2SrcImage = si, + C.blitImageInfo2SrcImageLayout = sil, + C.blitImageInfo2DstImage = di, + C.blitImageInfo2DstImageLayout = dil, + C.blitImageInfo2RegionCount = rc, + C.blitImageInfo2PRegions = prs, + C.blitImageInfo2Filter = flt } + withPoked cbii f + where + rc :: Integral n => n + rc = TL.length @_ @ras