-- GENERATED by C->Haskell Compiler, version 0.28.2 Switcheroo, 1 April 2016 (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..2017] 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
  {
    normalised :: !Bool,                -- ^ access texture using normalised coordinates [0.0,1.0)
    filtering  :: !FilterMode,
    addressing :: !(AddressMode, AddressMode, AddressMode),
    format     :: !FormatDesc
  }
  deriving (Eq, Show)

-- |Texture channel format kind
--
data FormatKind = Signed
                | Unsigned
                | Float
                | None
  deriving (Eq,Show)
instance Enum FormatKind where
  succ Signed = Unsigned
  succ Unsigned = Float
  succ Float = None
  succ None = error "FormatKind.succ: None has no successor"

  pred Unsigned = Signed
  pred Float = Unsigned
  pred None = Float
  pred Signed = error "FormatKind.pred: Signed 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 None

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

  toEnum 0 = Signed
  toEnum 1 = Unsigned
  toEnum 2 = Float
  toEnum 3 = None
  toEnum unmatched = error ("FormatKind.toEnum: Cannot match " ++ show 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)))