-- GENERATED by C->Haskell Compiler, version 0.20.1 The shapeless maps, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


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

module Foreign.CUDA.Runtime.Texture (

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

) where

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

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



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


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

-- |A texture reference
--
type TextureReference = Ptr (Texture)
{-# LINE 45 "./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 60 "./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 66 "./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 72 "./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 79 "./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 89 "./Foreign/CUDA/Runtime/Texture.chs" #-}

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

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

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


instance Storable Texture where
  sizeOf    _ = 124
{-# LINE 109 "./Foreign/CUDA/Runtime/Texture.chs" #-}

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

  peek p = do
    norm    <- cToBool     `fmap` (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) p
    fmt     <- cToEnum     `fmap` (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) p
    [x,y,z] <- map cToEnum `fmap` (peekArray 3 (p `plusPtr` texRefAddressModeOffset :: Ptr CInt))
    dsc     <- peekByteOff p texRefChannelDescOffset
    return $ Texture norm fmt (x,y,z) dsc

  poke p (Texture norm fmt (x,y,z) dsc) = do
    (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) p (cFromBool norm)
    (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) p (cFromEnum fmt)
    pokeArray (p `plusPtr` texRefAddressModeOffset :: Ptr CInt) (map cFromEnum [x,y,z])
    pokeByteOff p texRefChannelDescOffset 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 147 "./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 170 "./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 183 "./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'_ :: ((Ptr CULong) -> ((TextureReference) -> ((Ptr ()) -> ((Ptr (FormatDesc)) -> (CULong -> (IO CInt))))))

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

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