-- 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/Runtime/Texture.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Runtime.Texture
-- Copyright : [2009..2023] 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
$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)

-- |Texture channel format kind
--
data FormatKind = Signed
                | Unsigned
                | Float
                | None
                | NV12
                | UnsignedNormalized8X1
                | UnsignedNormalized8X2
                | UnsignedNormalized8X4
                | UnsignedNormalized16X1
                | UnsignedNormalized16X2
                | UnsignedNormalized16X4
                | SignedNormalized8X1
                | SignedNormalized8X2
                | SignedNormalized8X4
                | SignedNormalized16X1
                | SignedNormalized16X2
                | SignedNormalized16X4
                | UnsignedBlockCompressed1
                | UnsignedBlockCompressed1SRGB
                | UnsignedBlockCompressed2
                | UnsignedBlockCompressed2SRGB
                | UnsignedBlockCompressed3
                | UnsignedBlockCompressed3SRGB
                | UnsignedBlockCompressed4
                | SignedBlockCompressed4
                | UnsignedBlockCompressed5
                | SignedBlockCompressed5
                | UnsignedBlockCompressed6H
                | SignedBlockCompressed6H
                | UnsignedBlockCompressed7
                | UnsignedBlockCompressed7SRGB
  deriving (FormatKind -> FormatKind -> Bool
(FormatKind -> FormatKind -> Bool)
-> (FormatKind -> FormatKind -> Bool) -> Eq FormatKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatKind -> FormatKind -> Bool
== :: FormatKind -> FormatKind -> Bool
$c/= :: FormatKind -> FormatKind -> Bool
/= :: FormatKind -> FormatKind -> Bool
Eq,Show)
instance Enum FormatKind where
  succ Signed = Unsigned
  succ Unsigned = Float
  succ Float = None
  succ None = NV12
  succ NV12 = UnsignedNormalized8X1
  succ UnsignedNormalized8X1 = UnsignedNormalized8X2
  succ UnsignedNormalized8X2 = UnsignedNormalized8X4
  succ UnsignedNormalized8X4 = UnsignedNormalized16X1
  succ UnsignedNormalized16X1 = UnsignedNormalized16X2
  poke :: Ptr FormatDesc -> FormatDesc -> IO ()
succ UnsignedNormalized16X2 = UnsignedNormalized16X4
  succ UnsignedNormalized16X4 = SignedNormalized8X1
  succ SignedNormalized8X1 = SignedNormalized8X2
  succ SignedNormalized8X2 = SignedNormalized8X4
  succ SignedNormalized8X4 = SignedNormalized16X1
  succ SignedNormalized16X1 = SignedNormalized16X2
  succ SignedNormalized16X2 = SignedNormalized16X4
  succ SignedNormalized16X4 = UnsignedBlockCompressed1
  succ UnsignedBlockCompressed1 = UnsignedBlockCompressed1SRGB
  succ UnsignedBlockCompressed1SRGB = UnsignedBlockCompressed2
  succ UnsignedBlockCompressed2 = UnsignedBlockCompressed2SRGB
  succ UnsignedBlockCompressed2SRGB = UnsignedBlockCompressed3
  peek :: TextureReference -> IO Texture
