module Graphics.GL.Low.Texture (
Tex2D,
CubeMap,
Filtering(..),
Wrapping(..),
Dimensions(..),
newTexture2D,
deleteTexture,
newCubeMap,
newEmptyTexture2D,
newEmptyCubeMap,
bindTexture2D,
bindTextureCubeMap,
setActiveTextureUnit,
setTex2DFiltering,
setCubeMapFiltering,
setTex2DWrapping,
setCubeMapWrapping
) where
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Data.Vector.Storable
import Data.Word
import Control.Applicative
import Data.Traversable (sequenceA)
import Graphics.GL
import Graphics.GL.Low.Classes
import Graphics.GL.Low.Common
import Graphics.GL.Low.Cube
newtype Tex2D a = Tex2D GLuint deriving Show
newtype CubeMap a = CubeMap GLuint deriving Show
data Filtering =
Nearest |
Linear
deriving Show
instance ToGL Filtering where
toGL Nearest = GL_NEAREST
toGL Linear = GL_LINEAR
data Wrapping =
Repeat |
MirroredRepeat |
ClampToEdge
deriving Show
instance ToGL Wrapping where
toGL Repeat = GL_REPEAT
toGL MirroredRepeat = GL_MIRRORED_REPEAT
toGL ClampToEdge = GL_CLAMP_TO_EDGE
data Dimensions = Dimensions
{ imageWidth :: Int
, imageHeight :: Int }
deriving (Show)
instance Texture (Tex2D a) where
instance Texture (CubeMap a) where
instance GLObject (Tex2D a) where
glObjectName (Tex2D n) = fromIntegral n
instance GLObject (CubeMap a) where
glObjectName (CubeMap n) = fromIntegral n
newTexture2D :: InternalFormat a => Vector Word8 -> Dimensions -> IO (Tex2D a)
newTexture2D bytes (Dimensions w h) = do
n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
glBindTexture GL_TEXTURE_2D n
tex <- return (Tex2D n)
unsafeWith bytes $ \ptr -> glTexImage2D
GL_TEXTURE_2D
0
(internalFormat tex)
(fromIntegral w)
(fromIntegral h)
0
(internalFormat tex)
GL_UNSIGNED_BYTE
(castPtr ptr)
return tex
deleteTexture :: Texture a => a -> IO ()
deleteTexture x = withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr)
newCubeMap :: InternalFormat a
=> Cube (Vector Word8, Dimensions)
-> IO (CubeMap a)
newCubeMap images = do
n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
glBindTexture GL_TEXTURE_CUBE_MAP n
cm <- return (CubeMap n)
let fmt = internalFormat cm
sequenceA (liftA2 (loadCubeMapSide fmt) images cubeSideCodes)
return cm
loadCubeMapSide :: GLenum -> (Vector Word8, Dimensions) -> GLenum -> IO ()
loadCubeMapSide fmt (bytes, (Dimensions w h)) side = do
unsafeWith bytes $ \ptr -> glTexImage2D
side
0
(fromIntegral fmt)
(fromIntegral w)
(fromIntegral h)
0
fmt
GL_UNSIGNED_BYTE
(castPtr ptr)
newEmptyTexture2D :: InternalFormat a => Int -> Int -> IO (Tex2D a)
newEmptyTexture2D w h = do
let w' = fromIntegral w
let h' = fromIntegral h
n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
tex <- return (Tex2D n)
let fmt = internalFormat tex
let fmt' = internalFormat tex
glBindTexture GL_TEXTURE_2D n
glTexImage2D GL_TEXTURE_2D 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
return tex
newEmptyCubeMap :: InternalFormat a => Int -> Int -> IO (CubeMap a)
newEmptyCubeMap w h = do
let w' = fromIntegral w
let h' = fromIntegral h
n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
tex <- return (CubeMap n)
let fmt = internalFormat tex
let fmt' = internalFormat tex
glBindTexture GL_TEXTURE_CUBE_MAP n
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Y 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Y 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr
return tex
bindTexture2D :: Tex2D a -> IO ()
bindTexture2D (Tex2D n) = glBindTexture GL_TEXTURE_2D n
bindTextureCubeMap :: CubeMap a -> IO ()
bindTextureCubeMap (CubeMap n) = glBindTexture GL_TEXTURE_CUBE_MAP n
setActiveTextureUnit :: Enum a => a -> IO ()
setActiveTextureUnit n =
(glActiveTexture . fromIntegral) (GL_TEXTURE0 + fromEnum n)
setTex2DFiltering :: Filtering -> IO ()
setTex2DFiltering filt = do
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (toGL filt)
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (toGL filt)
setCubeMapFiltering :: Filtering -> IO ()
setCubeMapFiltering filt = do
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER (toGL filt)
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER (toGL filt)
setTex2DWrapping :: Wrapping -> IO ()
setTex2DWrapping wrap = do
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (toGL wrap)
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (toGL wrap)
setCubeMapWrapping :: Wrapping -> IO ()
setCubeMapWrapping wrap = do
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S (toGL wrap)
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T (toGL wrap)
glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R (toGL wrap)