module SFML.Graphics.Texture
(
module SFML.Utils
, TextureException(..)
, nullTexture
, createTexture
, textureFromFile
, textureFromMemory
, textureFromStream
, textureFromImage
, copy
, destroy
, textureSize
, copyTextureToImage
, updateTextureFromPixels
, updateTextureFromImage
, updateTextureFromWindow
, updateTextureFromRenderWindow
, bind
, setSmooth
, isSmooth
, setRepeated
, isRepeated
, textureMaxSize
)
where
import SFML.Graphics.Rect
import SFML.Graphics.SFBindable
import SFML.Graphics.SFSmoothTexture
import SFML.Graphics.Types
import SFML.Window.Types
import SFML.SFCopyable
import SFML.SFResource
import SFML.System.InputStream
import SFML.System.Vector2
import SFML.Utils
import Control.Exception
import Data.Typeable
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable (peek)
import System.IO.Unsafe
checkNull :: Texture -> Maybe Texture
checkNull tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex
data TextureException = TextureException String deriving (Show, Typeable)
instance Exception TextureException
nullTexture = Texture nullPtr
createTexture
:: Int
-> Int
-> IO (Either TextureException Texture)
createTexture w h =
let err = TextureException "Failed creating texture"
in fmap (tagErr err . checkNull) $ sfTexture_create (fromIntegral w) (fromIntegral h)
foreign import ccall unsafe "sfTexture_create"
sfTexture_create :: CUInt -> CUInt -> IO Texture
textureFromFile
:: FilePath
-> Maybe IntRect
-> IO (Either TextureException Texture)
textureFromFile path rect =
let err = TextureException $ "Failed loading texture from file " ++ show path
in withCAString path $ \cpath ->
fmap (tagErr err . checkNull) $
case rect of
Nothing -> sfTexture_createFromFile cpath nullPtr
Just r -> with r $ sfTexture_createFromFile cpath
foreign import ccall unsafe "sfTexture_createFromFile"
sfTexture_createFromFile :: CString -> Ptr IntRect -> IO Texture
textureFromMemory
:: Ptr a
-> Int
-> Maybe IntRect
-> IO (Either TextureException Texture)
textureFromMemory pixels size rect =
let err = TextureException $ "Failed creating texture from memory address " ++ show pixels
in fmap (tagErr err . checkNull) $ case rect of
Nothing -> sfTexture_createFromMemory pixels (fromIntegral size) nullPtr
Just r -> with r $ sfTexture_createFromMemory pixels (fromIntegral size)
foreign import ccall unsafe "sfTexture_createFromMemory"
sfTexture_createFromMemory :: Ptr a -> CUInt -> Ptr IntRect -> IO Texture
textureFromStream
:: InputStream
-> Maybe IntRect
-> IO (Either TextureException Texture)
textureFromStream stream rect =
let err = TextureException $ "Failed creating texture from input stream " ++ show stream
in fmap (tagErr err . checkNull) $
with stream $ \streamPtr ->
case rect of
Nothing -> sfTexture_createFromStream streamPtr nullPtr
Just r -> with r $ sfTexture_createFromStream streamPtr
foreign import ccall "sfTexture_createFromStream"
sfTexture_createFromStream :: Ptr InputStream -> Ptr IntRect -> IO Texture
textureFromImage
:: Image
-> Maybe IntRect
-> IO (Either TextureException Texture)
textureFromImage image rect =
let (Image addr) = image
err = TextureException $ "Failed creating texture from image " ++ show addr
in fmap (tagErr err . checkNull) $ case rect of
Nothing -> sfTexture_createFromImage image nullPtr
Just r -> with r $ sfTexture_createFromImage image
foreign import ccall unsafe "sfTexture_createFromImage"
sfTexture_createFromImage :: Image -> Ptr IntRect -> IO Texture
instance SFCopyable Texture where
copy = sfTexture_copy
foreign import ccall unsafe "sfTexture_copy"
sfTexture_copy :: Texture -> IO Texture
instance SFResource Texture where
destroy = sfTexture_destroy
foreign import ccall unsafe "sfTexture_destroy"
sfTexture_destroy :: Texture -> IO ()
textureSize :: Texture -> IO Vec2u
textureSize tex = alloca $ \ptr -> sfTexture_getSize_helper tex ptr >> peek ptr
foreign import ccall unsafe "sfTexture_getSize_helper"
sfTexture_getSize_helper :: Texture -> Ptr Vec2u -> IO ()
copyTextureToImage :: Texture -> IO Image
copyTextureToImage = sfTexture_copyToImage
foreign import ccall unsafe "sfTexture_copyToImage"
sfTexture_copyToImage :: Texture -> IO Image
updateTextureFromPixels
:: Texture
-> Ptr a
-> Int
-> Int
-> Int
-> Int
-> IO ()
updateTextureFromPixels tex pixels w h x y =
sfTexture_updateFromPixels tex pixels (fromIntegral w) (fromIntegral h) (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "sfTexture_updateFromPixels"
sfTexture_updateFromPixels :: Texture -> Ptr a -> CUInt -> CUInt -> CUInt -> CUInt -> IO ()
updateTextureFromImage
:: Texture
-> Image
-> Int
-> Int
-> IO ()
updateTextureFromImage tex image x y
= sfTexture_updateFromImage tex image (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "sfTexture_updateFromImage"
sfTexture_updateFromImage :: Texture -> Image -> CUInt -> CUInt -> IO ()
updateTextureFromWindow
:: Texture
-> Window
-> Int
-> Int
-> IO ()
updateTextureFromWindow tex wnd x y
= sfTexture_updateFromWindow tex wnd (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "sfTexture_updateFromWindow"
sfTexture_updateFromWindow :: Texture -> Window -> CUInt -> CUInt -> IO ()
updateTextureFromRenderWindow
:: Texture
-> RenderWindow
-> Int
-> Int
-> IO ()
updateTextureFromRenderWindow tex rwnd x y
= sfTexture_updateFromRenderWindow tex rwnd (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "sfTexture_updateFromRenderWindow"
sfTexture_updateFromRenderWindow :: Texture -> RenderWindow -> CUInt -> CUInt -> IO ()
instance SFBindable Texture where
bind = sfTexture_bind
foreign import ccall unsafe "sfTexture_bind"
sfTexture_bind :: Texture -> IO ()
instance SFSmoothTexture Texture where
setSmooth tex val = sfTexture_setSmooth tex (fromIntegral . fromEnum $ val)
isSmooth = fmap (/=0) . sfTexture_isSmooth
foreign import ccall unsafe "sfTexture_setSmooth"
sfTexture_setSmooth :: Texture -> CInt -> IO ()
foreign import ccall unsafe "sfTexture_isSmooth"
sfTexture_isSmooth :: Texture -> IO CInt
setRepeated :: Texture -> Bool -> IO ()
setRepeated tex True = sfTexture_setRepeated tex 1
setRepeated tex False = sfTexture_setRepeated tex 0
foreign import ccall unsafe "sfTexture_setRepeated"
sfTexture_setRepeated :: Texture -> CInt -> IO ()
isRepeated :: Texture -> IO Bool
isRepeated = fmap (/=0) . sfTexture_isRepeated
foreign import ccall unsafe "sfTexture_isRepeated"
sfTexture_isRepeated :: Texture -> IO CInt
textureMaxSize :: Int
textureMaxSize = unsafeDupablePerformIO $ fmap fromIntegral sfTexture_getMaximumSize
foreign import ccall unsafe "sfTexture_getMaximumSize"
sfTexture_getMaximumSize :: IO CUInt