module SFML.Graphics.Shape
(
createShape
, destroy
, setPosition
, setRotation
, setScale
, setOrigin
, getPosition
, getRotation
, getScale
, getOrigin
, move
, rotate
, scale
, getTransform
, getInverseTransform
, setTexture
, setTextureRect
, getTexture
, getTextureRect
, setFillColor
, setOutlineColor
, setOutlineThickness
, getFillColor
, getOutlineColor
, getOutlineThickness
, getPointCount
, getPoint
, setPointCount
, getLocalBounds
, getGlobalBounds
, updateShape
)
where
import SFML.Graphics.SFBounded
import SFML.Graphics.Color
import SFML.Graphics.Rect
import SFML.Graphics.SFShape
import SFML.Graphics.SFShapeResizable
import SFML.Graphics.SFTexturable
import SFML.Graphics.Transform
import SFML.Graphics.SFTransformable
import SFML.Graphics.Types
import SFML.SFResource
import SFML.System.Vector2
import Control.Monad ((>=>))
import Foreign.C.Types
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Foreign.Storable (peek)
checkNullTexture :: Texture -> Maybe Texture
checkNullTexture tex@(Texture ptr) = if ptr == nullPtr then Nothing else Just tex
createShape
:: Ptr a
-> Ptr b
-> Ptr c
-> IO Shape
createShape = sfShape_create
foreign import ccall unsafe "sfShape_create"
sfShape_create :: Ptr a -> Ptr b -> Ptr c -> IO Shape
instance SFResource Shape where
destroy = sfShape_destroy
foreign import ccall unsafe "sfShape_destroy"
sfShape_destroy :: Shape -> IO ()
instance SFTransformable Shape where
setPosition c p = with p $ sfShape_setPosition_helper c
setRotation s r = sfShape_setRotation s (realToFrac r)
setScale c s = with s $ sfShape_setScale_helper c
setOrigin c o = with o $ sfShape_setOrigin_helper c
getPosition c = alloca $ \ptr -> sfShape_getPosition_helper c ptr >> peek ptr
getRotation = sfShape_getRotation >=> return . realToFrac
getScale c = alloca $ \ptr -> sfShape_getScale_helper c ptr >> peek ptr
getOrigin c = alloca $ \ptr -> sfShape_getOrigin_helper c ptr >> peek ptr
move c off = with off $ sfShape_move_helper c
rotate s a = sfShape_rotate s (realToFrac a)
scale c s = with s $ sfShape_scale_helper c
getTransform c = alloca $ \ptr -> sfShape_getTransform_helper c ptr >> peek ptr
getInverseTransform c = alloca $ \ptr -> sfShape_getInverseTransform_helper c ptr >> peek ptr
foreign import ccall unsafe "sfShape_setPosition_helper"
sfShape_setPosition_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_setRotation"
sfShape_setRotation :: Shape -> CFloat -> IO ()
foreign import ccall unsafe "sfShape_setScale_helper"
sfShape_setScale_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_setOrigin_helper"
sfShape_setOrigin_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_getPosition_helper"
sfShape_getPosition_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_getRotation"
sfShape_getRotation :: Shape -> IO CFloat
foreign import ccall unsafe "sfShape_getScale_helper"
sfShape_getScale_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_getOrigin_helper"
sfShape_getOrigin_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_move_helper"
sfShape_move_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_rotate"
sfShape_rotate :: Shape -> CFloat -> IO ()
foreign import ccall unsafe "sfShape_scale_helper"
sfShape_scale_helper :: Shape -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfShape_getTransform_helper"
sfShape_getTransform_helper :: Shape -> Ptr Transform -> IO ()
foreign import ccall unsafe "sfShape_getInverseTransform_helper"
sfShape_getInverseTransform_helper :: Shape -> Ptr Transform -> IO ()
instance SFTexturable Shape where
setTexture c tex reset = sfShape_setTexture c tex (fromIntegral . fromEnum $ reset)
setTextureRect c rect = with rect $ sfShape_setTextureRect_helper c
getTexture = sfShape_getTexture >=> return . checkNullTexture
getTextureRect c = alloca $ \ptr -> sfShape_getTextureRect_helper c ptr >> peek ptr
foreign import ccall unsafe "sfShape_setTexture"
sfShape_setTexture :: Shape -> Texture -> CInt -> IO ()
foreign import ccall unsafe "sfShape_setTextureRect_helper"
sfShape_setTextureRect_helper :: Shape -> Ptr IntRect -> IO ()
foreign import ccall unsafe "sfShape_getTexture"
sfShape_getTexture :: Shape -> IO Texture
foreign import ccall unsafe "sfShape_getTextureRect_helper"
sfShape_getTextureRect_helper :: Shape -> Ptr IntRect -> IO ()
instance SFShape Shape where
setFillColor c color = with color $ sfShape_setFillColor_helper c
setOutlineColor c color = with color $ sfShape_setOutlineColor_helper c
setOutlineThickness s t = sfShape_setOutlineThickness s (realToFrac t)
getFillColor c = alloca $ \ptr -> sfShape_getFillColor_helper c ptr >> peek ptr
getOutlineColor c = alloca $ \ptr -> sfShape_getOutlineColor_helper c ptr >> peek ptr
getOutlineThickness = sfShape_getOutlineThickness >=> return . realToFrac
getPointCount = sfShape_getPointCount >=> return . fromIntegral
getPoint c idx = alloca $ \ptr -> sfShape_getPoint_helper c (fromIntegral idx) ptr >> peek ptr
foreign import ccall unsafe "sfShape_setFillColor_helper"
sfShape_setFillColor_helper :: Shape -> Ptr Color -> IO ()
foreign import ccall unsafe "sfShape_setOutlineColor_helper"
sfShape_setOutlineColor_helper :: Shape -> Ptr Color -> IO ()
foreign import ccall unsafe "sfShape_setOutlineThickness"
sfShape_setOutlineThickness :: Shape -> CFloat -> IO ()
foreign import ccall unsafe "sfShape_getFillColor_helper"
sfShape_getFillColor_helper :: Shape -> Ptr Color -> IO ()
foreign import ccall unsafe "sfShape_getOutlineColor_helper"
sfShape_getOutlineColor_helper :: Shape -> Ptr Color -> IO ()
foreign import ccall unsafe "sfShape_getOutlineThickness"
sfShape_getOutlineThickness :: Shape -> IO CFloat
foreign import ccall "sfShape_getPointCount"
sfShape_getPointCount :: Shape -> IO CUInt
foreign import ccall "sfShape_getPoint_helper"
sfShape_getPoint_helper :: Shape -> CUInt -> Ptr Vec2f -> IO ()
instance SFBounded Shape where
getLocalBounds c = alloca $ \ptr -> sfShape_getLocalBounds_helper c ptr >> peek ptr
getGlobalBounds c = alloca $ \ptr -> sfShape_getGlobalBounds_helper c ptr >> peek ptr
foreign import ccall unsafe "sfShape_getLocalBounds_helper"
sfShape_getLocalBounds_helper :: Shape -> Ptr FloatRect -> IO ()
foreign import ccall unsafe "sfShape_getGlobalBounds_helper"
sfShape_getGlobalBounds_helper :: Shape -> Ptr FloatRect -> IO ()
updateShape :: Shape -> IO ()
updateShape = sfShape_update
foreign import ccall unsafe "sfShape_update"
sfShape_update :: Shape -> IO ()