gpu-vulkan-middle 0.1.0.73 → 0.1.0.74

raw patch · 4 files changed

+58/−3 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• gpu-vulkan-middle.cabal +3/−1
• src/Gpu/Vulkan/Device/GroupDevice/Middle.hs +5/−0
• src/Gpu/Vulkan/Device/GroupDevice/Middle/Internal.hs +48/−0
• src/Gpu/Vulkan/PhysicalDevice/Middle/Internal.hsc +2/−2

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gpu-vulkan-middle-version:        0.1.0.73+version:        0.1.0.74 synopsis:       Medium wrapper for Vulkan API description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan-middle#readme> category:       GPU@@ -67,6 +67,7 @@       Gpu.Vulkan.Device.Enum       Gpu.Vulkan.Device.Middle       Gpu.Vulkan.Device.Middle.Internal+      Gpu.Vulkan.Device.GroupDevice.Middle       Gpu.Vulkan.Enum       Gpu.Vulkan.Exception.Enum       Gpu.Vulkan.Exception.Middle@@ -149,6 +150,7 @@       Gpu.Vulkan.DescriptorSet.Middle.Internal       Gpu.Vulkan.DescriptorSetLayout.BindingFlags.Middle.Internal       Gpu.Vulkan.DescriptorSetLayout.Middle.Internal+      Gpu.Vulkan.Device.GroupDevice.Middle.Internal       Gpu.Vulkan.Device.Middle.Types       Gpu.Vulkan.Exception.Middle.Internal       Gpu.Vulkan.Framebuffer.Middle.Internal

@@ -0,0 +1,5 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Device.GroupDevice.Middle (CreateInfo(..)) where++import Gpu.Vulkan.Device.GroupDevice.Middle.Internal

@@ -0,0 +1,48 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Device.GroupDevice.Middle.Internal where++import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Storable+import Foreign.Storable.PeekPoke+import Control.Arrow+import Data.TypeLevel.Maybe qualified as TMaybe++import Gpu.Vulkan.PhysicalDevice.Middle.Internal qualified as PhysicalDevice+import Gpu.Vulkan.Device.GroupDevice.Core qualified as C++data CreateInfo mn = CreateInfo {+	createInfoNext :: TMaybe.M mn,+	createInfoPhysicalDevices :: [PhysicalDevice.P] }++deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn)++instance WithPoked (TMaybe.M mn) => WithPoked (CreateInfo mn) where+	withPoked' ci f = alloca \pci -> do+		createInfoToCore ci $ \cci -> poke pci cci+		f . ptrS $ castPtr pci++createInfoToCore :: WithPoked (TMaybe.M mn) =>+	CreateInfo mn -> (C.CreateInfo -> IO a) -> IO ()+createInfoToCore CreateInfo {+	createInfoNext = mnxt,+	createInfoPhysicalDevices = (id &&& length) -> (pds, pdc)+	} f =+	putStrLn "createInfoToCore begin" >>+	withPoked' mnxt \pnxt -> withPtrS pnxt \(castPtr -> pnxt') ->+	allocaArray pdc \ppds -> do+		pokeArray ppds (phdToCore <$> pds)+		() <$ f C.CreateInfo {+			C.createInfoSType = (),+			C.createInfoPNext = pnxt',+			C.createInfoPhysicalDeviceCount = fromIntegral pdc,+			C.createInfoPPhysicalDevices = ppds }+	where+	phdToCore (PhysicalDevice.P p) = p

@@ -5,7 +5,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts, UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.PhysicalDevice.Middle.Internal (@@ -69,7 +69,7 @@  #include <vulkan/vulkan.h> -newtype P = P C.P deriving Show+newtype P = P C.P deriving (Show, Storable)  enumerate :: Instance.M.I -> IO [P] enumerate (Instance.M.I ist) = map P <$> alloca \pdvcc ->