-- NOTE: Untested!
module Graphics.Text.Font.Choose.FontSet where

import Graphics.Text.Font.Choose.Pattern
import Graphics.Text.Font.Choose.Result (throwFalse, throwNull)

import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (pokeElemOff, sizeOf, peek)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (advancePtr)
import Control.Monad (forM)
import Control.Exception (bracket)

type FontSet = [Pattern]

------
--- Low-level
------
type FontSet' = Int
type FontSet_ = Ptr FontSet'

withNewFontSet :: (FontSet_ -> IO a) -> IO a
withNewFontSet = bracket fcFontSetCreate fcFontSetDestroy
foreign import ccall "FcFontSetCreate" fcFontSetCreate :: IO FontSet_
foreign import ccall "FcFontSetDestroy" fcFontSetDestroy :: FontSet_ -> IO ()

withFontSet :: FontSet -> (FontSet_ -> IO a) -> IO a
withFontSet fonts cb = withNewFontSet $ \fonts' -> do
    forM fonts $ \font -> do
        font' <- patternAsPointer font
        throwFalse <$> fcFontSetAdd fonts' font'
    cb fonts'
foreign import ccall "FcFontSetAdd" fcFontSetAdd :: FontSet_ -> Pattern_ -> IO Bool

withFontSets :: [FontSet] -> (Ptr FontSet_ -> Int -> IO a) -> IO a
withFontSets fontss cb = let n = length fontss in
    allocaBytes (sizeOf (undefined :: FontSet_) * n) $ \fontss' ->
        withFontSets' fontss 0 fontss' $ cb fontss' n
withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
withFontSets' [] _ _ cb = cb
withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do
    pokeElemOff fontss' i fonts'
    withFontSets' fontss (succ i) fontss' cb

thawFontSet :: FontSet_ -> IO FontSet
thawFontSet fonts' = do
    n <- peek fonts'
    array <- peek $ castPtr $ advancePtr fonts' 2
    if n == 0 || array == nullPtr
    then return []
    else forM [0..pred n] $ \i -> thawPattern =<< peek (advancePtr array i)
thawFontSet_ :: IO FontSet_ -> IO FontSet
thawFontSet_ cb = bracket (throwNull <$> cb) fcFontSetDestroy thawFontSet