module SFML.Graphics.Shader
(
module SFML.Utils
, nullShader
, shaderFromFile
, shaderFromMemory
, shaderFromStream
, destroy
, setFloatParameter
, setFloat2Parameter
, setFloat3Parameter
, setFloat4Parameter
, setVector2Parameter
, setVector3Parameter
, setColorParameter
, setTransformParameter
, setTextureParameter
, setCurrentTextureParameter
, bind
, isShaderAvailable
)
where
import SFML.Graphics.Color
import SFML.Graphics.Transform
import SFML.Graphics.Types
import SFML.Graphics.SFBindable
import SFML.SFException
import SFML.SFResource
import SFML.System.InputStream
import SFML.System.Vector2
import SFML.System.Vector3
import SFML.Utils
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
checkNull :: Shader -> Maybe Shader
checkNull shader@(Shader ptr) = if ptr == nullPtr then Nothing else Just shader
exf :: Show a => Maybe a -> Maybe a -> SFException
exf vs fs = SFException $ "Failed loading shader program from files " ++ show vs ++ ", " ++ show fs
exs :: Show a => Maybe a -> Maybe a -> SFException
exs vs fs = SFException $ "Failed loading shader program from sources " ++ show vs ++ ", " ++ show fs
exi :: Show a => Maybe a -> Maybe a -> SFException
exi vs fs = SFException $ "Failed loading shader program from input streams " ++ show vs ++ ", " ++ show fs
nullstr = Nothing :: Maybe String
nullis = Nothing :: Maybe InputStream
nullShader = Shader nullPtr
shaderFromFile
:: Maybe FilePath
-> Maybe FilePath
-> IO (Either SFException Shader)
shaderFromFile Nothing Nothing = fmap (tagErr (exf nullstr nullstr) . checkNull) $ sfShader_createFromFile nullPtr nullPtr
shaderFromFile Nothing fs@(Just frag) =
fmap (tagErr (exf Nothing fs) . checkNull) . withCString frag $ sfShader_createFromFile nullPtr
shaderFromFile vs@(Just vert) Nothing =
fmap (tagErr (exf vs Nothing) . checkNull) . withCString vert $ flip sfShader_createFromFile nullPtr
shaderFromFile vs@(Just vert) fs@(Just frag) =
fmap (tagErr (exf vs fs) . checkNull) $ withCString vert $ \cvert -> withCString frag $ sfShader_createFromFile cvert
foreign import ccall unsafe "sfShader_createFromFile"
sfShader_createFromFile :: CString -> CString -> IO Shader
shaderFromMemory
:: Maybe String
-> Maybe String
-> IO (Either SFException Shader)
shaderFromMemory Nothing Nothing
= fmap (tagErr (exs nullstr nullstr) . checkNull) $ sfShader_createFromMemory nullPtr nullPtr
shaderFromMemory Nothing fs@(Just frag) =
fmap (tagErr (exs Nothing fs) . checkNull) . withCString frag $ sfShader_createFromMemory nullPtr
shaderFromMemory vs@(Just vert) Nothing =
fmap (tagErr (exs vs Nothing) . checkNull) . withCString vert $ flip sfShader_createFromMemory nullPtr
shaderFromMemory vs@(Just vert) fs@(Just frag)
= fmap (tagErr (exs vs fs) . checkNull) $ withCString vert $ \cvert -> withCString frag $ sfShader_createFromMemory cvert
foreign import ccall unsafe "sfShader_createFromMemory"
sfShader_createFromMemory :: CString -> CString -> IO Shader
shaderFromStream
:: Maybe InputStream
-> Maybe InputStream
-> IO (Either SFException Shader)
shaderFromStream Nothing Nothing
= fmap (tagErr (exi nullis nullis) . checkNull) $ sfShader_createFromStream nullPtr nullPtr
shaderFromStream Nothing fs@(Just frag)
= fmap (tagErr (exi Nothing fs) . checkNull) . with frag $ sfShader_createFromStream nullPtr
shaderFromStream vs@(Just vert) Nothing
= fmap (tagErr (exi vs Nothing) . checkNull) . with vert $ flip sfShader_createFromStream nullPtr
shaderFromStream vs@(Just vert) fs@(Just frag)
= fmap (tagErr (exi vs fs) . checkNull) $ with vert $ \cvert -> with frag $ sfShader_createFromStream cvert
foreign import ccall unsafe "sfShader_createFromStream"
sfShader_createFromStream :: Ptr InputStream -> Ptr InputStream -> IO Shader
instance SFResource Shader where
destroy = sfShader_destroy
foreign import ccall unsafe "sfShader_destroy"
sfShader_destroy :: Shader -> IO ()
setFloatParameter
:: Shader
-> String
-> Float
-> IO ()
setFloatParameter shader name val =
withCString name $ \cname ->
sfShader_setFloatParameter shader cname $ realToFrac val
foreign import ccall unsafe "sfShader_setFloatParameter"
sfShader_setFloatParameter :: Shader -> CString -> CFloat -> IO ()
setFloat2Parameter
:: Shader
-> String
-> Float
-> Float
-> IO ()
setFloat2Parameter shader name f1 f2 =
withCString name $ \cname ->
sfShader_setFloat2Parameter shader cname (realToFrac f1) (realToFrac f2)
foreign import ccall unsafe "sfShader_setFloat2Parameter"
sfShader_setFloat2Parameter :: Shader -> CString -> CFloat -> CFloat -> IO ()
setFloat3Parameter
:: Shader
-> String
-> Float
-> Float
-> Float
-> IO ()
setFloat3Parameter shader name f1 f2 f3 =
withCString name $ \cname ->
sfShader_setFloat3Parameter shader cname (realToFrac f1) (realToFrac f2) (realToFrac f3)
foreign import ccall unsafe "sfShader_setFloat3Parameter"
sfShader_setFloat3Parameter :: Shader -> CString -> CFloat -> CFloat -> CFloat -> IO ()
setFloat4Parameter
:: Shader
-> String
-> Float
-> Float
-> Float
-> Float
-> IO ()
setFloat4Parameter shader name f1 f2 f3 f4 =
withCString name $ \cname ->
sfShader_setFloat4Parameter shader cname (realToFrac f1) (realToFrac f2) (realToFrac f3) (realToFrac f4)
foreign import ccall unsafe "sfShader_setFloat4Parameter"
sfShader_setFloat4Parameter :: Shader -> CString -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
setVector2Parameter
:: Shader
-> String
-> Vec2f
-> IO ()
setVector2Parameter shader name vec =
withCString name $ \cname ->
with vec $ sfShader_setVector2Parameter_helper shader cname
foreign import ccall unsafe "sfShader_setVector2Parameter_helper"
sfShader_setVector2Parameter_helper :: Shader -> CString -> Ptr Vec2f -> IO ()
setVector3Parameter
:: Shader
-> String
-> Vec3f
-> IO ()
setVector3Parameter shader name vec =
withCString name $ \cname ->
with vec $ sfShader_setVector3Parameter_helper shader cname
foreign import ccall unsafe "sfShader_setVector3Parameter_helper"
sfShader_setVector3Parameter_helper :: Shader -> CString -> Ptr Vec3f -> IO ()
setColorParameter
:: Shader
-> String
-> Color
-> IO ()
setColorParameter shader name color =
withCString name $ \cname ->
with color $ sfShader_setColorParameter_helper shader cname
foreign import ccall unsafe "sfShader_setColorParameter_helper"
sfShader_setColorParameter_helper :: Shader -> CString -> Ptr Color -> IO ()
setTransformParameter
:: Shader
-> String
-> Transform
-> IO ()
setTransformParameter shader name transf =
withCString name $ \cname ->
with transf $ sfShader_setTransformParameter_helper shader cname
foreign import ccall unsafe "sfShader_setTransformParameter_helper"
sfShader_setTransformParameter_helper :: Shader -> CString -> Ptr Transform -> IO ()
setTextureParameter
:: Shader
-> String
-> Texture
-> IO ()
setTextureParameter shader name tex =
withCString name $ \cname -> sfShader_setTextureParameter shader cname tex
foreign import ccall unsafe "sfShader_setTextureParameter"
sfShader_setTextureParameter :: Shader -> CString -> Texture -> IO ()
setCurrentTextureParameter
:: Shader
-> String
-> IO ()
setCurrentTextureParameter shader name = withCString name $ sfShader_setCurrentTextureParameter shader
foreign import ccall unsafe "sfShader_setCurrentTextureParameter"
sfShader_setCurrentTextureParameter :: Shader -> CString -> IO ()
instance SFBindable Shader where
bind = sfShader_bind
foreign import ccall unsafe "sfShader_bind"
sfShader_bind :: Shader -> IO ()
isShaderAvailable :: IO Bool
isShaderAvailable = fmap (toEnum . fromIntegral) sfShader_isAvailable
foreign import ccall unsafe "sfShader_isAvailable"
sfShader_isAvailable :: IO CInt