module Graphics.UI.SDL.TTF.Attributes
( getFontStyle
, setFontStyle
, fontHeight
, fontAscent
, fontDescent
, fontLineSkip
, fontFaces
, fontFaceIsFixedWidth
, fontFaceFamilyName
, fontFaceStyleName
, tryTextSize
, textSize
, tryUTF8Size
, utf8Size
, FontStyle(..)
) where
import Foreign
import Foreign.C
import Prelude hiding (Enum(..))
import Graphics.UI.SDL.TTF.Types
import Graphics.UI.SDL.Utilities
import Graphics.UI.SDL.General
data FontStyle
= StyleBold
| StyleItalic
| StyleUnderline
deriving (Int -> FontStyle -> ShowS
[FontStyle] -> ShowS
FontStyle -> String
(Int -> FontStyle -> ShowS)
-> (FontStyle -> String)
-> ([FontStyle] -> ShowS)
-> Show FontStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontStyle] -> ShowS
$cshowList :: [FontStyle] -> ShowS
show :: FontStyle -> String
$cshow :: FontStyle -> String
showsPrec :: Int -> FontStyle -> ShowS
$cshowsPrec :: Int -> FontStyle -> ShowS
Show,FontStyle -> FontStyle -> Bool
(FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool) -> Eq FontStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStyle -> FontStyle -> Bool
$c/= :: FontStyle -> FontStyle -> Bool
== :: FontStyle -> FontStyle -> Bool
$c== :: FontStyle -> FontStyle -> Bool
Eq,Eq FontStyle
Eq FontStyle
-> (FontStyle -> FontStyle -> Ordering)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> FontStyle)
-> (FontStyle -> FontStyle -> FontStyle)
-> Ord FontStyle
FontStyle -> FontStyle -> Bool
FontStyle -> FontStyle -> Ordering
FontStyle -> FontStyle -> FontStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontStyle -> FontStyle -> FontStyle
$cmin :: FontStyle -> FontStyle -> FontStyle
max :: FontStyle -> FontStyle -> FontStyle
$cmax :: FontStyle -> FontStyle -> FontStyle
>= :: FontStyle -> FontStyle -> Bool
$c>= :: FontStyle -> FontStyle -> Bool
> :: FontStyle -> FontStyle -> Bool
$c> :: FontStyle -> FontStyle -> Bool
<= :: FontStyle -> FontStyle -> Bool
$c<= :: FontStyle -> FontStyle -> Bool
< :: FontStyle -> FontStyle -> Bool
$c< :: FontStyle -> FontStyle -> Bool
compare :: FontStyle -> FontStyle -> Ordering
$ccompare :: FontStyle -> FontStyle -> Ordering
Ord)
instance Bounded FontStyle where
minBound :: FontStyle
minBound = FontStyle
StyleBold
maxBound :: FontStyle
maxBound = FontStyle
StyleUnderline
instance Enum FontStyle Int where
fromEnum :: FontStyle -> Int
fromEnum FontStyle
StyleBold = Int
1
fromEnum FontStyle
StyleItalic = Int
2
fromEnum FontStyle
StyleUnderline = Int
4
toEnum :: Int -> FontStyle
toEnum Int
1 = FontStyle
StyleBold
toEnum Int
2 = FontStyle
StyleItalic
toEnum Int
4 = FontStyle
StyleUnderline
toEnum Int
_ = String -> FontStyle
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.TTF.Attributes.toEnum: bad argument"
succ :: FontStyle -> FontStyle
succ FontStyle
StyleBold = FontStyle
StyleItalic
succ FontStyle
StyleItalic = FontStyle
StyleUnderline
succ FontStyle
_ = String -> FontStyle
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.TTF.Attributes.succ: bad argument"
pred :: FontStyle -> FontStyle
pred FontStyle
StyleItalic = FontStyle
StyleBold
pred FontStyle
StyleUnderline = FontStyle
StyleItalic
pred FontStyle
_ = String -> FontStyle
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.TTF.Attributes.pred: bad argument"
enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
enumFromTo FontStyle
x FontStyle
y | FontStyle
x FontStyle -> FontStyle -> Bool
forall a. Ord a => a -> a -> Bool
> FontStyle
y = []
| FontStyle
x FontStyle -> FontStyle -> Bool
forall a. Eq a => a -> a -> Bool
== FontStyle
y = [FontStyle
y]
| Bool
True = FontStyle
x FontStyle -> [FontStyle] -> [FontStyle]
forall a. a -> [a] -> [a]
: FontStyle -> FontStyle -> [FontStyle]
forall a b. Enum a b => a -> a -> [a]
enumFromTo (FontStyle -> FontStyle
forall a b. Enum a b => a -> a
succ FontStyle
x) FontStyle
y
foreign import ccall unsafe "TTF_GetFontStyle" ttfGetFontStyle :: Ptr FontStruct -> IO CInt
getFontStyle :: Font -> IO [FontStyle]
getFontStyle :: Font -> IO [FontStyle]
getFontStyle Font
font
= Font -> (Ptr FontStruct -> IO [FontStyle]) -> IO [FontStyle]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO [FontStyle]) -> IO [FontStyle])
-> (Ptr FontStruct -> IO [FontStyle]) -> IO [FontStyle]
forall a b. (a -> b) -> a -> b
$
(CInt -> [FontStyle]) -> IO CInt -> IO [FontStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [FontStyle]
forall a b. (Bounded a, Enum a b, Bits b, Num b) => b -> [a]
fromBitmask (Int -> [FontStyle]) -> (CInt -> Int) -> CInt -> [FontStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO [FontStyle])
-> (Ptr FontStruct -> IO CInt) -> Ptr FontStruct -> IO [FontStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr FontStruct -> IO CInt
ttfGetFontStyle
foreign import ccall unsafe "TTF_SetFontStyle" ttfSetFontStyle :: Ptr FontStruct -> CInt -> IO ()
setFontStyle :: Font -> [FontStyle] -> IO ()
setFontStyle :: Font -> [FontStyle] -> IO ()
setFontStyle Font
font [FontStyle]
style
= Font -> (Ptr FontStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO ()) -> IO ())
-> (Ptr FontStruct -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
Ptr FontStruct -> CInt -> IO ()
ttfSetFontStyle Ptr FontStruct
fontPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> ([FontStyle] -> Int) -> [FontStyle] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FontStyle] -> Int
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask ([FontStyle] -> CInt) -> [FontStyle] -> CInt
forall a b. (a -> b) -> a -> b
$ [FontStyle]
style)
foreign import ccall unsafe "TTF_FontHeight" ttfFontHeight :: Ptr FontStruct -> IO CInt
fontHeight :: Font -> IO Int
fontHeight :: Font -> IO Int
fontHeight Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontHeight
foreign import ccall unsafe "TTF_FontAscent" ttfFontAscent :: Ptr FontStruct -> IO CInt
fontAscent :: Font -> IO Int
fontAscent :: Font -> IO Int
fontAscent Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontAscent
foreign import ccall unsafe "TTF_FontAscent" ttfFontDescent :: Ptr FontStruct -> IO CInt
fontDescent :: Font -> IO Int
fontDescent :: Font -> IO Int
fontDescent Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontDescent
foreign import ccall unsafe "TTF_FontLineSkip" ttfFontLineSkip :: Ptr FontStruct -> IO CInt
fontLineSkip :: Font -> IO Int
fontLineSkip :: Font -> IO Int
fontLineSkip Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontLineSkip
foreign import ccall unsafe "TTF_FontFaces" ttfFontFaces :: Ptr FontStruct -> IO CInt
fontFaces :: Font -> IO Int
fontFaces :: Font -> IO Int
fontFaces Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontFaces
foreign import ccall unsafe "TTF_FontFaceIsFixedWidth" ttfFontFaceIsFixedWidth :: Ptr FontStruct -> IO CInt
fontFaceIsFixedWidth :: Font -> IO Int
fontFaceIsFixedWidth :: Font -> IO Int
fontFaceIsFixedWidth Font
font = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr FontStruct -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CInt
ttfFontFaceIsFixedWidth
foreign import ccall unsafe "TTF_FontFaceFamilyName" ttfFontFaceFamilyName :: Ptr FontStruct -> IO CString
fontFaceFamilyName :: Font -> IO String
fontFaceFamilyName :: Font -> IO String
fontFaceFamilyName Font
font = Font -> (Ptr FontStruct -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CString
ttfFontFaceFamilyName IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
foreign import ccall unsafe "TTF_FontFaceStyleName" ttfFontFaceStyleName :: Ptr FontStruct -> IO CString
fontFaceStyleName :: Font -> IO String
fontFaceStyleName :: Font -> IO String
fontFaceStyleName Font
font = Font -> (Ptr FontStruct -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO CString
ttfFontFaceStyleName IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
getSize :: (Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt) -> Font -> String -> IO (Maybe (Int,Int))
getSize :: (Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt)
-> Font -> String -> IO (Maybe (Int, Int))
getSize Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
getter Font
font String
string
= String
-> (CString -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a. String -> (CString -> IO a) -> IO a
withCString String
string ((CString -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int)))
-> (CString -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \CString
cString ->
(Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
width ->
(Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
height ->
Font
-> (Ptr FontStruct -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int)))
-> (Ptr FontStruct -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
do CInt
ret <- Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
getter Ptr FontStruct
fontPtr CString
cString Ptr CInt
width Ptr CInt
height
case CInt
ret of
CInt
0 -> do [CInt
w,CInt
h] <- (Ptr CInt -> IO CInt) -> [Ptr CInt] -> IO [CInt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek [Ptr CInt
width,Ptr CInt
height]
Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h))
CInt
_ -> Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing
foreign import ccall unsafe "TTF_SizeText" ttfSizeText
:: Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
tryTextSize :: Font -> String -> IO (Maybe (Int,Int))
tryTextSize :: Font -> String -> IO (Maybe (Int, Int))
tryTextSize = (Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt)
-> Font -> String -> IO (Maybe (Int, Int))
getSize Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
ttfSizeText
textSize :: Font -> String -> IO (Int,Int)
textSize :: Font -> String -> IO (Int, Int)
textSize Font
font String
string = String -> IO (Maybe (Int, Int)) -> IO (Int, Int)
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_SizeText" (Font -> String -> IO (Maybe (Int, Int))
tryTextSize Font
font String
string)
foreign import ccall unsafe "TTF_SizeUTF8" ttfSizeUTF8
:: Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
tryUTF8Size :: Font -> String -> IO (Maybe (Int,Int))
tryUTF8Size :: Font -> String -> IO (Maybe (Int, Int))
tryUTF8Size = (Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt)
-> Font -> String -> IO (Maybe (Int, Int))
getSize Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
ttfSizeUTF8
utf8Size :: Font -> String -> IO (Int,Int)
utf8Size :: Font -> String -> IO (Int, Int)
utf8Size Font
font String
string = String -> IO (Maybe (Int, Int)) -> IO (Int, Int)
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_SizeUTF8" (Font -> String -> IO (Maybe (Int, Int))
tryUTF8Size Font
font String
string)