succ UnsignedBlockCompressed3 = UnsignedBlockCompressed3SRGB
  succ UnsignedBlockCompressed3SRGB = UnsignedBlockCompressed4
  succ UnsignedBlockCompressed4 = SignedBlockCompressed4
  succ SignedBlockCompressed4 = UnsignedBlockCompressed5
  succ UnsignedBlockCompressed5 = SignedBlockCompressed5
  succ SignedBlockCompressed5 = UnsignedBlockCompressed6H
  succ UnsignedBlockCompressed6H = SignedBlockCompressed6H
  succ SignedBlockCompressed6H = UnsignedBlockCompressed7
  succ UnsignedBlockCompressed7 = UnsignedBlockCompressed7SRGB
  succ UnsignedBlockCompressed7SRGB = error "FormatKind.succ: UnsignedBlockCompressed7SRGB has no successor"

  pred Unsigned = Signed
  pred Float = Unsigned
  pred None = Float
  pred NV12 = None
  pred UnsignedNormalized8X1 = NV12
  pred UnsignedNormalized8X2 = UnsignedNormalized8X1
  pred UnsignedNormalized8X4 = UnsignedNormalized8X2
  pred UnsignedNormalized16X1 = UnsignedNormalized8X4
  pred UnsignedNormalized16X2 = UnsignedNormalized16X1
  pred UnsignedNormalized16X4 = UnsignedNormalized16X2
  pred SignedNormalized8X1 = UnsignedNormalized16X4
  pred SignedNormalized8X2 = SignedNormalized8X1
  pred SignedNormalized8X4 = SignedNormalized8X2
  pred SignedNormalized16X1 = SignedNormalized8X4
  pred SignedNormalized16X2 = SignedNormalized16X1
  pred SignedNormalized16X4 = SignedNormalized16X2
  pred UnsignedBlockCompressed1 = SignedNormalized16X4
  pred UnsignedBlockCompressed1SRGB = UnsignedBlockCompressed1
  pred UnsignedBlockCompressed2 = UnsignedBlockCompressed1SRGB
  pred UnsignedBlockCompressed2SRGB = UnsignedBlockCompressed2
  pred UnsignedBlockCompressed3 = UnsignedBlockCompressed2SRGB
  pred UnsignedBlockCompressed3SRGB = UnsignedBlockCompressed3
  pred UnsignedBlockCompressed4 = UnsignedBlockCompressed3SRGB
  pred SignedBlockCompressed4 = UnsignedBlockCompressed4
  pred UnsignedBlockCompressed5 = SignedBlockCompressed4
  pred SignedBlockCompressed5 = UnsignedBlockCompressed5
  pred UnsignedBlockCompressed6H = SignedBlockCompressed5
  pred SignedBlockCompressed6H = UnsignedBlockCompressed6H
  pred UnsignedBlockCompressed7 = SignedBlockCompressed6H
  pred UnsignedBlockCompressed7SRGB = UnsignedBlockCompressed7
  pred Signed = error "FormatKind.pred: Signed has no predecessor"

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

  enumFrom :: FormatKind -> [FormatKind]
enumFrom FormatKind
from = FormatKind -> FormatKind -> [FormatKind]
forall a. Enum a => a -> a -> [a]
enumFromTo FormatKind
from FormatKind
UnsignedBlockCompressed7SRGB

  fromEnum Signed = 0
  fromEnum Unsigned = 1
  fromEnum Float = 2
  fromEnum None = 3
  fromEnum NV12 = 4
  fromEnum UnsignedNormalized8X1 = 5
  fromEnum UnsignedNormalized8X2 = 6
  fromEnum UnsignedNormalized8X4 = 7
  fromEnum UnsignedNormalized16X1 = 8
  fromEnum UnsignedNormalized16X2 = 9
  fromEnum UnsignedNormalized16X4 = 10
  fromEnum SignedNormalized8X1 = 11
  fromEnum SignedNormalized8X2 = 12
  fromEnum SignedNormalized8X4 = 13
  fromEnum SignedNormalized16X1 = 14
  fromEnum SignedNormalized16X2 = 15
  fromEnum SignedNormalized16X4 = 16
  fromEnum UnsignedBlockCompressed1 = 17
  fromEnum UnsignedBlockCompressed1SRGB = 18
  fromEnum UnsignedBlockCompressed2 = 19
  fromEnum UnsignedBlockCompressed2SRGB = 20
  fromEnum UnsignedBlockCompressed3 = 21
  fromEnum UnsignedBlockCompressed3SRGB = 22
  fromEnum UnsignedBlockCompressed4 = 23
  fromEnum SignedBlockCompressed4 = 24
  fromEnum UnsignedBlockCompressed5 = 25
  fromEnum SignedBlockCompressed5 = 26
  fromEnum UnsignedBlockCompressed6H = 27
  fromEnum SignedBlockCompressed6H = 28
  fromEnum UnsignedBlockCompressed7 = 29
  fromEnum UnsignedBlockCompressed7SRGB = 30

  toEnum :: Int -> FormatKind
toEnum Int
0 = FormatKind
Signed
  toEnum Int
1 = FormatKind
Unsigned
  toEnum Int
2 = FormatKind
Float
  toEnum 3 = None
  toEnum 4 = NV12
  toEnum 5 = UnsignedNormalized8X1
  toEnum Int
6 = FormatKind
UnsignedNormalized8X2
  toEnum Int
7 = FormatKind
UnsignedNormalized8X4
  toEnum 8 = UnsignedNormalized16X1
  toEnum 9 = UnsignedNormalized16X2
  toEnum Int
10 = FormatKind
UnsignedNormalized16X4
  toEnum 11 = SignedNormalized8X1
  toEnum 12 = SignedNormalized8X2
  toEnum Int
