M Graphics/Text/Font/Choose/LangSet.hs => Graphics/Text/Font/Choose/LangSet.hs +32 -9
@@ 1,12 1,16 @@
-module Graphics.Text.Font.Choose.LangSet where
+module Graphics.Text.Font.Choose.LangSet (LangSet, defaultLangs, langs,
+ langSetCompare, langNormalize, langCharSet,
+ LangSet_, withLangSet, thawLangSet) where
import Data.Set (Set)
import qualified Data.Set as Set
-import Graphics.Text.Font.Choose.Strings (thawStrSet, StrSet_)
+import Graphics.Text.Font.Choose.Strings (thawStrSet, thawStrSet_, StrSet_)
import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
+import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)
import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString, peekCString)
+import Foreign.Marshal.Alloc (free)
import Control.Exception (bracket)
import Control.Monad (forM)
import System.IO.Unsafe (unsafePerformIO)
@@ 18,22 22,40 @@ defaultLangs = thawStrSet =<< fcGetDefaultLangs
foreign import ccall "FcGetDefaultLangs" fcGetDefaultLangs :: IO StrSet_
langs :: LangSet
-langs = unsafePerformIO (thawStrSet =<< fcGetLangs)
+langs = unsafePerformIO $ thawStrSet_ $ fcGetLangs
foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_
-data LangResult = SameLang | DifferentTerritory | DifferentLang deriving Enum
+data LangResult = SameLang | DifferentTerritory | DifferentLang
+ deriving (Enum, Eq, Read, Show)
langSetCompare :: LangSet -> LangSet -> LangResult
langSetCompare a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $ \b' ->
(toEnum <$> fcLangSetCompare a' b')
foreign import ccall "FcLangSetCompare" fcLangSetCompare ::
LangSet_ -> LangSet_ -> IO Int
+langSetContains :: LangSet -> LangSet -> Bool
+langSetContains a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $
+ fcLangSetContains a'
+foreign import ccall "FcLangSetContains" fcLangSetContains ::
+ LangSet_ -> LangSet_ -> IO Bool
+
+langSetHasLang :: LangSet -> String -> LangResult
+langSetHasLang a b = unsafePerformIO $ withLangSet a $ \a' -> withCString b $ \b' ->
+ (toEnum <$> fcLangSetHasLang a' b')
+foreign import ccall "FcLangSetHasLang" fcLangSetHasLang :: LangSet_ -> CString -> IO Int
+
langNormalize :: String -> String
-langNormalize lang = unsafePerformIO $ withCString lang (peekCString . fcLangNormalize)
+langNormalize "" = ""
+langNormalize lang = unsafePerformIO $ withCString lang (peekCString_ . fcLangNormalize)
foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
+peekCString_ str' = do
+ str <- peekCString $ throwNull str'
+ free str'
+ return str
langCharSet :: String -> CharSet
-langCharSet lang = unsafePerformIO $ withCString lang (thawCharSet . fcLangGetCharSet)
+langCharSet lang = unsafePerformIO $
+ withCString lang (thawCharSet . throwNull . fcLangGetCharSet)
foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_
------
@@ 44,16 66,17 @@ data LangSet'
type LangSet_ = Ptr LangSet'
withNewLangSet :: (LangSet_ -> IO a) -> IO a
-withNewLangSet = bracket fcLangSetCreate fcLangSetDestroy
+withNewLangSet = bracket (throwNull <$> fcLangSetCreate) fcLangSetDestroy
foreign import ccall "FcLangSetCreate" fcLangSetCreate :: IO LangSet_
foreign import ccall "FcLangSetDestroy" fcLangSetDestroy :: LangSet_ -> IO ()
withLangSet :: LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet langs cb = withNewLangSet $ \langs' -> do
- forM (Set.elems langs) $ flip withCString $ fcLangSetAdd langs'
+ forM (Set.elems langs) $ flip withCString $ \lang' ->
+ throwFalse <$> fcLangSetAdd langs' lang'
cb langs'
foreign import ccall "FcLangSetAdd" fcLangSetAdd :: LangSet_ -> CString -> IO Bool
thawLangSet :: LangSet_ -> IO LangSet
-thawLangSet langs' = thawStrSet =<< fcLangSetGetLangs langs'
+thawLangSet = thawStrSet_ . fcLangSetGetLangs
foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_
M Graphics/Text/Font/Choose/Strings.hs => Graphics/Text/Font/Choose/Strings.hs +5 -1
@@ 1,8 1,9 @@
module Graphics.Text.Font.Choose.Strings (StrSet, StrSet_, StrList, StrList_,
- withStrSet, withFilenameSet, thawStrSet, withStrList, thawStrList) where
+ withStrSet, withFilenameSet, thawStrSet, thawStrSet_, withStrList, thawStrList) where
import Data.Set (Set)
import qualified Data.Set as Set
+import Graphics.Text.Font.Choose.Result (throwNull)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.String (CString, withCString, peekCString)
@@ 35,6 36,9 @@ foreign import ccall "FcStrSetAddFilename" fcStrSetAddFilename ::
thawStrSet :: StrSet_ -> IO StrSet
thawStrSet strs = Set.fromList <$> withStrList strs thawStrList
+thawStrSet_ :: IO StrSet_ -> IO StrSet
+thawStrSet_ cb = bracket (throwNull <$> cb) fcStrSetDestroy thawStrSet
+
------------
type StrList = [String]