{-# language CPP #-}
module Vulkan.Core10.Sampler  ( createSampler
                              , withSampler
                              , destroySampler
                              , SamplerCreateInfo(..)
                              , Sampler(..)
                              , BorderColor(..)
                              , Filter(..)
                              , SamplerMipmapMode(..)
                              , SamplerAddressMode(..)
                              , SamplerCreateFlagBits(..)
                              , SamplerCreateFlags
                              ) where

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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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(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 (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
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

-- | vkCreateSampler - Create a new sampler object
--
-- == Valid Usage
--
-- -   There /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxSamplerAllocationCount@
--     VkSampler objects currently created on the device.
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'SamplerCreateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pSampler@ /must/ be a valid pointer to a
--     'Vulkan.Core10.Handles.Sampler' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Sampler',
-- 'SamplerCreateInfo'
createSampler :: forall a io
               . (Extendss SamplerCreateInfo a, PokeChain a, MonadIO io)
              => -- | @device@ is the logical device that creates the sampler.
                 Device
              -> -- | @pCreateInfo@ is a pointer to a 'SamplerCreateInfo' structure specifying
                 -- the state of the sampler object.
                 (SamplerCreateInfo a)
              -> -- | @pAllocator@ controls host memory allocation as described in the
                 -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                 -- chapter.
                 ("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
$ 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)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createSampler' and 'destroySampler'
--
-- To ensure that 'destroySampler' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
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 ()

-- | vkDestroySampler - Destroy a sampler object
--
-- == Valid Usage
--
-- -   All submitted commands that refer to @sampler@ /must/ have completed
--     execution
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @sampler@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @sampler@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @sampler@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @sampler@ /must/ be a valid 'Vulkan.Core10.Handles.Sampler' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @sampler@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @sampler@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Sampler'
destroySampler :: forall io
                . (MonadIO io)
               => -- | @device@ is the logical device that destroys the sampler.
                  Device
               -> -- | @sampler@ is the sampler to destroy.
                  Sampler
               -> -- | @pAllocator@ controls host memory allocation as described in the
                  -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                  -- chapter.
                  ("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
$ 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
$ ()


-- | VkSamplerCreateInfo - Structure specifying parameters of a newly created
-- sampler
--
-- = Description
--
-- Mapping of OpenGL to Vulkan filter modes
--
-- @magFilter@ values of 'Vulkan.Core10.Enums.Filter.FILTER_NEAREST' and
-- 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' directly correspond to
-- @GL_NEAREST@ and @GL_LINEAR@ magnification filters. @minFilter@ and
-- @mipmapMode@ combine to correspond to the similarly named OpenGL
-- minification filter of @GL_minFilter_MIPMAP_mipmapMode@ (e.g.
-- @minFilter@ of 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
-- @mipmapMode@ of
-- 'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_NEAREST'
-- correspond to @GL_LINEAR_MIPMAP_NEAREST@).
--
-- There are no Vulkan filter modes that directly correspond to OpenGL
-- minification filters of @GL_LINEAR@ or @GL_NEAREST@, but they /can/ be
-- emulated using
-- 'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_NEAREST',
-- @minLod@ = 0, and @maxLod@ = 0.25, and using @minFilter@ =
-- 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' or @minFilter@ =
-- 'Vulkan.Core10.Enums.Filter.FILTER_NEAREST', respectively.
--
-- Note that using a @maxLod@ of zero would cause
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-texel-filtering magnification>
-- to always be performed, and the @magFilter@ to always be used. This is
-- valid, just not an exact match for OpenGL behavior. Clamping the maximum
-- LOD to 0.25 allows the λ value to be non-zero and minification to be
-- performed, while still always rounding down to the base level. If the
-- @minFilter@ and @magFilter@ are equal, then using a @maxLod@ of zero
-- also works.
--
-- The maximum number of sampler objects which /can/ be simultaneously
-- created on a device is implementation-dependent and specified by the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxSamplerAllocationCount maxSamplerAllocationCount>
-- member of the 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'
-- structure. If @maxSamplerAllocationCount@ is exceeded, 'createSampler'
-- will return 'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'.
--
-- Since 'Vulkan.Core10.Handles.Sampler' is a non-dispatchable handle type,
-- implementations /may/ return the same handle for sampler state vectors
-- that are identical. In such cases, all such objects would only count
-- once against the @maxSamplerAllocationCount@ limit.
--
-- == Valid Usage
--
-- -   The absolute value of @mipLodBias@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxSamplerLodBias@
--
-- -   @maxLod@ /must/ be greater than or equal to @minLod@
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-samplerAnisotropy anisotropic sampling>
--     feature is not enabled, @anisotropyEnable@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @anisotropyEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE',
--     @maxAnisotropy@ /must/ be between @1.0@ and
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxSamplerAnisotropy@,
--     inclusive
--
-- -   If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>
--     is enabled and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     of the sampler Y′CBCR conversion do not support
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_YCBCR_CONVERSION_SEPARATE_RECONSTRUCTION_FILTER_BIT',
--     @minFilter@ and @magFilter@ /must/ be equal to the sampler Y′CBCR
--     conversion’s @chromaFilter@
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @minFilter@ and @magFilter@
--     /must/ be equal
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @mipmapMode@ /must/ be
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_NEAREST'
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @minLod@ and @maxLod@ /must/
--     be zero
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @addressModeU@ and
--     @addressModeV@ /must/ each be either
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--     or
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER'
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @anisotropyEnable@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @unnormalizedCoordinates@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', @compareEnable@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If any of @addressModeU@, @addressModeV@ or @addressModeW@ are
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER',
--     @borderColor@ /must/ be a valid
--     'Vulkan.Core10.Enums.BorderColor.BorderColor' value
--
-- -   If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>
--     is enabled, @addressModeU@, @addressModeV@, and @addressModeW@
--     /must/ be
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE',
--     @anisotropyEnable@ /must/ be 'Vulkan.Core10.FundamentalTypes.FALSE',
--     and @unnormalizedCoordinates@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   The sampler reduction mode /must/ be set to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE'
--     if
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>
--     is enabled
--
-- -   If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-samplerMirrorClampToEdge samplerMirrorClampToEdge>
--     is not enabled, and if the @VK_KHR_sampler_mirror_clamp_to_edge@
--     extension is not enabled, @addressModeU@, @addressModeV@ and
--     @addressModeW@ /must/ not be
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_MIRROR_CLAMP_TO_EDGE'
--
-- -   If @compareEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE',
--     @compareOp@ /must/ be a valid
--     'Vulkan.Core10.Enums.CompareOp.CompareOp' value
--
-- -   If either @magFilter@ or @minFilter@ is
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT',
--     @anisotropyEnable@ /must/ be 'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @compareEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE', the
--     @reductionMode@ member of
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'
--     /must/ be
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @minFilter@ and @magFilter@ /must/ be equal
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @mipmapMode@ /must/ be
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_NEAREST'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @minLod@ and @maxLod@ /must/ be zero
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @addressModeU@ and @addressModeV@ /must/ each be either
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--     or
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @anisotropyEnable@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @compareEnable@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_SUBSAMPLED_BIT_EXT',
--     then @unnormalizedCoordinates@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If @borderColor@ is set to one of
--     'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT' or
--     'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT', then
--     a
--     'Vulkan.Extensions.VK_EXT_custom_border_color.SamplerCustomBorderColorCreateInfoEXT'
--     /must/ be present in the @pNext@ chain
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-customBorderColors customBorderColors>
--     feature is not enabled, @borderColor@ /must/ not be set to
--     'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT' or
--     'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT'
--
-- -   The maximum number of samplers with custom border colors which /can/
--     be simultaneously created on a device is implementation-dependent
--     and specified by the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxCustomBorderColorSamplers maxCustomBorderColorSamplers>
--     member of the
--     'Vulkan.Extensions.VK_EXT_custom_border_color.PhysicalDeviceCustomBorderColorPropertiesEXT'
--     structure
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLER_CREATE_INFO'
--
-- -   Each @pNext@ member of any structure (including this one) in the
--     @pNext@ chain /must/ be either @NULL@ or a pointer to a valid
--     instance of
--     'Vulkan.Extensions.VK_EXT_custom_border_color.SamplerCustomBorderColorCreateInfoEXT',
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo',
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionInfo'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- -   @flags@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SamplerCreateFlagBits'
--     values
--
-- -   @magFilter@ /must/ be a valid 'Vulkan.Core10.Enums.Filter.Filter'
--     value
--
-- -   @minFilter@ /must/ be a valid 'Vulkan.Core10.Enums.Filter.Filter'
--     value
--
-- -   @mipmapMode@ /must/ be a valid
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SamplerMipmapMode' value
--
-- -   @addressModeU@ /must/ be a valid
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
--
-- -   @addressModeV@ /must/ be a valid
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
--
-- -   @addressModeW@ /must/ be a valid
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.BorderColor.BorderColor',
-- 'Vulkan.Core10.Enums.CompareOp.CompareOp',
-- 'Vulkan.Core10.Enums.Filter.Filter',
-- 'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode',
-- 'Vulkan.Core10.Enums.SamplerCreateFlagBits.SamplerCreateFlags',
-- 'Vulkan.Core10.Enums.SamplerMipmapMode.SamplerMipmapMode',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createSampler'
data SamplerCreateInfo (es :: [Type]) = SamplerCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    SamplerCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.SamplerCreateFlagBits.SamplerCreateFlagBits'
    -- describing additional parameters of the sampler.
    SamplerCreateInfo es -> SamplerCreateFlags
flags :: SamplerCreateFlags
  , -- | @magFilter@ is a 'Vulkan.Core10.Enums.Filter.Filter' value specifying
    -- the magnification filter to apply to lookups.
    SamplerCreateInfo es -> Filter
magFilter :: Filter
  , -- | @minFilter@ is a 'Vulkan.Core10.Enums.Filter.Filter' value specifying
    -- the minification filter to apply to lookups.
    SamplerCreateInfo es -> Filter
minFilter :: Filter
  , -- | @mipmapMode@ is a
    -- 'Vulkan.Core10.Enums.SamplerMipmapMode.SamplerMipmapMode' value
    -- specifying the mipmap filter to apply to lookups.
    SamplerCreateInfo es -> SamplerMipmapMode
mipmapMode :: SamplerMipmapMode
  , -- | @addressModeU@ is a
    -- 'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
    -- specifying the addressing mode for outside [0..1] range for U
    -- coordinate.
    SamplerCreateInfo es -> SamplerAddressMode
addressModeU :: SamplerAddressMode
  , -- | @addressModeV@ is a
    -- 'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
    -- specifying the addressing mode for outside [0..1] range for V
    -- coordinate.
    SamplerCreateInfo es -> SamplerAddressMode
addressModeV :: SamplerAddressMode
  , -- | @addressModeW@ is a
    -- 'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' value
    -- specifying the addressing mode for outside [0..1] range for W
    -- coordinate.
    SamplerCreateInfo es -> SamplerAddressMode
addressModeW :: SamplerAddressMode
  , -- | @mipLodBias@ is the bias to be added to mipmap LOD (level-of-detail)
    -- calculation and bias provided by image sampling functions in SPIR-V, as
    -- described in the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-level-of-detail-operation Level-of-Detail Operation>
    -- section.
    SamplerCreateInfo es -> Float
mipLodBias :: Float
  , -- | @anisotropyEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE' to enable
    -- anisotropic filtering, as described in the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-texel-anisotropic-filtering Texel Anisotropic Filtering>
    -- section, or 'Vulkan.Core10.FundamentalTypes.FALSE' otherwise.
    SamplerCreateInfo es -> Bool
anisotropyEnable :: Bool
  , -- | @maxAnisotropy@ is the anisotropy value clamp used by the sampler when
    -- @anisotropyEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE'. If
    -- @anisotropyEnable@ is 'Vulkan.Core10.FundamentalTypes.FALSE',
    -- @maxAnisotropy@ is ignored.
    SamplerCreateInfo es -> Float
maxAnisotropy :: Float
  , -- | @compareEnable@ is 'Vulkan.Core10.FundamentalTypes.TRUE' to enable
    -- comparison against a reference value during lookups, or
    -- 'Vulkan.Core10.FundamentalTypes.FALSE' otherwise.
    --
    -- -   Note: Some implementations will default to shader state if this
    --     member does not match.
    SamplerCreateInfo es -> Bool
compareEnable :: Bool
  , -- | @compareOp@ is a 'Vulkan.Core10.Enums.CompareOp.CompareOp' value
    -- specifying the comparison function to apply to fetched data before
    -- filtering as described in the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation Depth Compare Operation>
    -- section.
    SamplerCreateInfo es -> CompareOp
compareOp :: CompareOp
  , -- | @minLod@ and @maxLod@ are the values used to clamp the computed LOD
    -- value, as described in the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-level-of-detail-operation Level-of-Detail Operation>
    -- section.
    SamplerCreateInfo es -> Float
minLod :: Float
  , -- No documentation found for Nested "VkSamplerCreateInfo" "maxLod"
    SamplerCreateInfo es -> Float
maxLod :: Float
  , -- | @borderColor@ is a 'Vulkan.Core10.Enums.BorderColor.BorderColor' value
    -- specifying the predefined border color to use.
    SamplerCreateInfo es -> BorderColor
borderColor :: BorderColor
  , -- | @unnormalizedCoordinates@ controls whether to use unnormalized or
    -- normalized texel coordinates to address texels of the image. When set to
    -- 'Vulkan.Core10.FundamentalTypes.TRUE', the range of the image
    -- coordinates used to lookup the texel is in the range of zero to the
    -- image dimensions for x, y and z. When set to
    -- 'Vulkan.Core10.FundamentalTypes.FALSE' the range of image coordinates is
    -- zero to one.
    --
    -- When @unnormalizedCoordinates@ is 'Vulkan.Core10.FundamentalTypes.TRUE',
    -- images the sampler is used with in the shader have the following
    -- requirements:
    --
    -- -   The @viewType@ /must/ be either
    --     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D' or
    --     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D'.
    --
    -- -   The image view /must/ have a single layer and a single mip level.
    --
    -- When @unnormalizedCoordinates@ is 'Vulkan.Core10.FundamentalTypes.TRUE',
    -- image built-in functions in the shader that use the sampler have the
    -- following requirements:
    --
    -- -   The functions /must/ not use projection.
    --
    -- -   The functions /must/ not use offsets.
    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
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_SAMPLER_CREATE_INFO
  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 a :: Float
a) -> Float
a) CFloat
mipLodBias) (Bool32 -> Bool
bool32ToBool Bool32
anisotropyEnable) ((\(CFloat a :: Float
a) -> Float
a) CFloat
maxAnisotropy) (Bool32 -> Bool
bool32ToBool Bool32
compareEnable) CompareOp
compareOp ((\(CFloat a :: Float
a) -> Float
a) CFloat
minLod) ((\(CFloat a :: Float
a) -> Float
a) 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