    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.UI.SDL.TTF.Attributes
    -- Copyright   :  (c) David Himmelstrup 2005
    -- License     :  BSD-like
    --
    -- Maintainer  :  lemmih@gmail.com
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -----------------------------------------------------------------------------
    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
    $cp1Ord :: Eq FontStyle
    Ord)

    instance Bounded FontStyle where
        minBound :: FontStyle
    minBound = FontStyle
    StyleBold
        maxBound :: FontStyle
    maxBound = FontStyle
    StyleUnderline

    instance Enum FontStyle Int where
        fromEnum :: FontStyle -> Int
    fromEnum StyleBold = 1
        fromEnum StyleItalic = 2
        fromEnum StyleUnderline = 4
        toEnum :: Int -> FontStyle
    toEnum 1 = FontStyle
    StyleBold
        toEnum 2 = FontStyle
    StyleItalic
        toEnum 4 = FontStyle
    StyleUnderline
        toEnum _ = String -> FontStyle
    forall a. HasCallStack => String -> a
    error "Graphics.UI.SDL.TTF.Attributes.toEnum: bad argument"
        succ :: FontStyle -> FontStyle
    succ StyleBold = FontStyle
    StyleItalic
        succ StyleItalic = FontStyle
    StyleUnderline
        succ _ = String -> FontStyle
    forall a. HasCallStack => String -> a
    error "Graphics.UI.SDL.TTF.Attributes.succ: bad argument"
        pred :: FontStyle -> FontStyle
    pred StyleItalic = FontStyle
    StyleBold
        pred StyleUnderline = FontStyle
    StyleItalic
        pred _ = String -> FontStyle
    forall a. HasCallStack => String -> a
    error "Graphics.UI.SDL.TTF.Attributes.pred: bad argument"
        enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
    enumFromTo x :: FontStyle
    x y :: 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

    -- int TTF_GetFontStyle(TTF_Font *font)
    foreign import ccall unsafe "TTF_GetFontStyle" ttfGetFontStyle :: Ptr FontStruct -> IO CInt
    getFontStyle :: Font -> IO [FontStyle]
    getFontStyle :: Font -> IO [FontStyle]
    getFontStyle font :: 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

    -- void TTF_SetFontStyle(TTF_Font *font, int style)
    foreign import ccall unsafe "TTF_SetFontStyle" ttfSetFontStyle :: Ptr FontStruct -> CInt -> IO ()
    setFontStyle :: Font -> [FontStyle] -> IO ()
    setFontStyle :: Font -> [FontStyle] -> IO ()
    setFontStyle font :: Font
    font style :: [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
    $ \fontPtr :: 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)

    -- int TTF_FontHeight(TTF_Font *font)
    foreign import ccall unsafe "TTF_FontHeight" ttfFontHeight :: Ptr FontStruct -> IO CInt
    fontHeight :: Font -> IO Int
    fontHeight :: Font -> IO Int
    fontHeight font :: 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

    -- int TTF_FontAscent(TTF_Font *font)
    foreign import ccall unsafe "TTF_FontAscent" ttfFontAscent :: Ptr FontStruct -> IO CInt
    fontAscent :: Font -> IO Int
    fontAscent :: Font -> IO Int
    fontAscent font :: 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

    -- int TTF_FontDecent(TTF_Font *font)
    foreign import ccall unsafe "TTF_FontAscent" ttfFontDescent :: Ptr FontStruct -> IO CInt
    fontDescent :: Font -> IO Int
    fontDescent :: Font -> IO Int
    fontDescent font :: 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

    -- int TTF_FontLineSkip(TTF_Font *font)
    foreign import ccall unsafe "TTF_FontLineSkip" ttfFontLineSkip :: Ptr FontStruct -> IO CInt
    fontLineSkip :: Font -> IO Int
    fontLineSkip :: Font -> IO Int
    fontLineSkip font :: 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

    -- long TTF_FontFaces(TTF_Font *font);
    foreign import ccall unsafe "TTF_FontFaces" ttfFontFaces :: Ptr FontStruct -> IO CInt
    fontFaces :: Font -> IO Int
    fontFaces :: Font -> IO Int
    fontFaces font :: 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

    -- int SDLCALL TTF_FontFaceIsFixedWidth(TTF_Font *font);
    foreign import ccall unsafe "TTF_FontFaceIsFixedWidth" ttfFontFaceIsFixedWidth :: Ptr FontStruct -> IO CInt
    fontFaceIsFixedWidth :: Font -> IO Int
    fontFaceIsFixedWidth :: Font -> IO Int
    fontFaceIsFixedWidth font :: 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

    -- char * SDLCALL TTF_FontFaceFamilyName(TTF_Font *font);
    foreign import ccall unsafe "TTF_FontFaceFamilyName" ttfFontFaceFamilyName :: Ptr FontStruct -> IO CString
    fontFaceFamilyName :: Font -> IO String
    fontFaceFamilyName :: Font -> IO String
    fontFaceFamilyName font :: 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

    -- char * SDLCALL TTF_FontFaceStyleName(TTF_Font *font);
    foreign import ccall unsafe "TTF_FontFaceStyleName" ttfFontFaceStyleName :: Ptr FontStruct -> IO CString
    fontFaceStyleName :: Font -> IO String
    fontFaceStyleName :: Font -> IO String
    fontFaceStyleName font :: 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 getter :: Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
    getter font :: Font
    font string :: 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
    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
    $ \width :: 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
    $ \height :: 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
    $ \fontPtr :: 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
               0 -> do [w :: CInt
    w,h :: 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))
               _ -> Maybe (Int, Int) -> IO (Maybe (Int, Int))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Int, Int)
    forall a. Maybe a
    Nothing

    -- int SDLCALL TTF_SizeText(TTF_Font *font, const char *text, int *w, int *h);
    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
    font string :: String
    string = String -> IO (Maybe (Int, Int)) -> IO (Int, Int)
    forall a. String -> IO (Maybe a) -> IO a
    unwrapMaybe "TTF_SizeText" (Font -> String -> IO (Maybe (Int, Int))
    tryTextSize Font
    font String
    string)

    -- int SDLCALL TTF_SizeUTF8(TTF_Font *font, const char *text, int *w, int *h);
    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
    font string :: String
    string = String -> IO (Maybe (Int, Int)) -> IO (Int, Int)
    forall a. String -> IO (Maybe a) -> IO a
    unwrapMaybe "TTF_SizeUTF8" (Font -> String -> IO (Maybe (Int, Int))
    tryUTF8Size Font
    font String
    string)