{-# LINE 1 "src/Foreign/CUDA/Runtime/Texture.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Foreign.CUDA.Runtime.Texture (
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
import Foreign.CUDA.Ptr
import Foreign.CUDA.Runtime.Error
import Foreign.CUDA.Internal.C2HS
import Data.Int
import Foreign
import Foreign.C
{-# LINE 32 "src/Foreign/CUDA/Runtime/Texture.chs" #-}
type TextureReference = C2HSImp.Ptr (Texture)
{-# LINE 44 "src/Foreign/CUDA/Runtime/Texture.chs" #-}
data Texture = Texture
{
Texture -> Bool
normalised :: !Bool,
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)
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" #-}
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" #-}
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" #-}
{-# 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)
dscptr <- (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO (C2HSImp.Ptr ())}) p
poke (castPtr dscptr) dsc
{-# 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
{-# 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
{-# 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" #-}
{-# INLINE with_ #-}
with_ :: Storable a => a -> (Ptr a -> IO b) -> IO b
with_ = with
{-# 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)))