{-# language CPP #-}
module Vulkan.Core10.Sampler ( createSampler
, withSampler
, destroySampler
, SamplerCreateInfo(..)
, Sampler(..)
, BorderColor(..)
, Filter(..)
, SamplerMipmapMode(..)
, SamplerAddressMode(..)
, SamplerCreateFlagBits(..)
, SamplerCreateFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.BorderColor (BorderColor)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Enums.CompareOp (CompareOp)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateSampler))
import Vulkan.Dynamic (DeviceCmds(pVkDestroySampler))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Enums.Filter (Filter)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Sampler)
import Vulkan.Core10.Handles (Sampler(..))
import Vulkan.Core10.Enums.SamplerAddressMode (SamplerAddressMode)
import Vulkan.Core10.Enums.SamplerCreateFlagBits (SamplerCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_custom_border_color (SamplerCustomBorderColorCreateInfoEXT)
import Vulkan.Core10.Enums.SamplerMipmapMode (SamplerMipmapMode)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax (SamplerReductionModeCreateInfo)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion (SamplerYcbcrConversionInfo)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SAMPLER_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.BorderColor (BorderColor(..))
import Vulkan.Core10.Enums.Filter (Filter(..))
import Vulkan.Core10.Handles (Sampler(..))
import Vulkan.Core10.Enums.SamplerAddressMode (SamplerAddressMode(..))
import Vulkan.Core10.Enums.SamplerCreateFlagBits (SamplerCreateFlagBits(..))
import Vulkan.Core10.Enums.SamplerCreateFlagBits (SamplerCreateFlags)
import Vulkan.Core10.Enums.SamplerMipmapMode (SamplerMipmapMode(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateSampler
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct SamplerCreateInfo) -> Ptr AllocationCallbacks -> Ptr Sampler -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct SamplerCreateInfo) -> Ptr AllocationCallbacks -> Ptr Sampler -> IO Result
createSampler :: forall a io
. (Extendss SamplerCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(SamplerCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Sampler)
createSampler :: Device
-> SamplerCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Sampler
createSampler device :: Device
device createInfo :: SamplerCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Sampler -> io Sampler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sampler -> io Sampler)
-> (ContT Sampler IO Sampler -> IO Sampler)
-> ContT Sampler IO Sampler
-> io Sampler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Sampler IO Sampler -> IO Sampler
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Sampler IO Sampler -> io Sampler)
-> ContT Sampler IO Sampler -> io Sampler
forall a b. (a -> b) -> a -> b
$ do
let vkCreateSamplerPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
vkCreateSamplerPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
pVkCreateSampler (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT Sampler IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Sampler IO ()) -> IO () -> ContT Sampler IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
vkCreateSamplerPtr FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateSampler is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateSampler' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result
vkCreateSampler' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result
mkVkCreateSampler FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result)
vkCreateSamplerPtr
Ptr (SamplerCreateInfo a)
pCreateInfo <- ((Ptr (SamplerCreateInfo a) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO (Ptr (SamplerCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SamplerCreateInfo a) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO (Ptr (SamplerCreateInfo a)))
-> ((Ptr (SamplerCreateInfo a) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO (Ptr (SamplerCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SamplerCreateInfo a
-> (Ptr (SamplerCreateInfo a) -> IO Sampler) -> IO Sampler
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SamplerCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Sampler IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Sampler)
-> IO Sampler)
-> ContT Sampler IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Sampler)
-> IO Sampler)
-> ContT Sampler IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Sampler)
-> IO Sampler)
-> ContT Sampler IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Sampler)
-> IO Sampler
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pSampler" ::: Ptr Sampler
pPSampler <- ((("pSampler" ::: Ptr Sampler) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO ("pSampler" ::: Ptr Sampler)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSampler" ::: Ptr Sampler) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO ("pSampler" ::: Ptr Sampler))
-> ((("pSampler" ::: Ptr Sampler) -> IO Sampler) -> IO Sampler)
-> ContT Sampler IO ("pSampler" ::: Ptr Sampler)
forall a b. (a -> b) -> a -> b
$ IO ("pSampler" ::: Ptr Sampler)
-> (("pSampler" ::: Ptr Sampler) -> IO ())
-> (("pSampler" ::: Ptr Sampler) -> IO Sampler)
-> IO Sampler
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pSampler" ::: Ptr Sampler)
forall a. Int -> IO (Ptr a)
callocBytes @Sampler 8) ("pSampler" ::: Ptr Sampler) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Sampler IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Sampler IO Result)
-> IO Result -> ContT Sampler IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateSampler" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSampler" ::: Ptr Sampler)
-> IO Result
vkCreateSampler' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (SamplerCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct SamplerCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SamplerCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pSampler" ::: Ptr Sampler
pPSampler))
IO () -> ContT Sampler IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Sampler IO ()) -> IO () -> ContT Sampler IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Sampler
pSampler <- IO Sampler -> ContT Sampler IO Sampler
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Sampler -> ContT Sampler IO Sampler)
-> IO Sampler -> ContT Sampler IO Sampler
forall a b. (a -> b) -> a -> b
$ ("pSampler" ::: Ptr Sampler) -> IO Sampler
forall a. Storable a => Ptr a -> IO a
peek @Sampler "pSampler" ::: Ptr Sampler
pPSampler
Sampler -> ContT Sampler IO Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sampler -> ContT Sampler IO Sampler)
-> Sampler -> ContT Sampler IO Sampler
forall a b. (a -> b) -> a -> b
$ (Sampler
pSampler)
withSampler :: forall a io r . (Extendss SamplerCreateInfo a, PokeChain a, MonadIO io) => Device -> SamplerCreateInfo a -> Maybe AllocationCallbacks -> (io Sampler -> (Sampler -> io ()) -> r) -> r
withSampler :: Device
-> SamplerCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Sampler -> (Sampler -> io ()) -> r)
-> r
withSampler device :: Device
device pCreateInfo :: SamplerCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Sampler -> (Sampler -> io ()) -> r
b =
io Sampler -> (Sampler -> io ()) -> r
b (Device
-> SamplerCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Sampler
forall (a :: [*]) (io :: * -> *).
(Extendss SamplerCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SamplerCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Sampler
createSampler Device
device SamplerCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Sampler
o0) -> Device
-> Sampler -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Sampler -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroySampler Device
device Sampler
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroySampler
:: FunPtr (Ptr Device_T -> Sampler -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Sampler -> Ptr AllocationCallbacks -> IO ()
destroySampler :: forall io
. (MonadIO io)
=>
Device
->
Sampler
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySampler :: Device
-> Sampler -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroySampler device :: Device
device sampler :: Sampler
sampler allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroySamplerPtr :: FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroySamplerPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroySampler (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroySamplerPtr FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroySampler is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroySampler' :: Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySampler' = FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Sampler
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroySampler FunPtr
(Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroySamplerPtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent "vkDestroySampler" (Ptr Device_T
-> Sampler -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySampler' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Sampler
sampler) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()
data SamplerCreateInfo (es :: [Type]) = SamplerCreateInfo
{
SamplerCreateInfo es -> Chain es
next :: Chain es
,
SamplerCreateInfo es -> SamplerCreateFlags
flags :: SamplerCreateFlags
,
SamplerCreateInfo es -> Filter
magFilter :: Filter
,
SamplerCreateInfo es -> Filter
minFilter :: Filter
,
SamplerCreateInfo es -> SamplerMipmapMode
mipmapMode :: SamplerMipmapMode
,
SamplerCreateInfo es -> SamplerAddressMode
addressModeU :: SamplerAddressMode
,
SamplerCreateInfo es -> SamplerAddressMode
addressModeV :: SamplerAddressMode
,
SamplerCreateInfo es -> SamplerAddressMode
addressModeW :: SamplerAddressMode
,
SamplerCreateInfo es -> Float
mipLodBias :: Float
,
SamplerCreateInfo es -> Bool
anisotropyEnable :: Bool
,
SamplerCreateInfo es -> Float
maxAnisotropy :: Float
,
SamplerCreateInfo es -> Bool
compareEnable :: Bool
,
SamplerCreateInfo es -> CompareOp
compareOp :: CompareOp
,
SamplerCreateInfo es -> Float
minLod :: Float
,
SamplerCreateInfo es -> Float
maxLod :: Float
,
SamplerCreateInfo es -> BorderColor
borderColor :: BorderColor
,
SamplerCreateInfo es -> Bool
unnormalizedCoordinates :: Bool
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SamplerCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SamplerCreateInfo es)
instance Extensible SamplerCreateInfo where
extensibleTypeName :: String
extensibleTypeName = "SamplerCreateInfo"
setNext :: SamplerCreateInfo ds -> Chain es -> SamplerCreateInfo es
setNext x :: SamplerCreateInfo ds
x next :: Chain es
next = SamplerCreateInfo ds
x{$sel:next:SamplerCreateInfo :: Chain es
next = Chain es
next}
getNext :: SamplerCreateInfo es -> Chain es
getNext SamplerCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends SamplerCreateInfo e => b) -> Maybe b
extends :: proxy e -> (Extends SamplerCreateInfo e => b) -> Maybe b
extends _ f :: Extends SamplerCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable SamplerCustomBorderColorCreateInfoEXT) =>
Maybe (e :~: SamplerCustomBorderColorCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SamplerCustomBorderColorCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SamplerCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable SamplerReductionModeCreateInfo) =>
Maybe (e :~: SamplerReductionModeCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SamplerReductionModeCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SamplerCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable SamplerYcbcrConversionInfo) =>
Maybe (e :~: SamplerYcbcrConversionInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SamplerYcbcrConversionInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SamplerCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss SamplerCreateInfo es, PokeChain es) => ToCStruct (SamplerCreateInfo es) where
withCStruct :: SamplerCreateInfo es
-> (Ptr (SamplerCreateInfo es) -> IO b) -> IO b
withCStruct x :: SamplerCreateInfo es
x f :: Ptr (SamplerCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (SamplerCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 80 8 ((Ptr (SamplerCreateInfo es) -> IO b) -> IO b)
-> (Ptr (SamplerCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SamplerCreateInfo es)
p -> Ptr (SamplerCreateInfo es) -> SamplerCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SamplerCreateInfo es)
p SamplerCreateInfo es
x (Ptr (SamplerCreateInfo es) -> IO b
f Ptr (SamplerCreateInfo es)
p)
pokeCStruct :: Ptr (SamplerCreateInfo es) -> SamplerCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (SamplerCreateInfo es)
p SamplerCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerCreateFlags -> SamplerCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SamplerCreateFlags)) (SamplerCreateFlags
flags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Filter)) (Filter
magFilter)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Filter)) (Filter
minFilter)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerMipmapMode -> SamplerMipmapMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerMipmapMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr SamplerMipmapMode)) (SamplerMipmapMode
mipmapMode)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr SamplerAddressMode)) (SamplerAddressMode
addressModeU)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SamplerAddressMode)) (SamplerAddressMode
addressModeV)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SamplerAddressMode)) (SamplerAddressMode
addressModeW)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
mipLodBias))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
anisotropyEnable))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxAnisotropy))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
compareEnable))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CompareOp -> CompareOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CompareOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CompareOp)) (CompareOp
compareOp)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
minLod))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 68 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxLod))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr BorderColor -> BorderColor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr BorderColor
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr BorderColor)) (BorderColor
borderColor)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 76 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
unnormalizedCoordinates))
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 80
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (SamplerCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SamplerCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Filter)) (Filter
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Filter)) (Filter
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerMipmapMode -> SamplerMipmapMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerMipmapMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr SamplerMipmapMode)) (SamplerMipmapMode
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr SamplerAddressMode)) (SamplerAddressMode
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SamplerAddressMode)) (SamplerAddressMode
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SamplerAddressMode -> SamplerAddressMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SamplerAddressMode)) (SamplerAddressMode
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CompareOp -> CompareOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CompareOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CompareOp)) (CompareOp
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 68 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr BorderColor -> BorderColor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr BorderColor
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr BorderColor)) (BorderColor
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 76 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss SamplerCreateInfo es, PeekChain es) => FromCStruct (SamplerCreateInfo es) where
peekCStruct :: Ptr (SamplerCreateInfo es) -> IO (SamplerCreateInfo es)
peekCStruct p :: Ptr (SamplerCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
SamplerCreateFlags
flags <- Ptr SamplerCreateFlags -> IO SamplerCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @SamplerCreateFlags ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SamplerCreateFlags))
Filter
magFilter <- Ptr Filter -> IO Filter
forall a. Storable a => Ptr a -> IO a
peek @Filter ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Filter))
Filter
minFilter <- Ptr Filter -> IO Filter
forall a. Storable a => Ptr a -> IO a
peek @Filter ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Filter))
SamplerMipmapMode
mipmapMode <- Ptr SamplerMipmapMode -> IO SamplerMipmapMode
forall a. Storable a => Ptr a -> IO a
peek @SamplerMipmapMode ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerMipmapMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr SamplerMipmapMode))
SamplerAddressMode
addressModeU <- Ptr SamplerAddressMode -> IO SamplerAddressMode
forall a. Storable a => Ptr a -> IO a
peek @SamplerAddressMode ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr SamplerAddressMode))
SamplerAddressMode
addressModeV <- Ptr SamplerAddressMode -> IO SamplerAddressMode
forall a. Storable a => Ptr a -> IO a
peek @SamplerAddressMode ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SamplerAddressMode))
SamplerAddressMode
addressModeW <- Ptr SamplerAddressMode -> IO SamplerAddressMode
forall a. Storable a => Ptr a -> IO a
peek @SamplerAddressMode ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr SamplerAddressMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SamplerAddressMode))
CFloat
mipLodBias <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr CFloat))
Bool32
anisotropyEnable <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Bool32))
CFloat
maxAnisotropy <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr CFloat))
Bool32
compareEnable <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr Bool32))
CompareOp
compareOp <- Ptr CompareOp -> IO CompareOp
forall a. Storable a => Ptr a -> IO a
peek @CompareOp ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CompareOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CompareOp))
CFloat
minLod <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr CFloat))
CFloat
maxLod <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 68 :: Ptr CFloat))
BorderColor
borderColor <- Ptr BorderColor -> IO BorderColor
forall a. Storable a => Ptr a -> IO a
peek @BorderColor ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr BorderColor
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr BorderColor))
Bool32
unnormalizedCoordinates <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr (SamplerCreateInfo es)
p Ptr (SamplerCreateInfo es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 76 :: Ptr Bool32))
SamplerCreateInfo es -> IO (SamplerCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplerCreateInfo es -> IO (SamplerCreateInfo es))
-> SamplerCreateInfo es -> IO (SamplerCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> SamplerCreateFlags
-> Filter
-> Filter
-> SamplerMipmapMode
-> SamplerAddressMode
-> SamplerAddressMode
-> SamplerAddressMode
-> Float
-> Bool
-> Float
-> Bool
-> CompareOp
-> Float
-> Float
-> BorderColor
-> Bool
-> SamplerCreateInfo es
forall (es :: [*]).
Chain es
-> SamplerCreateFlags
-> Filter
-> Filter
-> SamplerMipmapMode
-> SamplerAddressMode
-> SamplerAddressMode
-> SamplerAddressMode
-> Float
-> Bool
-> Float
-> Bool
-> CompareOp
-> Float
-> Float
-> BorderColor
-> Bool
-> SamplerCreateInfo es
SamplerCreateInfo
Chain es
next SamplerCreateFlags
flags Filter
magFilter Filter
minFilter SamplerMipmapMode
mipmapMode SamplerAddressMode
addressModeU SamplerAddressMode
addressModeV SamplerAddressMode
addressModeW (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
mipLodBias) (Bool32 -> Bool
bool32ToBool Bool32
anisotropyEnable) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxAnisotropy) (Bool32 -> Bool
bool32ToBool Bool32
compareEnable) CompareOp
compareOp (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
minLod) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxLod) BorderColor
borderColor (Bool32 -> Bool
bool32ToBool Bool32
unnormalizedCoordinates)
instance es ~ '[] => Zero (SamplerCreateInfo es) where
zero :: SamplerCreateInfo es
zero = Chain es
-> SamplerCreateFlags
-> Filter
-> Filter
-> SamplerMipmapMode
-> SamplerAddressMode
-> SamplerAddressMode
-> SamplerAddressMode
-> Float
-> Bool
-> Float
-> Bool
-> CompareOp
-> Float
-> Float
-> BorderColor
-> Bool
-> SamplerCreateInfo es
forall (es :: [*]).
Chain es
-> SamplerCreateFlags
-> Filter
-> Filter
-> SamplerMipmapMode
-> SamplerAddressMode
-> SamplerAddressMode
-> SamplerAddressMode
-> Float
-> Bool
-> Float
-> Bool
-> CompareOp
-> Float
-> Float
-> BorderColor
-> Bool
-> SamplerCreateInfo es
SamplerCreateInfo
()
SamplerCreateFlags
forall a. Zero a => a
zero
Filter
forall a. Zero a => a
zero
Filter
forall a. Zero a => a
zero
SamplerMipmapMode
forall a. Zero a => a
zero
SamplerAddressMode
forall a. Zero a => a
zero
SamplerAddressMode
forall a. Zero a => a
zero
SamplerAddressMode
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Bool
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Bool
forall a. Zero a => a
zero
CompareOp
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
BorderColor
forall a. Zero a => a
zero
Bool
forall a. Zero a => a
zero