-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Texture.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_HADDOCK prune #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Texture
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Texture management for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Texture (

  -- * Texture Reference Management
  Texture(..), Format(..), AddressMode(..), FilterMode(..), ReadMode(..),
  bind, bind2D,
  getAddressMode, getFilterMode, getFormat,
  setAddressMode, setFilterMode, setFormat, setReadMode,

  -- Deprecated
  create, destroy,

  -- Internal
  peekTex

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 31 "src/Foreign/CUDA/Driver/Texture.chs" #-}


-- Friends
import Foreign.CUDA.Ptr
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Marshal
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Control.Monad

{-# DEPRECATED create, destroy "as of CUDA version 3.2" #-}


--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A texture reference
--
newtype Texture = Texture { Texture -> Ptr ()
useTexture :: ((C2HSImp.Ptr ()))}
  deriving (Texture -> Texture -> Bool
(Texture -> Texture -> Bool)
-> (Texture -> Texture -> Bool) -> Eq Texture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
/= :: Texture -> Texture -> Bool
Eq, Int -> Texture -> ShowS
[Texture] -> ShowS
Texture -> String
(Int -> Texture -> ShowS)
-> (Texture -> String) -> ([Texture] -> ShowS) -> Show Texture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Texture -> ShowS
showsPrec :: Int -> Texture -> ShowS
$cshow :: Texture -> String
show :: Texture -> String
$cshowList :: [Texture] -> ShowS
showList :: [Texture] -> ShowS
Show)

instance Storable Texture where
  sizeOf :: Texture -> Int
sizeOf Texture
_    = Ptr () -> Int
forall a. Storable a => a -> Int
sizeOf    (Ptr ()
forall a. HasCallStack => a
undefined :: ((C2HSImp.Ptr ())))
  alignment :: Texture -> Int
alignment Texture
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. HasCallStack => a
undefined :: ((C2HSImp.Ptr ())))
  peek :: Ptr Texture -> IO Texture
peek Ptr Texture
p      = Ptr () -> Texture
Texture (Ptr () -> Texture) -> IO (Ptr ()) -> IO Texture
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr Texture -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr Texture
p)
  poke :: Ptr Texture -> Texture -> IO ()
poke Ptr Texture
p Texture
t    = Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Texture -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr Texture
p) (Texture -> Ptr ()
useTexture Texture
t)

-- |
-- Texture reference addressing modes
--
data AddressMode = Wrap
                 | Clamp
                 | Mirror
                 | Border
  deriving (AddressMode -> AddressMode -> Bool
(AddressMode -> AddressMode -> Bool)
-> (AddressMode -> AddressMode -> Bool) -> Eq AddressMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressMode -> AddressMode -> Bool
== :: AddressMode -> AddressMode -> Bool
$c/= :: AddressMode -> AddressMode -> Bool
/= :: AddressMode -> AddressMode -> Bool
Eq,Int -> AddressMode -> ShowS
[AddressMode] -> ShowS
AddressMode -> String
(Int -> AddressMode -> ShowS)
-> (AddressMode -> String)
-> ([AddressMode] -> ShowS)
-> Show AddressMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressMode -> ShowS
showsPrec :: Int -> AddressMode -> ShowS
$cshow :: AddressMode -> String
show :: AddressMode -> String
$cshowList :: [AddressMode] -> ShowS
showList :: [AddressMode] -> ShowS
Show)
instance Enum AddressMode where
  succ Wrap = Clamp
  succ Clamp = Mirror
  succ Mirror = Border
  succ Border = error "AddressMode.succ: Border has no successor"

  pred :: AddressMode -> AddressMode
pred AddressMode
Clamp = AddressMode
Int -> FilterMode -> ShowS
[FilterMode] -> ShowS
FilterMode -> String
(Int -> FilterMode -> ShowS)
-> (FilterMode -> String)
-> ([FilterMode] -> ShowS)
-> Show FilterMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterMode -> ShowS
showsPrec :: Int -> FilterMode -> ShowS
$cshow :: FilterMode -> String
show :: FilterMode -> String
$cshowList :: [FilterMode] -> ShowS
showList :: [FilterMode] -> ShowS
Wrap
  pred AddressMode
Mirror = AddressMode
Clamp
  pred AddressMode
