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


{-# LINE 1 "src/Foreign/CUDA/Runtime/Texture.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Runtime.Texture
-- Copyright : [2009..2018] Trevor L. McDonell
-- License   : BSD
--
-- Texture references
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Runtime.Texture (

  -- * Texture Reference Management
  Texture(..), FormatKind(..), AddressMode(..), FilterMode(..), FormatDesc(..),
  bind, bind2D

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Array as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



-- Friends
import Foreign.CUDA.Ptr
import Foreign.CUDA.Runtime.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Data.Int
import Foreign
import Foreign.C



{-# LINE 32 "src/Foreign/CUDA/Runtime/Texture.chs" #-}


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

-- |A texture reference
--
type TextureReference = C2HSImp.Ptr (Texture)
{-# LINE 44 "src/Foreign/CUDA/Runtime/Texture.chs" #-}


data Texture = Texture
  {
    Texture -> Bool
normalised :: !Bool,                -- ^ access texture using normalised coordinates [0.0,1.0)
    Texture -> FilterMode
filtering  :: !FilterMode,
    Texture -> (AddressMode, AddressMode, AddressMode)
addressing :: !(AddressMode, AddressMode, AddressMode),
    Texture -> FormatDesc
format     :: !FormatDesc
  }
  deriving (Texture -> Texture -> Bool
(Texture -> Texture -> Bool)
-> (Texture -> Texture -> Bool) -> Eq Texture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c== :: 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
showList :: [Texture] -> ShowS
$cshowList :: [Texture] -> ShowS
show :: Texture -> String
$cshow :: Texture -> String
showsPrec :: Int -> Texture -> ShowS
$cshowsPrec :: Int -> Texture -> ShowS
Show)

-- |Texture channel format kind
--
data FormatKind = Signed
                | Unsigned
                | Float
                | None
  deriving (FormatKind -> FormatKind -> Bool
(FormatKind -> FormatKind -> Bool)
-> (FormatKind -> FormatKind -> Bool) -> Eq FormatKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatKind -> FormatKind -> Bool
$c/= :: FormatKind -> FormatKind -> Bool
== :: FormatKind -> FormatKind -> Bool
$c== :: FormatKind -> FormatKind -> Bool
Eq,Int -> FormatKind -> ShowS
[FormatKind] -> ShowS
FormatKind -> String
(Int -> FormatKind -> ShowS)
-> (FormatKind -> String)
-> ([FormatKind] -> ShowS)
-> Show FormatKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatKind] -> ShowS
$cshowList :: [FormatKind] -> ShowS
show :: FormatKind -> String
$cshow :: FormatKind -> String
showsPrec :: Int -> FormatKind -> ShowS
$cshowsPrec :: Int -> FormatKind -> ShowS
Show)
instance Enum FormatKind where
  succ Signed = Unsigned
  succ Unsigned = Float
  succ Float = None
  succ None = error "FormatKind.succ: None has no successor"

  pred :: FormatKind -> FormatKind
pred FormatKind
Unsigned = FormatKind
Signed
  pred Float = Unsigned
  pred None = Float
  pred FormatKind
Signed = String -> FormatKind
forall a. HasCallStack => String -> a
error String
"FormatKind.pred: Signed has no predecessor"

  enumFromTo :: FormatKind -> FormatKind -> [FormatKind]
enumFromTo FormatKind
from FormatKind
to = go from
    where
      end :: Int
end = FormatKind -> Int
forall a. Enum a => a -> Int
fromEnum FormatKind
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 None

  fromEnum Signed = 0
  fromEnum Unsigned = 1
  fromEnum Float = 2
  fromEnum None = 3

  toEnum :: Int -> FormatKind
sizeOf :: FormatDesc -> Int
toEnum Int
0 = FormatKind
Signed
  toEnum Int
1 = FormatKind
Unsigned
  toEnum Int
2 = FormatKind
Float
  toEnum Int
3 = FormatKind
None
  toEnum unmatched = String -> FormatKind
forall a. HasCallStack => String -> a
error (String
"FormatKind.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 59 "src/Foreign/CUDA/Runtime/Texture.chs" #-}


-- |Texture addressing mode
--
data AddressMode = Wrap
                 | Clamp
                 | Mirror
                 | Border
  deriving (Eq,Show)
instance Enum AddressMode where
  succ Wrap = Clamp
  succ Clamp = Mirror
  succ Mirror = Border
  succ Border = error "AddressMode.succ: Border has no successor"

  pred Clamp = Wrap
  pred Mirror = Clamp
  pred Border = Mirror
  pred Wrap = error "AddressMode.pred: Wrap 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 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 65 "src/Foreign/CUDA/Runtime/Texture.chs" #-}


-- |Texture 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 71 "src/Foreign/CUDA/Runtime/Texture.chs" #-}



-- |A description of how memory read through the texture cache should be
-- interpreted, including the kind of data and the number of bits of each
-- component (x,y,z and w, respectively).
--

{-# LINE 78 "src/Foreign/CUDA/Runtime/Texture.chs" #-}


data FormatDesc = FormatDesc
  {
    depth :: !(Int,Int,Int,Int),
    kind  :: !FormatKind
  }
  deriving (Eq, Show)

instance Storable FormatDesc where
  sizeOf    _ = 20
{-# LINE 88 "src/Foreign/CUDA/Runtime/Texture.chs" #-}

  alignment _ = alignment (undefined :: Ptr ())

  peek p = do
    dx <- cIntConv `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) p
    dy <- cIntConv `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt}) p
    dz <- cIntConv `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CInt}) p
    dw <- cIntConv `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 12 :: IO C2HSImp.CInt}) p
    df <- cToEnum  `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CInt}) p
    return $ FormatDesc (dx,dy,dz,dw) df

  poke p (FormatDesc (x,y,z,w) k) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)}) p (cIntConv x)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)}) p (cIntConv y)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)}) p (cIntConv z)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CInt)}) p (cIntConv w)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CInt)}) p (cFromEnum k)


instance Storable Texture where
  sizeOf :: Texture -> Int
sizeOf    Texture
_ = Int
124
{-# LINE 108 "src/Foreign/CUDA/Runtime/Texture.chs" #-}

  alignment _ = alignment (undefined :: Ptr ())

  peek :: Ptr Texture -> IO Texture
peek Ptr Texture
p = do
    Bool
norm    <- CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
cToBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr Texture
ptr -> do {Ptr Texture -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Texture
ptr Int
0 :: IO C2HSImp.CInt}) Ptr Texture
p
    FilterMode
fmt     <- CInt -> FilterMode
forall i e. (Integral i, Enum e) => i -> e
cToEnum (CInt -> FilterMode) -> IO CInt -> IO FilterMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (\Ptr Texture
ptr -> do {Ptr Texture -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Texture
ptr Int
4 :: IO C2HSImp.CInt}) Ptr Texture
p
    FormatDesc
dsc     <- Ptr FormatDesc -> IO FormatDesc
forall a. Storable a => Ptr a -> IO a
peek (Ptr FormatDesc -> IO FormatDesc)
-> (Ptr () -> Ptr FormatDesc) -> Ptr () -> IO FormatDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> Ptr FormatDesc
forall a b. Ptr a -> Ptr b
castPtr          (Ptr () -> IO FormatDesc) -> IO (Ptr ()) -> IO FormatDesc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\Ptr Texture
ptr -> do {Ptr Texture -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Texture
ptr Int
20 :: IO (C2HSImp.Ptr ())}) Ptr Texture
p
    [AddressMode
x,AddressMode
y,AddressMode
z] <- (CInt -> AddressMode) -> Int -> Ptr CInt -> IO [AddressMode]
forall a b. Storable a => (a -> b) -> Int -> Ptr a -> IO [b]
peekArrayWith CInt -> AddressMode
forall i e. (Integral i, Enum e) => i -> e
cToEnum Int
3 (Ptr CInt -> IO [AddressMode]) -> IO (Ptr CInt) -> IO [AddressMode]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\Ptr Texture
ptr -> do {Ptr CInt -> IO (Ptr CInt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CInt -> IO (Ptr CInt)) -> Ptr CInt -> IO (Ptr CInt)
forall a b. (a -> b) -> a -> b
$ Ptr Texture
ptr Ptr Texture -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`C2HSImp.plusPtr` Int
8 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) Ptr Texture
p
    Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return (Texture -> IO Texture) -> Texture -> IO Texture
forall a b. (a -> b) -> a -> b
$ Bool
-> FilterMode
-> (AddressMode, AddressMode, AddressMode)
-> FormatDesc
-> Texture
Texture Bool
norm FilterMode
fmt (AddressMode
x,AddressMode
y,AddressMode
z) FormatDesc
dsc

  poke :: Ptr Texture -> Texture -> IO ()
poke Ptr Texture
p (Texture Bool
norm FilterMode
fmt (AddressMode
x,AddressMode
y,AddressMode
z) FormatDesc
dsc) = do
    (\Ptr Texture
ptr CInt
val -> do {Ptr Texture -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Texture
ptr Int
0 (CInt
val :: C2HSImp.CInt)}) Ptr Texture
p (Bool -> CInt
forall a. Num a => Bool -> a
cFromBool Bool
norm)
    (\Ptr Texture
ptr CInt
val -> do {Ptr Texture -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Texture
ptr Int
4 (CInt
val :: C2HSImp.CInt)}) Ptr Texture
p (FilterMode -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum FilterMode
fmt)
    [CInt] -> (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((AddressMode -> CInt) -> [AddressMode] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map AddressMode -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum [AddressMode
x,AddressMode
y,AddressMode
z]) ((\Ptr Texture
ptr Ptr CInt
val -> do {Ptr CInt -> Ptr CInt -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
C2HSImp.copyArray (Ptr Texture
ptr Ptr Texture -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`C2HSImp.plusPtr` Int
8) (Ptr CInt
val :: (C2HSImp.Ptr C2HSImp.CInt)) Int
3}) Ptr Texture
p)

    -- c2hs is returning the wrong type for structs-within-structs
    Ptr ()
dscptr <- (\Ptr Texture
ptr -> do {Ptr Texture -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Texture
ptr Int
20 :: IO (C2HSImp.Ptr ())}) Ptr Texture
p
    Ptr FormatDesc -> FormatDesc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr () -> Ptr FormatDesc
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
dscptr) FormatDesc
dsc


--------------------------------------------------------------------------------
-- Texture References
--------------------------------------------------------------------------------

-- |Bind the memory area associated with the device pointer to a texture
-- reference given by the named symbol. Any previously bound references are
-- unbound.
--
{-# INLINEABLE bind #-}
bind :: String -> Texture -> DevicePtr a -> Int64 -> IO ()
bind :: String -> Texture -> DevicePtr a -> Int64 -> IO ()
bind !String
name !Texture
tex !DevicePtr a
dptr !Int64
bytes = do
  Ptr Texture
ref <- String -> IO (Ptr Texture)
getTex String
name
  Ptr Texture -> Texture -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Texture
ref Texture
tex
  Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Texture -> DevicePtr a -> FormatDesc -> Int64 -> IO Status
forall a.
Ptr Texture -> DevicePtr a -> FormatDesc -> Int64 -> IO Status
cudaBindTexture Ptr Texture
ref DevicePtr a
dptr (Texture -> FormatDesc
format Texture
tex) Int64
bytes

{-# INLINE cudaBindTexture #-}
cudaBindTexture :: (TextureReference) -> (DevicePtr a) -> (FormatDesc) -> (Int64) -> IO ((Status))
cudaBindTexture :: Ptr Texture -> DevicePtr a -> FormatDesc -> Int64 -> IO Status
cudaBindTexture Ptr Texture
a2 DevicePtr a
a3 FormatDesc
a4 Int64
a5 =
  (Ptr CULong -> IO Status) -> IO Status
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO Status) -> IO Status)
-> (Ptr CULong -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a1' -> 
  let {a2' :: Ptr Texture
a2' = Ptr Texture -> Ptr Texture
forall a. a -> a
id Ptr Texture
a2} in 
  let {a3' :: Ptr a
a3' = DevicePtr a -> Ptr a
forall a a. DevicePtr a -> Ptr a
dptr DevicePtr a
a3} in 
  FormatDesc -> (Ptr FormatDesc -> IO Status) -> IO Status
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with_ FormatDesc
a4 ((Ptr FormatDesc -> IO Status) -> IO Status)
-> (Ptr FormatDesc -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDesc
a4' -> 
  let {a5' :: CULong
a5' = Int64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a5} in 
  Ptr CULong
-> Ptr Texture -> Ptr () -> Ptr FormatDesc -> CULong -> IO CInt
cudaBindTexture'_ Ptr CULong
a1' Ptr Texture
a2' Ptr ()
forall a. Ptr a
a3' Ptr FormatDesc
a4' CULong
a5' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 149 "src/Foreign/CUDA/Runtime/Texture.chs" #-}

  where dptr = useDevicePtr . castDevPtr

-- |Bind the two-dimensional memory area to the texture reference associated
-- with the given symbol. The size of the area is constrained by (width,height)
-- in texel units, and the row pitch in bytes. Any previously bound references
-- are unbound.
--
{-# INLINEABLE bind2D #-}
bind2D :: String -> Texture -> DevicePtr a -> (Int,Int) -> Int64 -> IO ()
bind2D :: String -> Texture -> DevicePtr a -> (Int, Int) -> Int64 -> IO ()
bind2D !String
name !Texture
tex !DevicePtr a
dptr (!Int
width,!Int
height) !Int64
bytes = do
  Ptr Texture
ref <- String -> IO (Ptr Texture)
getTex String
name
  Ptr Texture -> Texture -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Texture
ref Texture
tex
  Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Texture
-> DevicePtr a -> FormatDesc -> Int -> Int -> Int64 -> IO Status
forall a.
Ptr Texture
-> DevicePtr a -> FormatDesc -> Int -> Int -> Int64 -> IO Status
cudaBindTexture2D Ptr Texture
ref DevicePtr a
dptr (Texture -> FormatDesc
format Texture
tex) Int
width Int
height Int64
bytes

{-# INLINE cudaBindTexture2D #-}
cudaBindTexture2D :: (TextureReference) -> (DevicePtr a) -> (FormatDesc) -> (Int) -> (Int) -> (Int64) -> IO ((Status))
cudaBindTexture2D :: Ptr Texture
-> DevicePtr a -> FormatDesc -> Int -> Int -> Int64 -> IO Status
cudaBindTexture2D Ptr Texture
a2 DevicePtr a
a3 FormatDesc
a4 Int
a5 Int
a6 Int64
a7 =
  (Ptr CULong -> IO Status) -> IO Status
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO Status) -> IO Status)
-> (Ptr CULong -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a1' -> 
  let {a2' :: Ptr Texture
a2' = Ptr Texture -> Ptr Texture
forall a. a -> a
id Ptr Texture
a2} in 
  let {a3' :: Ptr a
a3' = DevicePtr a -> Ptr a
forall a a. DevicePtr a -> Ptr a
dptr DevicePtr a
a3} in 
  FormatDesc -> (Ptr FormatDesc -> IO Status) -> IO Status
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with_ FormatDesc
a4 ((Ptr FormatDesc -> IO Status) -> IO Status)
-> (Ptr FormatDesc -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDesc
a4' -> 
  let {a5' :: CULong
a5' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a5} in 
  let {a6' :: CULong
a6' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a6} in 
  let {a7' :: CULong
a7' = Int64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral a7} in 
  Ptr CULong
-> Ptr Texture
-> Ptr ()
-> Ptr FormatDesc
-> CULong
-> CULong
-> CULong
-> IO CInt
cudaBindTexture2D'_ Ptr CULong
a1' Ptr Texture
a2' Ptr ()
forall a. Ptr a
a3' Ptr FormatDesc
a4' CULong
a5' CULong
a6' CULong
a7' IO CInt -> (CInt -> IO Status) -> IO Status
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 (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 172 "src/Foreign/CUDA/Runtime/Texture.chs" #-}

  where dptr = useDevicePtr . castDevPtr


-- |Returns the texture reference associated with the given symbol
--
{-# INLINEABLE getTex #-}
getTex :: String -> IO TextureReference
getTex :: String -> IO (Ptr Texture)
getTex !String
name = (Status, Ptr Texture) -> IO (Ptr Texture)
forall a. (Status, a) -> IO a
resultIfOk ((Status, Ptr Texture) -> IO (Ptr Texture))
-> IO (Status, Ptr Texture) -> IO (Ptr Texture)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Status, Ptr Texture)
cudaGetTextureReference String
name

{-# INLINE cudaGetTextureReference #-}
cudaGetTextureReference :: (String) -> IO ((Status), (Ptr Texture))
cudaGetTextureReference :: String -> IO (Status, Ptr Texture)
cudaGetTextureReference String
a2 =
  (Ptr (Ptr Texture) -> IO (Status, Ptr Texture))
-> IO (Status, Ptr Texture)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Texture) -> IO (Status, Ptr Texture))
 -> IO (Status, Ptr Texture))
-> (Ptr (Ptr Texture) -> IO (Status, Ptr Texture))
-> IO (Status, Ptr Texture)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Texture)
a1' -> 
  String
-> (Ptr () -> IO (Status, Ptr Texture)) -> IO (Status, Ptr Texture)
forall a b. String -> (Ptr a -> IO b) -> IO b
withCString_ String
a2 ((Ptr () -> IO (Status, Ptr Texture)) -> IO (Status, Ptr Texture))
-> (Ptr () -> IO (Status, Ptr Texture)) -> IO (Status, Ptr Texture)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a2' -> 
  Ptr (Ptr Texture) -> Ptr () -> IO CInt
cudaGetTextureReference'_ Ptr (Ptr Texture)
a1' Ptr ()
a2' IO CInt
-> (CInt -> IO (Status, Ptr Texture)) -> IO (Status, Ptr Texture)
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
  Ptr (Ptr Texture) -> IO (Ptr Texture)
forall a. Storable a => Ptr a -> IO a
peek  Ptr (Ptr Texture)
a1'IO (Ptr Texture)
-> (Ptr Texture -> IO (Status, Ptr Texture))
-> IO (Status, Ptr Texture)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr Texture
a1'' -> 
  (Status, Ptr Texture) -> IO (Status, Ptr Texture)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Ptr Texture
a1'')

{-# LINE 185 "src/Foreign/CUDA/Runtime/Texture.chs" #-}



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

{-# INLINE with_ #-}
with_ :: Storable a => a -> (Ptr a -> IO b) -> IO b
with_ :: a -> (Ptr a -> IO b) -> IO b
with_ = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with


-- CUDA 5.0 changed the types of some attributes from char* to void*
--
{-# INLINE withCString_ #-}
withCString_ :: String -> (Ptr a -> IO b) -> IO b
withCString_ :: String -> (Ptr a -> IO b) -> IO b
withCString_ !String
str !Ptr a -> IO b
fn = String -> (CString -> IO b) -> IO b
forall a. String -> (CString -> IO a) -> IO a
withCString String
str (Ptr a -> IO b
fn (Ptr a -> IO b) -> (CString -> Ptr a) -> CString -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)


foreign import ccall unsafe "Foreign/CUDA/Runtime/Texture.chs.h cudaBindTexture"
  cudaBindTexture'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> ((TextureReference) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (FormatDesc)) -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Texture.chs.h cudaBindTexture2D"
  cudaBindTexture2D'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> ((TextureReference) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (FormatDesc)) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))))))

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