module Graphics.Text.Font.Choose.CharSet where

import Data.Set (Set)
import qualified Data.Set as Set

import Data.Word (Word32)
import Foreign.Ptr
import Control.Exception (bracket)
import Control.Monad (forM)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import GHC.Base (unsafeChr)
import Data.Char (ord)

type CharSet = Set Char

------
--- Low-level
------

data CharSet'
type CharSet_ = Ptr CharSet'

withNewCharSet :: (CharSet_ -> IO a) -> IO a
withNewCharSet cb = bracket fcCharSetCreate fcCharSetDestroy cb
foreign import ccall "FcCharSetCreate" fcCharSetCreate :: IO CharSet_
foreign import ccall "FcCharSetDestroy" fcCharSetDestroy :: CharSet_ -> IO ()

withCharSet :: CharSet -> (CharSet_ -> IO a) -> IO a
withCharSet chars cb = withNewCharSet $ \chars' -> do
    forM (Set.elems chars) $ fcCharSetAddChar chars' . fromIntegral . ord
    cb chars'
foreign import ccall "FcCharSetAddChar" fcCharSetAddChar :: CharSet_ -> Word32 -> IO Bool

thawCharSet :: CharSet_ -> IO CharSet
thawCharSet chars' = allocaBytes fcCHARSET_MAP_SIZE $ \iter' -> alloca $ \next' -> do
    first <- fcCharSetFirstPage chars' iter' next'
    let go = do {
        ch <- fcCharSetNextPage chars' iter' next';
        if ch == maxBound then return []
        else do
            chs <- go
            return (ch:chs)
      }
    rest <- go
    return $ Set.fromList $ map (unsafeChr . fromIntegral) (first:rest)
foreign import ccall "FcCharSetFirstPage" fcCharSetFirstPage ::
    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32
foreign import ccall "FcCharSetNextPage" fcCharSetNextPage ::
    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32
foreign import ccall "my_FcCHARSET_MAP_SIZE" fcCHARSET_MAP_SIZE :: Int