Border = AddressMode
Mirror
  pred AddressMode
Wrap = String -> AddressMode
forall a. HasCallStack => String -> a
error String
"AddressMode.pred: Wrap has no predecessor"

  enumFromTo :: AddressMode -> AddressMode -> [AddressMode]
enumFromTo AddressMode
from AddressMode
to = go from
    where
      end :: Int
end = AddressMode -> Int
forall a. Enum a => a -> Int
fromEnum AddressMode
to
      go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 Ordering
EQ -> [t
v]
                 Ordering
GT -> []

  enumFrom from = enumFromTo from Border

  fromEnum Wrap = 0
  fromEnum Clamp = 1
  fromEnum Mirror = 2
  fromEnum Border = 3

  toEnum 0 = Wrap
  toEnum 1 = Clamp
  toEnum 2 = Mirror
  toEnum 3 = Border
  toEnum unmatched = error ("AddressMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 70 "src/Foreign/CUDA/Driver/Texture.chs" #-}


-- |
-- Texture reference filtering mode
--
data FilterMode = Point
                | Linear
  deriving (Eq,Show)
instance Enum FilterMode where
  succ Point = Linear
  succ Linear = error "FilterMode.succ: Linear has no successor"

  pred Linear = Point
  pred Point = error "FilterMode.pred: Point has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Linear

  fromEnum Point = 0
  fromEnum Linear = 1

  toEnum 0 = Point
  toEnum 1 = Linear
  toEnum unmatched = error ("FilterMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 77 "src/Foreign/CUDA/Driver/Texture.chs" #-}


-- |
-- Texture read mode options
--
data ReadMode = ReadAsInteger
              | NormalizedCoordinates
              | SRGB
  deriving (Eq,Show)
instance Enum ReadMode where
  succ ReadAsInteger = NormalizedCoordinates
  succ NormalizedCoordinates = SRGB
  succ SRGB = error "ReadMode.succ: SRGB has no successor"

  pred NormalizedCoordinates = ReadAsInteger
  pred SRGB = NormalizedCoordinates
  pred ReadAsInteger = error "ReadMode.pred: ReadAsInteger has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SRGB

  fromEnum :: ReadMode -> Int
fromEnum ReadMode
ReadAsInteger = Int
1
  fromEnum ReadMode
NormalizedCoordinates = Int
2
  fromEnum ReadMode
SRGB = Int
16

  toEnum :: Int -> ReadMode
toEnum Int
1 = ReadMode
ReadAsInteger
  toEnum Int
2 = ReadMode
NormalizedCoordinates
  toEnum Int
16 = ReadMode
SRGB
  toEnum Int
unmatched = String -> ReadMode
forall a. HasCallStack => String -> a
error (String
"ReadMode.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 92 "src/Foreign/CUDA/Driver/Texture.chs" #-}


-- |
-- Texture data formats
--
data Format = Word8
            | Word16
            | Word32
            | Int8
            | Int16
            | Int32
            | Half
            | Float
            | Bc1Unorm
            | Bc1UnormSrgb
            | Bc2Unorm
            | Bc2UnormSrgb
            | Bc3Unorm
            | Bc3UnormSrgb
            | Bc4Unorm
            | Bc4Snorm
            | Bc5Unorm
            | Bc5Snorm
            | Bc6hUf16
            | Bc6hSf16
            | Bc7Unorm
            | Bc7UnormSrgb
            | Nv12
            | UnormInt8x1
            | UnormInt8x2
            | UnormInt8x4
            | UnormInt16x1
            | UnormInt16x2
            | UnormInt16x4
            | SnormInt8x1
            | SnormInt8x2
            | SnormInt8x4
            | SnormInt16x1
            | SnormInt16x2
            | SnormInt16x4
  deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq,Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show)
instance Enum Format where
  succ Word8 = Word16
  succ Word16 = Word32
  succ Word32 = Int8
  succ Int8 = Int16
  succ Int16 = Int32
  succ Int32 = Half
  succ Half = Float
  succ Float = Bc1Unorm
  succ Bc1Unorm = Bc1UnormSrgb
  succ Bc1UnormSrgb = Bc2Unorm
  succ Bc2Unorm = Bc2UnormSrgb
  succ Bc2UnormSrgb = Bc3Unorm
  succ Bc3Unorm = Bc3UnormSrgb
  succ Bc3UnormSrgb = Bc4Unorm
  succ Bc4Unorm = Bc4Snorm
  succ Bc4Snorm = Bc5Unorm
  succ Bc5Unorm = Bc5Snorm
  succ Bc5Snorm = Bc6hUf16
  succ Bc6hUf16 = Bc6hSf16
  succ Bc6hSf16 = Bc7Unorm
  succ Bc7Unorm = Bc7UnormSrgb
  succ Bc7UnormSrgb = Nv12
  succ Nv12 = UnormInt8x1
  succ UnormInt8x1 = UnormInt8x2
  succ UnormInt8x2 = UnormInt8x4
  succ UnormInt8x4 = UnormInt16x1
  succ UnormInt16x1 = UnormInt16x2
  succ UnormInt16x2 = UnormInt16x4
  succ UnormInt16x4 = SnormInt8x1
  succ SnormInt8x1 = SnormInt8x2
  succ SnormInt8x2 = SnormInt8x4
  succ SnormInt8x4 = SnormInt16x1
  succ SnormInt16x1 = SnormInt16x2
  succ SnormInt16x2 = SnormInt16x4
  succ SnormInt16x4 = error "Format.succ: SnormInt16x4 has no successor"

  pred Word16 = Word8
  pred Word32 = Word16
  pred Int8 = Word32
  pred Int16 = Int8
  pred Int32 = Int16
  pred Half = Int32
  pred Float = Half
  pred Bc1Unorm = Float
  pred Bc1UnormSrgb = Bc1Unorm
  pred Bc2Unorm = Bc1UnormSrgb
  pred Bc2UnormSrgb = Bc2Unorm
  pred Bc3Unorm = Bc2UnormSrgb
  pred Bc3UnormSrgb = Bc3Unorm
  pred Bc4Unorm = Bc3UnormSrgb
  pred Bc4Snorm = Bc4Unorm
  pred Bc5Unorm = Bc4Snorm
  pred Bc5Snorm = Bc5Unorm
  pred Bc6hUf16 = Bc5Snorm
  pred Bc6hSf16 = Bc6hUf16
  pred Bc7Unorm = Bc6hSf16
  pred Bc7UnormSrgb = Bc7Unorm
  pred Nv12 = Bc7UnormSrgb
  pred UnormInt8x1 = Nv12
  pred UnormInt8x2 = UnormInt8x1
  pred UnormInt8x4 = UnormInt8x2
  pred UnormInt16x1 = UnormInt8x4
  pred UnormInt16x2 = UnormInt16x1
  pred UnormInt16x4 = UnormInt16x2
  pred SnormInt8x1 = UnormInt16x4
  pred SnormInt8x2 = SnormInt8x1
  pred SnormInt8x4 = SnormInt8x2
  pred SnormInt16x1 = SnormInt8x4
  pred SnormInt16x2 = SnormInt16x1
  pred SnormInt16x4 = SnormInt16x2
  pred Word8 = error "Format.pred: Word8 has no predecessor"

  enumFromTo :: Format -> Format -> [Format]
enumFromTo Format
from Format
to = Format -> [Format]
forall {t}. Enum t => t -> [t]
go Format
from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SnormInt16x4

  fromEnum Word8 = 1
  fromEnum Word16 = 2
  fromEnum Word32 = 3
  fromEnum Int8 = 8
  fromEnum Int16 = 9
  fromEnum Int32 = 10
  fromEnum Half = 16
  fromEnum Float = 32
  fromEnum Bc1Unorm = 145
  fromEnum Bc1UnormSrgb = 146
  fromEnum Bc2Unorm = 147
  fromEnum Bc2UnormSrgb = 148
  fromEnum Bc3Unorm = 149
  fromEnum Bc3UnormSrgb = 150
  fromEnum Bc4Unorm = 151
  fromEnum Bc4Snorm = 152
  fromEnum Bc5Unorm = 153
  fromEnum Bc5Snorm = 154
  fromEnum Bc6hUf16 = 155
  fromEnum Bc6hSf16 = 156
  fromEnum Bc7Unorm = 157
  fromEnum Bc7UnormSrgb = 158
  fromEnum Nv12 = 176
  fromEnum UnormInt8x1 = 192
  fromEnum UnormInt8x2 = 193
  fromEnum UnormInt8x4 = 194
  fromEnum UnormInt16x1 = 195
  fromEnum UnormInt16x2 = 196
  fromEnum UnormInt16x4 = 197
  fromEnum SnormInt8x1 = 198
  fromEnum SnormInt8x2 = 199
  fromEnum SnormInt8x4 = 200
  fromEnum SnormInt16x1 = 201
  fromEnum SnormInt16x2 = 202
  fromEnum SnormInt16x4 = 203

  toEnum 1 = Word8
  toEnum 2 = Word16
  toEnum 3 = Word32
  toEnum 8 = Int8
  toEnum 9 = Int16
  toEnum 10 = Int32
  toEnum 16 = Half
  toEnum 32 = Float
  toEnum 145 = Bc1Unorm
  toEnum 146 = Bc1UnormSrgb
  toEnum 147 = Bc2Unorm
  toEnum 148 = Bc2UnormSrgb
  toEnum 149 = Bc3Unorm
  toEnum 150 = Bc3UnormSrgb
  toEnum 151 = Bc4Unorm
  toEnum 152 = Bc4Snorm
  toEnum 153 = Bc5Unorm
  toEnum 154 = Bc5Snorm
  toEnum 155 = Bc6hUf16
  toEnum 156 = Bc6hSf16
  toEnum 157 = Bc7Unorm
  toEnum 158 = Bc7UnormSrgb
  toEnum 176 = Nv12
  toEnum 192 = UnormInt8x1
  toEnum 193 = UnormInt8x2
  toEnum 194 = UnormInt8x4
  toEnum 195 = UnormInt16x1
  toEnum 196 = UnormInt16x2
  toEnum 197 = UnormInt16x4
  toEnum 198 = SnormInt8x1
  toEnum 199 = SnormInt8x2
  toEnum 200 = SnormInt8x4
  toEnum 201 = SnormInt16x1
  toEnum 202 = SnormInt16x2
  toEnum 203 = SnormInt16x4
  toEnum unmatched = error ("Format.toEnum: Cannot match " ++ show unmatched)

{-# LINE 105 "src/Foreign/CUDA/Driver/Texture.chs" #-}



--------------------------------------------------------------------------------
-- Texture management
--------------------------------------------------------------------------------

-- |
-- Create a new texture reference. Once created, the application must call
-- 'setPtr' to associate the reference with allocated memory. Other texture
-- reference functions are used to specify the format and interpretation to be
-- used when the memory is read through this reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF__DEPRECATED.html#group__CUDA__TEXREF__DEPRECATED_1g0084fabe2c6d28ffcf9d9f5c7164f16c>
--
{-# INLINEABLE create #-}
create :: IO Texture
create = resultIfOk =<< cuTexRefCreate

{-# INLINE cuTexRefCreate #-}
cuTexRefCreate :: IO ((Status), (Texture))
cuTexRefCreate =
  alloca $ \a1' -> 
  cuTexRefCreate'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  peekTex  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 126 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Destroy a texture reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF__DEPRECATED.html#group__CUDA__TEXREF__DEPRECATED_1gea8edbd6cf9f97e6ab2b41fc6785519d>
--
{-# INLINEABLE destroy #-}
destroy :: Texture -> IO ()
destroy !tex = nothingIfOk =<< cuTexRefDestroy tex

{-# INLINE cuTexRefDestroy #-}
cuTexRefDestroy :: (Texture) -> IO ((Status))
cuTexRefDestroy a1 =
  let {a1' = useTexture a1} in 
  cuTexRefDestroy'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 140 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Bind a linear array address of the given size (bytes) as a texture
-- reference. Any previously bound references are unbound.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g44ef7e5055192d52b3d43456602b50a8>
--
{-# INLINEABLE bind #-}
bind :: Texture -> DevicePtr a -> Int64 -> IO ()
bind !tex !dptr !bytes = nothingIfOk =<< cuTexRefSetAddress tex dptr bytes

{-# INLINE cuTexRefSetAddress #-}
cuTexRefSetAddress :: (Texture) -> (DevicePtr a) -> (Int64) -> IO ((Status))
cuTexRefSetAddress a2 a3 a4 =
  alloca $ \a1' -> 
  let {a2' = useTexture a2} in 
  let {a3' = useDeviceHandle a3} in 
  let {a4' = fromIntegral a4} in 
  cuTexRefSetAddress'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 158 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Bind a linear address range to the given texture reference as a
-- two-dimensional arena. Any previously bound reference is unbound. Note that
-- calls to 'setFormat' can not follow a call to 'bind2D' for the same texture
-- reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g26f709bbe10516681913d1ffe8756ee2>
--
{-# INLINEABLE bind2D #-}
bind2D :: Texture -> Format -> Int -> DevicePtr a -> (Int,Int) -> Int64 -> IO ()
bind2D !tex !fmt !chn !dptr (!width,!height) !pitch =
  nothingIfOk =<< cuTexRefSetAddress2D_simple tex fmt chn dptr width height pitch

{-# INLINE cuTexRefSetAddress2D_simple #-}
cuTexRefSetAddress2D_simple :: (Texture) -> (Format) -> (Int) -> (DevicePtr a) -> (Int) -> (Int) -> (Int64) -> IO ((Status))
cuTexRefSetAddress2D_simple a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = useTexture a1} in 
  let {a2' = cFromEnum a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = useDeviceHandle a4} in 
  let {a5' = fromIntegral a5} in 
  let {a6' = fromIntegral a6} in 
  let {a7' = fromIntegral a7} in 
  cuTexRefSetAddress2D_simple'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 182 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Get the addressing mode used by a texture reference, corresponding to the
-- given dimension (currently the only supported dimension values are 0 or 1).
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1gfb367d93dc1d20aab0cf8ce70d543b33>
--
{-# INLINEABLE getAddressMode #-}
getAddressMode :: Texture -> Int -> IO AddressMode
getAddressMode !tex !dim = resultIfOk =<< cuTexRefGetAddressMode tex dim

{-# INLINE cuTexRefGetAddressMode #-}
cuTexRefGetAddressMode :: (Texture) -> (Int) -> IO ((Status), (AddressMode))
cuTexRefGetAddressMode a2 a3 =
  alloca $ \a1' -> 
  let {a2' = useTexture a2} in 
  let {a3' = fromIntegral a3} in 
  cuTexRefGetAddressMode'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekEnum  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 199 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Get the filtering mode used by a texture reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g2439e069746f69b940f2f4dbc78cdf87>
--
{-# INLINEABLE getFilterMode #-}
getFilterMode :: Texture -> IO FilterMode
getFilterMode !tex = resultIfOk =<< cuTexRefGetFilterMode tex

{-# INLINE cuTexRefGetFilterMode #-}
cuTexRefGetFilterMode :: (Texture) -> IO ((Status), (FilterMode))
cuTexRefGetFilterMode a2 =
  alloca $ \a1' -> 
  let {a2' = useTexture a2} in 
  cuTexRefGetFilterMode'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekEnum  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 214 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Get the data format and number of channel components of the bound texture.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g90936eb6c7c4434a609e1160c278ae53>
--
{-# INLINEABLE getFormat #-}
getFormat :: Texture -> IO (Format, Int)
getFormat !tex = do
  (!status,!fmt,!dim) <- cuTexRefGetFormat tex
  resultIfOk (status,(fmt,dim))

{-# INLINE cuTexRefGetFormat #-}
cuTexRefGetFormat :: (Texture) -> IO ((Status), (Format), (Int))
cuTexRefGetFormat a3 =
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  let {a3' = useTexture a3} in 
  cuTexRefGetFormat'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekEnum  a1'>>= \a1'' -> 
  peekIntConv  a2'>>= \a2'' -> 
  return (res', a1'', a2'')

{-# LINE 232 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Specify the addressing mode for the given dimension of a texture reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g85f4a13eeb94c8072f61091489349bcb>
--
{-# INLINEABLE setAddressMode #-}
setAddressMode :: Texture -> Int -> AddressMode -> IO ()
setAddressMode !tex !dim !mode = nothingIfOk =<< cuTexRefSetAddressMode tex dim mode

{-# INLINE cuTexRefSetAddressMode #-}
cuTexRefSetAddressMode :: (Texture) -> (Int) -> (AddressMode) -> IO ((Status))
cuTexRefSetAddressMode a1 a2 a3 =
  let {a1' = useTexture a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = cFromEnum a3} in 
  cuTexRefSetAddressMode'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 248 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Specify the filtering mode to be used when reading memory through a texture
-- reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g595d0af02c55576f8c835e4efd1f39c0>
--
{-# INLINEABLE setFilterMode #-}
setFilterMode :: Texture -> FilterMode -> IO ()
setFilterMode !tex !mode = nothingIfOk =<< cuTexRefSetFilterMode tex mode

{-# INLINE cuTexRefSetFilterMode #-}
cuTexRefSetFilterMode :: (Texture) -> (FilterMode) -> IO ((Status))
cuTexRefSetFilterMode a1 a2 =
  let {a1' = useTexture a1} in 
  let {a2' = cFromEnum a2} in 
  cuTexRefSetFilterMode'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 264 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Specify additional characteristics for reading and indexing the texture
-- reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g554ffd896487533c36810f2e45bb7a28>
--
{-# INLINEABLE setReadMode #-}
setReadMode :: Texture -> ReadMode -> IO ()
setReadMode !tex !mode = nothingIfOk =<< cuTexRefSetFlags tex mode

{-# INLINE cuTexRefSetFlags #-}
cuTexRefSetFlags :: (Texture) -> (ReadMode) -> IO ((Status))
cuTexRefSetFlags a1 a2 =
  let {a1' = useTexture a1} in 
  let {a2' = cFromEnum a2} in 
  cuTexRefSetFlags'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 280 "src/Foreign/CUDA/Driver/Texture.chs" #-}



-- |
-- Specify the format of the data and number of packed components per element to
-- be read by the texture reference.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TEXREF.html#group__CUDA__TEXREF_1g05585ef8ea2fec728a03c6c8f87cf07a>
--
{-# INLINEABLE setFormat #-}
setFormat :: Texture -> Format -> Int -> IO ()
setFormat :: Texture -> Format -> Int -> IO ()
setFormat !Texture
tex !Format
fmt !Int
chn = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Texture -> Format -> Int -> IO Status
cuTexRefSetFormat Texture
tex Format
fmt Int
chn

{-# INLINE cuTexRefSetFormat #-}
cuTexRefSetFormat :: (Texture) -> (Format) -> (Int) -> IO ((Status))
cuTexRefSetFormat :: Texture -> Format -> Int -> IO Status
cuTexRefSetFormat Texture
a1 Format
a2 Int
a3 =
  let {a1' :: Ptr ()
a1' = Texture -> Ptr ()
useTexture Texture
a1} in 
  let {a2' :: CInt
a2' = Format -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Format
a2} in 
  let {a3' :: CInt
a3' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3} in 
  Ptr () -> CInt -> CInt -> IO CInt
cuTexRefSetFormat'_ Ptr ()
a1' CInt
a2' CInt
a3' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 297 "src/Foreign/CUDA/Driver/Texture.chs" #-}



--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE peekTex #-}
peekTex :: Ptr ((C2HSImp.Ptr ())) -> IO Texture
peekTex :: Ptr (Ptr ()) -> IO Texture
peekTex = (Ptr () -> Texture) -> IO (Ptr ()) -> IO Texture
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> Texture
Texture (IO (Ptr ()) -> IO Texture)
-> (Ptr (Ptr ()) -> IO (Ptr ())) -> Ptr (Ptr ()) -> IO Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek


foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefCreate"
  cuTexRefCreate'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefDestroy"
  cuTexRefDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetAddress"
  cuTexRefSetAddress'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetAddress2D_simple"
  cuTexRefSetAddress2D_simple'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (C2HSImp.CULLong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefGetAddressMode"
  cuTexRefGetAddressMode'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefGetFilterMode"
  cuTexRefGetFilterMode'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefGetFormat"
  cuTexRefGetFormat'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetAddressMode"
  cuTexRefSetAddressMode'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetFilterMode"
  cuTexRefSetFilterMode'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetFlags"
  cuTexRefSetFlags'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Texture.chs.h cuTexRefSetFormat"
  cuTexRefSetFormat'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))