module SFML.Graphics.Text
(
module SFML.Utils
, TextStyle(..)
, createText
, copy
, destroy
, setTextString
, setTextStringU
, setTextFont
, setTextCharacterSize
, setTextStyle
, setTextColor
, getTextString
, getTextUnicodeString
, getTextFont
, getTextCharacterSize
, getTextStyle
, getTextColor
, findTextCharacterPos
, getTextLocalBounds
, getTextGlobalBounds
)
where
import SFML.Graphics.Color
import SFML.Graphics.Rect
import SFML.Graphics.Transform
import SFML.Graphics.SFTransformable
import SFML.Graphics.Types
import SFML.SFCopyable
import SFML.SFException
import SFML.SFResource
import SFML.System.Vector2
import SFML.Utils
import Control.Monad
import Data.Bits ((.|.))
import Data.List (foldl')
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray0, withArray0)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable
data TextStyle
= TextRegular
| TextBold
| TextItalic
| TextUnderlined
| TextStrikeThrough
deriving (Eq, Bounded, Show)
instance Enum TextStyle where
fromEnum TextRegular = 0
fromEnum TextBold = 1
fromEnum TextItalic = 2
fromEnum TextUnderlined = 4
fromEnum TextStrikeThrough = 8
toEnum 0 = TextRegular
toEnum 1 = TextBold
toEnum 2 = TextItalic
toEnum 4 = TextUnderlined
toEnum 8 = TextStrikeThrough
checkNull :: Text -> Maybe Text
checkNull text@(Text ptr) = if ptr == nullPtr then Nothing else Just text
checkNullFont :: Font -> Maybe Font
checkNullFont font@(Font ptr) = if ptr == nullPtr then Nothing else Just font
createText :: IO (Either SFException Text)
createText =
let err = SFException "Failed creating text"
in fmap (tagErr err . checkNull) sfText_create
foreign import ccall unsafe "sfText_create"
sfText_create :: IO Text
instance SFCopyable Text where
copy = sfText_copy
foreign import ccall unsafe "sfText_copy"
sfText_copy :: Text -> IO Text
instance SFResource Text where
destroy = sfText_destroy
foreign import ccall unsafe "sfText_destroy"
sfText_destroy :: Text -> IO ()
instance SFTransformable Text where
setPosition text pos = with pos $ sfText_setPosition_helper text
setRotation t r = sfText_setRotation t (realToFrac r)
setScale text s = with s $ sfText_setScale_helper text
setOrigin text o = with o $ sfText_setOrigin_helper text
getPosition text = alloca $ \ptr -> sfText_getPosition_helper text ptr >> peek ptr
getRotation = sfText_getRotation >=> return . realToFrac
getScale text = alloca $ \ptr -> sfText_getScale_helper text ptr >> peek ptr
getOrigin text = alloca $ \ptr -> sfText_getOrigin_helper text ptr >> peek ptr
move text pos = with pos $ sfText_move_helper text
rotate t a = sfText_rotate t (realToFrac a)
scale text s = with s $ sfText_scale_helper text
getTransform text = alloca $ \ptr -> sfText_getTransform_helper text ptr >> peek ptr
getInverseTransform text = alloca $ \ptr -> sfText_getInverseTransform_helper text ptr >> peek ptr
foreign import ccall unsafe "sfText_setPosition_helper"
sfText_setPosition_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_setRotation"
sfText_setRotation :: Text -> CFloat -> IO ()
foreign import ccall unsafe "sfText_setScale_helper"
sfText_setScale_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_setOrigin_helper"
sfText_setOrigin_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_getPosition_helper"
sfText_getPosition_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_getRotation"
sfText_getRotation :: Text -> IO CFloat
foreign import ccall unsafe "sfText_getScale_helper"
sfText_getScale_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_getOrigin_helper"
sfText_getOrigin_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_move_helper"
sfText_move_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_rotate"
sfText_rotate :: Text -> CFloat -> IO ()
foreign import ccall unsafe "sfText_scale_helper"
sfText_scale_helper :: Text -> Ptr Vec2f -> IO ()
foreign import ccall unsafe "sfText_getTransform_helper"
sfText_getTransform_helper :: Text -> Ptr Transform -> IO ()
foreign import ccall unsafe "sfText_getInverseTransform_helper"
sfText_getInverseTransform_helper :: Text -> Ptr Transform -> IO ()
setTextString :: Text -> String -> IO ()
setTextString text str = withCAString str $ sfText_setString text
foreign import ccall unsafe "sfText_setString"
sfText_setString :: Text -> CString -> IO ()
setTextStringU :: Text -> String -> IO ()
setTextStringU text str = withArray0 0 str' $ sfText_setUnicodeString text
where
str' = map (fromIntegral . fromEnum) str
foreign import ccall unsafe "sfText_setUnicodeString"
sfText_setUnicodeString :: Text -> Ptr Word32 -> IO ()
setTextFont :: Text -> Font -> IO ()
setTextFont = sfText_setFont
foreign import ccall unsafe "sfText_setFont"
sfText_setFont :: Text -> Font -> IO ()
setTextCharacterSize
:: Text
-> Int
-> IO ()
setTextCharacterSize text size = sfText_setCharacterSize text (fromIntegral size)
foreign import ccall unsafe "sfText_setCharacterSize"
sfText_setCharacterSize :: Text -> CUInt -> IO ()
setTextStyle :: Text -> [TextStyle] -> IO ()
setTextStyle text styles = sfText_setStyle text $ foldl' (.|.) 0 $ fmap (fromIntegral . fromEnum) styles
foreign import ccall unsafe "sfText_setStyle"
sfText_setStyle :: Text -> CUInt -> IO ()
setTextColor :: Text -> Color -> IO ()
setTextColor text color = with color $ sfText_setColor_helper text
foreign import ccall unsafe "sfText_setColor_helper"
sfText_setColor_helper :: Text -> Ptr Color -> IO ()
getTextString :: Text -> IO String
getTextString = sfText_getString >=> peekCString
foreign import ccall unsafe "sfText_getString"
sfText_getString :: Text -> IO CString
getTextUnicodeString :: Text -> IO String
getTextUnicodeString = liftM toString . peekArray0 0 <=< sfText_getUnicodeString
where
toString = map $ toEnum . fromIntegral
foreign import ccall unsafe "sfText_getUnicodeString"
sfText_getUnicodeString :: Text -> IO (Ptr Word32)
getTextFont :: Text -> IO (Maybe Font)
getTextFont = fmap checkNullFont . sfText_getFont
foreign import ccall unsafe "sfText_getFont"
sfText_getFont :: Text -> IO Font
getTextCharacterSize :: Text -> IO Int
getTextCharacterSize = fmap fromIntegral . sfText_getCharacterSize
foreign import ccall unsafe "sfText_getCharacterSize"
sfText_getCharacterSize :: Text -> IO CUInt
getTextStyle :: Text -> IO TextStyle
getTextStyle = fmap (toEnum . fromIntegral) . sfText_getStyle
foreign import ccall unsafe "sfText_getStyle"
sfText_getStyle :: Text -> IO CUInt
getTextColor :: Text -> IO Color
getTextColor text = alloca $ \ptr -> sfText_getColor_helper text ptr >> peek ptr
foreign import ccall unsafe "sfText_getColor_helper"
sfText_getColor_helper :: Text -> Ptr Color -> IO ()
findTextCharacterPos
:: Text
-> Int
-> IO Vec2f
findTextCharacterPos text idx =
alloca $ \ptr -> sfText_findCharacterPos_helper text (fromIntegral idx) ptr >> peek ptr
foreign import ccall unsafe "sfText_findCharacterPos_helper"
sfText_findCharacterPos_helper :: Text -> CUInt -> Ptr Vec2f -> IO ()
getTextLocalBounds :: Text -> IO FloatRect
getTextLocalBounds text = alloca $ \ptr -> sfText_getLocalBounds_helper text ptr >> peek ptr
foreign import ccall unsafe "sfText_getLocalBounds_helper"
sfText_getLocalBounds_helper :: Text -> Ptr FloatRect -> IO ()
getTextGlobalBounds :: Text -> IO FloatRect
getTextGlobalBounds text = alloca $ \ptr -> sfText_getGlobalBounds_helper text ptr >> peek ptr
foreign import ccall unsafe "sfText_getGlobalBounds_helper"
sfText_getGlobalBounds_helper :: Text -> Ptr FloatRect -> IO ()