-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.TTF.Management
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.TTF.Management
    ( tryOpenFont
    , openFont
    , closeFont
    , tryOpenFontRW
    , openFontRW
    , tryOpenFontIndex
    , openFontIndex
    ) where

import Graphics.UI.SDL.TTF.Types
import Graphics.UI.SDL.General (unwrapMaybe)
import Graphics.UI.SDL.Types

import Foreign
import Foreign.C

-- void TTF_CloseFont(TTF_Font *font)
foreign import ccall unsafe "&TTF_CloseFont" ttfCloseFontFinal :: FunPtr (Ptr FontStruct -> IO ())
mkFinalizedFont :: Ptr FontStruct -> IO Font
mkFinalizedFont :: Ptr FontStruct -> IO Font
mkFinalizedFont = FinalizerPtr FontStruct -> Ptr FontStruct -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr FontStruct
ttfCloseFontFinal

foreign import ccall unsafe "TTF_CloseFont" ttfCloseFont :: Ptr FontStruct -> IO ()
closeFont :: Font -> IO ()
closeFont :: Font -> IO ()
closeFont Font
font = Font -> (Ptr FontStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font Ptr FontStruct -> IO ()
ttfCloseFont

-- TTF_Font *TTF_OpenFont(const char *file, int ptsize)
foreign import ccall unsafe "TTF_OpenFont" ttfOpenFont :: CString -> CInt -> IO (Ptr FontStruct)
tryOpenFont :: String -> Int -> IO (Maybe Font)
tryOpenFont :: String -> Int -> IO (Maybe Font)
tryOpenFont String
path Int
ptsize
    = String -> (CString -> IO (Maybe Font)) -> IO (Maybe Font)
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO (Maybe Font)) -> IO (Maybe Font))
-> (CString -> IO (Maybe Font)) -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$ \CString
cPath ->
      CString -> CInt -> IO (Ptr FontStruct)
ttfOpenFont CString
cPath (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ptsize) IO (Ptr FontStruct)
-> (Ptr FontStruct -> IO (Maybe Font)) -> IO (Maybe Font)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr FontStruct -> IO Font) -> Ptr FontStruct -> IO (Maybe Font)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr FontStruct -> IO Font
mkFinalizedFont

openFont :: String -> Int -> IO Font
openFont :: String -> Int -> IO Font
openFont String
path Int
ptsize = String -> IO (Maybe Font) -> IO Font
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_OpenFont" (String -> Int -> IO (Maybe Font)
tryOpenFont String
path Int
ptsize)

-- TTF_Font *TTF_OpenFontRW(SDL_RWops *src, int freesrc, int ptsize)
foreign import ccall unsafe "TTF_OpenFontRW" ttfOpenFontRW :: Ptr RWopsStruct -> CInt -> Int -> IO (Ptr FontStruct)
tryOpenFontRW :: RWops -> Bool -> Int -> IO (Maybe Font)
tryOpenFontRW :: RWops -> Bool -> Int -> IO (Maybe Font)
tryOpenFontRW RWops
rw Bool
freesrc Int
ptsize
    = RWops -> (Ptr RWopsStruct -> IO (Maybe Font)) -> IO (Maybe Font)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO (Maybe Font)) -> IO (Maybe Font))
-> (Ptr RWopsStruct -> IO (Maybe Font)) -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      Ptr RWopsStruct -> CInt -> Int -> IO (Ptr FontStruct)
ttfOpenFontRW Ptr RWopsStruct
rwPtr (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
freesrc) Int
ptsize IO (Ptr FontStruct)
-> (Ptr FontStruct -> IO (Maybe Font)) -> IO (Maybe Font)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr FontStruct -> IO Font) -> Ptr FontStruct -> IO (Maybe Font)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr FontStruct -> IO Font
mkFinalizedFont

openFontRW :: RWops -> Bool -> Int -> IO Font
openFontRW :: RWops -> Bool -> Int -> IO Font
openFontRW RWops
rw Bool
freesrc Int
ptsize
    = String -> IO (Maybe Font) -> IO Font
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_OpenFontRW" (RWops -> Bool -> Int -> IO (Maybe Font)
tryOpenFontRW RWops
rw Bool
freesrc Int
ptsize)

-- TTF_Font *TTF_OpenFontIndex(const char *file, int ptsize, long index)
foreign import ccall unsafe "TTF_OpenFontIndex" ttfOpenFontIndex :: CString -> CInt -> Int -> IO (Ptr FontStruct)
tryOpenFontIndex :: String -> Int -> Int -> IO (Maybe Font)
tryOpenFontIndex :: String -> Int -> Int -> IO (Maybe Font)
tryOpenFontIndex String
file Int
ptsize Int
index
    = String -> (CString -> IO (Maybe Font)) -> IO (Maybe Font)
forall a. String -> (CString -> IO a) -> IO a
withCString String
file ((CString -> IO (Maybe Font)) -> IO (Maybe Font))
-> (CString -> IO (Maybe Font)) -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$ \CString
cFile ->
      CString -> CInt -> Int -> IO (Ptr FontStruct)
ttfOpenFontIndex CString
cFile (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ptsize) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) IO (Ptr FontStruct)
-> (Ptr FontStruct -> IO (Maybe Font)) -> IO (Maybe Font)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr FontStruct -> IO Font) -> Ptr FontStruct -> IO (Maybe Font)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr FontStruct -> IO Font
mkFinalizedFont

openFontIndex :: String -> Int -> Int -> IO Font
openFontIndex :: String -> Int -> Int -> IO Font
openFontIndex String
file Int
ptsize Int
index = String -> IO (Maybe Font) -> IO Font
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_OpenFontIndex" (String -> Int -> Int -> IO (Maybe Font)
tryOpenFontIndex String
file Int
ptsize Int
index)

-- TODO:
-- 
-- TTF_Font *TTF_OpenFontIndexRW(SDL_RWops *src, int freesrc, int ptsize, long index)