13 = FormatKind
SignedNormalized8X4
  toEnum 14 = SignedNormalized16X1
  toEnum 15 = SignedNormalized16X2
  toEnum Int
16 = FormatKind
SignedNormalized16X4
  toEnum Int
17 = FormatKind
UnsignedBlockCompressed1
  toEnum Int
18 = FormatKind
UnsignedBlockCompressed1SRGB
  toEnum Int
19 = FormatKind
UnsignedBlockCompressed2
  toEnum Int
20 = FormatKind
UnsignedBlockCompressed2SRGB
  toEnum Int
21 = FormatKind
UnsignedBlockCompressed3
  toEnum Int
22 = FormatKind
UnsignedBlockCompressed3SRGB
  toEnum Int
23 = FormatKind
UnsignedBlockCompressed4
  toEnum Int
24 = FormatKind
SignedBlockCompressed4
  toEnum Int
25 = FormatKind
UnsignedBlockCompressed5
  toEnum Int
26 = FormatKind
SignedBlockCompressed5
  toEnum Int
27 = FormatKind
UnsignedBlockCompressed6H
  toEnum Int
28 = FormatKind
SignedBlockCompressed6H
  toEnum Int
29 = FormatKind
UnsignedBlockCompressed7
  toEnum Int
30 = FormatKind
UnsignedBlockCompressed7SRGB
  toEnum Int
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    _ = 124
{-# LINE 108 "src/Foreign/CUDA/Runtime/Texture.chs" #-}

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

  peek p = do
    norm    <- cToBool `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) p
    fmt     <- cToEnum `fmap` (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt}) p
    dsc     <- peek . castPtr          =<< (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO (C2HSImp.Ptr ())}) p
    [x,y,z] <- peekArrayWith cToEnum 3 =<< (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 8 :: IO (C2HSImp.Ptr C2HSImp.CInt)}) p
    return $ Texture norm fmt (x,y,z) dsc

  poke p (Texture norm fmt (x,y,z) dsc) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)}) p (cFromBool norm)
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)}) p (cFromEnum fmt)
    withArray (map cFromEnum [x,y,z]) ((\ptr val -> do {C2HSImp.copyArray (ptr `C2HSImp.plusPtr` 8) (val :: (C2HSImp.Ptr C2HSImp.CInt)) 3}) p)

    -- c2hs is returning the wrong type for structs-within-structs
    dscptr <- (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO (C2HSImp.Ptr ())}) p
    poke (castPtr dscptr) 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 !name !tex !dptr !bytes = do
  ref <- getTex name
  poke ref tex
  nothingIfOk =<< cudaBindTexture ref dptr (format tex) bytes

{-# INLINE cudaBindTexture #-}
cudaBindTexture :: (TextureReference) -> (DevicePtr a) -> (FormatDesc) -> (Int64) -> IO ((Status))
cudaBindTexture a2 a3 a4 a5 =
  alloca $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = dptr a3} in 
  with_ a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  cudaBindTexture'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = cToEnum res} in
  return (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 !name !tex !dptr (!width,!height) !bytes = do
  ref <- getTex name
  poke ref tex
  nothingIfOk =<< cudaBindTexture2D ref dptr (format tex) width height bytes

{-# INLINE cudaBindTexture2D #-}
cudaBindTexture2D :: (TextureReference) -> (DevicePtr a) -> (FormatDesc) -> (Int) -> (Int) -> (Int64) -> IO ((Status))
cudaBindTexture2D a2 a3 a4 a5 a6 a7 =
  alloca $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = dptr a3} in 
  with_ a4 $ \a4' -> 
  let {a5' = fromIntegral a5} in 
  let {a6' = fromIntegral a6} in 
  let {a7' = fromIntegral a7} in 
  cudaBindTexture2D'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = cToEnum res} in
  return (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 !name = resultIfOk =<< cudaGetTextureReference name

{-# INLINE cudaGetTextureReference #-}
cudaGetTextureReference :: (String) -> IO ((Status), (Ptr Texture))
cudaGetTextureReference a2 =
  alloca $ \a1' -> 
  withCString_ a2 $ \a2' -> 
  cudaGetTextureReference'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peek  a1'>>= \a1'' -> 
  return (res', a1'')

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



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

{-# INLINE with_ #-}
with_ :: Storable a => a -> (Ptr a -> IO b) -> IO b
with_ = 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_ !str !fn = withCString str (fn . 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)))