-----------------------------------------------------------------------------
-- |
-- 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 (Show,Eq,Ord)

instance Bounded FontStyle where
    minBound = StyleBold
    maxBound = StyleUnderline

instance Enum FontStyle Int where
    fromEnum StyleBold = 1
    fromEnum StyleItalic = 2
    fromEnum StyleUnderline = 4
    toEnum 1 = StyleBold
    toEnum 2 = StyleItalic
    toEnum 4 = StyleUnderline
    toEnum _ = error "Graphics.UI.SDL.TTF.Attributes.toEnum: bad argument"
    succ StyleBold = StyleItalic
    succ StyleItalic = StyleUnderline
    succ _ = error "Graphics.UI.SDL.TTF.Attributes.succ: bad argument"
    pred StyleItalic = StyleBold
    pred StyleUnderline = StyleItalic
    pred _ = error "Graphics.UI.SDL.TTF.Attributes.pred: bad argument"
    enumFromTo x y | x > y = []
                   | x == y = [y]
                   | True = x : enumFromTo (succ x) y


-- int TTF_GetFontStyle(TTF_Font *font)
foreign import ccall unsafe "TTF_GetFontStyle" ttfGetFontStyle :: Ptr FontStruct -> IO CInt
getFontStyle :: Font -> IO [FontStyle]
getFontStyle font
    = withForeignPtr font $
      fmap (fromBitmask . fromIntegral) . 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 style
    = withForeignPtr font $ \fontPtr ->
      ttfSetFontStyle fontPtr (fromIntegral . toBitmask $ style)

-- int TTF_FontHeight(TTF_Font *font)
foreign import ccall unsafe "TTF_FontHeight" ttfFontHeight :: Ptr FontStruct -> IO CInt
fontHeight :: Font -> IO Int
fontHeight font = fmap fromIntegral $ withForeignPtr font ttfFontHeight

-- int TTF_FontAscent(TTF_Font *font)
foreign import ccall unsafe "TTF_FontAscent" ttfFontAscent :: Ptr FontStruct -> IO CInt
fontAscent :: Font -> IO Int
fontAscent font = fmap fromIntegral $ withForeignPtr font ttfFontAscent

-- int TTF_FontDecent(TTF_Font *font)
foreign import ccall unsafe "TTF_FontAscent" ttfFontDescent :: Ptr FontStruct -> IO CInt
fontDescent :: Font -> IO Int
fontDescent font = fmap fromIntegral $ withForeignPtr font ttfFontDescent

-- int TTF_FontLineSkip(TTF_Font *font)
foreign import ccall unsafe "TTF_FontLineSkip" ttfFontLineSkip :: Ptr FontStruct -> IO CInt
fontLineSkip :: Font -> IO Int
fontLineSkip font = fmap fromIntegral $ withForeignPtr font ttfFontLineSkip

-- long TTF_FontFaces(TTF_Font *font);
foreign import ccall unsafe "TTF_FontFaces" ttfFontFaces :: Ptr FontStruct -> IO CInt
fontFaces :: Font -> IO Int
fontFaces font = fmap fromIntegral $ withForeignPtr font 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 = fmap fromIntegral $ withForeignPtr font 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 = withForeignPtr font ttfFontFaceFamilyName >>= 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 = withForeignPtr font ttfFontFaceStyleName >>= peekCString


getSize :: (Ptr FontStruct -> CString -> Ptr CInt -> Ptr CInt -> IO CInt) -> Font -> String -> IO (Maybe (Int,Int))
getSize getter font string
    = withCString string $ \cString ->
      alloca $ \width ->
      alloca $ \height ->
      withForeignPtr font $ \fontPtr ->
      do ret <- getter fontPtr cString width height
         case ret of
           0 -> do [w,h] <- mapM peek [width,height]
                   return (Just (fromIntegral w,fromIntegral h))
           _ -> return 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 = getSize ttfSizeText

textSize :: Font -> String -> IO (Int,Int)
textSize font string = unwrapMaybe "TTF_SizeText" (tryTextSize font 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 = getSize ttfSizeUTF8

utf8Size :: Font -> String -> IO (Int,Int)
utf8Size font string = unwrapMaybe "TTF_SizeUTF8" (tryUTF8Size font string)