{-# LINE 1 "./Graphics/Rendering/Pango/Description.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Rendering.Pango.Description (
FontDescription,
fontDescriptionNew,
fontDescriptionCopy,
fontDescriptionSetFamily,
fontDescriptionGetFamily,
fontDescriptionSetStyle,
fontDescriptionGetStyle,
fontDescriptionSetVariant,
fontDescriptionGetVariant,
fontDescriptionSetWeight,
fontDescriptionGetWeight,
fontDescriptionSetStretch,
fontDescriptionGetStretch,
fontDescriptionSetSize,
fontDescriptionGetSize,
FontMask(..),
fontDescriptionUnsetFields,
fontDescriptionMerge,
fontDescriptionBetterMatch,
fontDescriptionFromString,
fontDescriptionToString
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.Flags (Flags, fromFlags)
import System.Glib.UTFString
import Graphics.Rendering.Pango.Types
{-# LINE 64 "./Graphics/Rendering/Pango/Description.chs" #-}
import Graphics.Rendering.Pango.Enums
{-# LINE 65 "./Graphics/Rendering/Pango/Description.chs" #-}
import Graphics.Rendering.Pango.Structs ( puToInt, intToPu )
import Graphics.Rendering.Pango.BasicTypes
{-# LINE 69 "./Graphics/Rendering/Pango/Description.chs" #-}
fontDescriptionNew :: IO FontDescription
fontDescriptionNew :: IO FontDescription
fontDescriptionNew = IO (Ptr FontDescription)
pango_font_description_new IO (Ptr FontDescription)
-> (Ptr FontDescription -> IO FontDescription)
-> IO FontDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr FontDescription -> IO FontDescription
makeNewFontDescription
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy FontDescription
fd = (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO (Ptr FontDescription))
-> IO (Ptr FontDescription)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO (Ptr FontDescription))
-> IO (Ptr FontDescription))
-> (Ptr FontDescription -> IO (Ptr FontDescription))
-> IO (Ptr FontDescription)
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO (Ptr FontDescription)
pango_font_description_copy Ptr FontDescription
argPtr1) FontDescription
fd IO (Ptr FontDescription)
-> (Ptr FontDescription -> IO FontDescription)
-> IO FontDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr FontDescription -> IO FontDescription
makeNewFontDescription
fontDescriptionSetFamily :: GlibString string => FontDescription -> string -> IO ()
fontDescriptionSetFamily :: forall string.
GlibString string =>
FontDescription -> string -> IO ()
fontDescriptionSetFamily FontDescription
fd string
family = string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
family ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
(\(FontDescription ForeignPtr FontDescription
arg1) CString
arg2 -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> CString -> IO ()
pango_font_description_set_family Ptr FontDescription
argPtr1 CString
arg2) FontDescription
fd CString
strPtr
fontDescriptionGetFamily :: GlibString string => FontDescription -> IO (Maybe string)
fontDescriptionGetFamily :: forall string.
GlibString string =>
FontDescription -> IO (Maybe string)
fontDescriptionGetFamily FontDescription
fd = do
CString
strPtr <- (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CString) -> IO CString)
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CString
pango_font_description_get_family Ptr FontDescription
argPtr1) FontDescription
fd
if CString
strPtrCString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
==CString
forall a. Ptr a
nullPtr then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing else
(string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
data FontMask = PangoFontMaskFamily
| PangoFontMaskStyle
| PangoFontMaskVariant
| PangoFontMaskWeight
| PangoFontMaskStretch
| PangoFontMaskSize
| PangoFontMaskGravity
| PangoFontMaskVariations
deriving (FontMask
FontMask -> FontMask -> Bounded FontMask
forall a. a -> a -> Bounded a
$cminBound :: FontMask
minBound :: FontMask
$cmaxBound :: FontMask
maxBound :: FontMask
Bounded)
instance Enum FontMask where
fromEnum PangoFontMaskFamily = 1
fromEnum PangoFontMaskStyle = 2
fromEnum PangoFontMaskVariant = 4
fromEnum PangoFontMaskWeight = 8
fromEnum PangoFontMaskStretch = 16
fromEnum PangoFontMaskSize = 32
fromEnum PangoFontMaskGravity = 64
fromEnum PangoFontMaskVariations = 128
toEnum 1 = PangoFontMaskFamily
toEnum 2 = PangoFontMaskStyle
toEnum 4 = PangoFontMaskVariant
toEnum 8 = PangoFontMaskWeight
toEnum 16 = PangoFontMaskStretch
toEnum 32 = PangoFontMaskSize
toEnum 64 = PangoFontMaskGravity
toEnum 128 = PangoFontMaskVariations
toEnum unmatched = error ("FontMask.toEnum: Cannot match " ++ show unmatched)
succ PangoFontMaskFamily = PangoFontMaskStyle
succ PangoFontMaskStyle = PangoFontMaskVariant
succ PangoFontMaskVariant = PangoFontMaskWeight
succ PangoFontMaskWeight = PangoFontMaskStretch
succ PangoFontMaskStretch = PangoFontMaskSize
succ PangoFontMaskSize = PangoFontMaskGravity
succ PangoFontMaskGravity = PangoFontMaskVariations
succ _ = undefined
pred :: FontMask -> FontMask
pred FontMask
PangoFontMaskStyle = FontMask
PangoFontMaskFamily
pred PangoFontMaskVariant = PangoFontMaskStyle
pred PangoFontMaskWeight = PangoFontMaskVariant
pred PangoFontMaskStretch = PangoFontMaskWeight
pred FontMask
PangoFontMaskSize = FontMask
PangoFontMaskStretch
pred PangoFontMaskGravity = PangoFontMaskSize
pred PangoFontMaskVariations = PangoFontMaskGravity
pred FontMask
_ = FontMask
forall a. HasCallStack => a
undefined
enumFromTo :: FontMask -> FontMask -> [FontMask]
enumFromTo FontMask
x FontMask
y | FontMask -> Int
forall a. Enum a => a -> Int
fromEnum FontMask
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== FontMask -> Int
forall a. Enum a => a -> Int
fromEnum FontMask
y = [ FontMask
y ]
| Bool
otherwise = FontMask
x FontMask -> [FontMask] -> [FontMask]
forall a. a -> [a] -> [a]
: FontMask -> FontMask -> [FontMask]
forall a. Enum a => a -> a -> [a]
enumFromTo (FontMask -> FontMask
forall a. Enum a => a -> a
succ FontMask
x) FontMask
y
enumFrom :: FontMask -> [FontMask]
enumFrom FontMask
x = FontMask -> FontMask -> [FontMask]
forall a. Enum a => a -> a -> [a]
enumFromTo FontMask
x FontMask
PangoFontMaskVariations
enumFromThen :: FontMask -> FontMask -> [FontMask]
enumFromThen FontMask
_ FontMask
_ = [Char] -> [FontMask]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum FontMask: enumFromThen not implemented"
enumFromThenTo :: FontMask -> FontMask -> FontMask -> [FontMask]
enumFromThenTo FontMask
_ FontMask
_ FontMask
_ = [Char] -> [FontMask]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum FontMask: enumFromThenTo not implemented"
{-# LINE 105 "./Graphics/Rendering/Pango/Description.chs" #-}
instance Flags FontMask
fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()
fontDescriptionSetStyle fd p =
(\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_style argPtr1 arg2) fd (fromIntegral (fromEnum p))
fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)
fontDescriptionGetStyle fd = do
fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0
then liftM (Just . toEnum . fromIntegral) $
(\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_style argPtr1) fd
else return Nothing
fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()
fontDescriptionSetVariant fd p =
(\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_variant argPtr1 arg2) fd (fromIntegral (fromEnum p))
fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)
fontDescriptionGetVariant fd = do
fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0
then liftM (Just . toEnum . fromIntegral) $
(\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_variant argPtr1) fd
else return Nothing
fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()
fontDescriptionSetWeight fd p =
(\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_weight argPtr1 arg2) fd (fromIntegral (fromEnum p))
fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)
fontDescriptionGetWeight fd = do
fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0
then liftM (Just . toEnum . fromIntegral) $
(\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_weight argPtr1) fd
else return Nothing
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch FontDescription
fd Stretch
p =
(\(FontDescription ForeignPtr FontDescription
arg1) CInt
arg2 -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> CInt -> IO ()
pango_font_description_set_stretch Ptr FontDescription
argPtr1 CInt
arg2) FontDescription
fd (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Stretch -> Int
forall a. Enum a => a -> Int
fromEnum Stretch
p))
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch FontDescription
fd = do
CInt
fields <- (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CInt
pango_font_description_get_set_fields Ptr FontDescription
argPtr1) FontDescription
fd
if (FontMask -> Int
forall a. Enum a => a -> Int
fromEnum FontMask
PangoFontMaskStretch) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
fields) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0
then (CInt -> Maybe Stretch) -> IO CInt -> IO (Maybe Stretch)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Stretch -> Maybe Stretch
forall a. a -> Maybe a
Just (Stretch -> Maybe Stretch)
-> (CInt -> Stretch) -> CInt -> Maybe Stretch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Stretch
forall a. Enum a => Int -> a
toEnum (Int -> Stretch) -> (CInt -> Int) -> CInt -> Stretch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO (Maybe Stretch)) -> IO CInt -> IO (Maybe Stretch)
forall a b. (a -> b) -> a -> b
$
(\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CInt
pango_font_description_get_stretch Ptr FontDescription
argPtr1) FontDescription
fd
else Maybe Stretch -> IO (Maybe Stretch)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stretch
forall a. Maybe a
Nothing
fontDescriptionSetSize :: FontDescription -> Double -> IO ()
fontDescriptionSetSize :: FontDescription -> Double -> IO ()
fontDescriptionSetSize FontDescription
fd Double
p =
(\(FontDescription ForeignPtr FontDescription
arg1) CInt
arg2 -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> CInt -> IO ()
pango_font_description_set_size Ptr FontDescription
argPtr1 CInt
arg2) FontDescription
fd (Double -> CInt
puToInt Double
p)
fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)
fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)
fontDescriptionGetSize FontDescription
fd = do
CInt
fields <- (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CInt
pango_font_description_get_set_fields Ptr FontDescription
argPtr1) FontDescription
fd
if (FontMask -> Int
forall a. Enum a => a -> Int
fromEnum FontMask
PangoFontMaskSize) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
fields) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0
then (CInt -> Maybe Double) -> IO CInt -> IO (Maybe Double)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\CInt
x -> Double -> Maybe Double
forall a. a -> Maybe a
Just (CInt -> Double
intToPu CInt
x)) (IO CInt -> IO (Maybe Double)) -> IO CInt -> IO (Maybe Double)
forall a b. (a -> b) -> a -> b
$
(\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CInt
pango_font_description_get_size Ptr FontDescription
argPtr1) FontDescription
fd
else Maybe Double -> IO (Maybe Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields FontDescription
fd [FontMask]
mask =
(\(FontDescription ForeignPtr FontDescription
arg1) CInt
arg2 -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> CInt -> IO ()
pango_font_description_unset_fields Ptr FontDescription
argPtr1 CInt
arg2) FontDescription
fd (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([FontMask] -> Int
forall a. Flags a => [a] -> Int
fromFlags [FontMask]
mask))
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge FontDescription
fd1 FontDescription
fd2 Bool
replace =
(\(FontDescription ForeignPtr FontDescription
arg1) (FontDescription ForeignPtr FontDescription
arg2) CInt
arg3 -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->ForeignPtr FontDescription
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg2 ((Ptr FontDescription -> IO ()) -> IO ())
-> (Ptr FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr2 ->Ptr FontDescription -> Ptr FontDescription -> CInt -> IO ()
pango_font_description_merge Ptr FontDescription
argPtr1 Ptr FontDescription
argPtr2 CInt
arg3) FontDescription
fd1 FontDescription
fd2 (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
replace)
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch FontDescription
fdA FontDescription
fdB = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(FontDescription ForeignPtr FontDescription
arg1) (FontDescription ForeignPtr FontDescription
arg2) (FontDescription ForeignPtr FontDescription
arg3) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg2 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr2 ->ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg3 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr3 ->Ptr FontDescription
-> Ptr FontDescription -> Ptr FontDescription -> IO CInt
pango_font_description_better_match Ptr FontDescription
argPtr1 Ptr FontDescription
argPtr2 Ptr FontDescription
argPtr3) FontDescription
fdA (ForeignPtr FontDescription -> FontDescription
FontDescription ForeignPtr FontDescription
forall a. ForeignPtr a
nullForeignPtr) FontDescription
fdB
fontDescriptionBetterMatch :: FontDescription -> FontDescription ->
FontDescription -> Bool
fontDescriptionBetterMatch :: FontDescription -> FontDescription -> FontDescription -> Bool
fontDescriptionBetterMatch FontDescription
fd FontDescription
fdA FontDescription
fdB = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(FontDescription ForeignPtr FontDescription
arg1) (FontDescription ForeignPtr FontDescription
arg2) (FontDescription ForeignPtr FontDescription
arg3) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg2 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr2 ->ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg3 ((Ptr FontDescription -> IO CInt) -> IO CInt)
-> (Ptr FontDescription -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr3 ->Ptr FontDescription
-> Ptr FontDescription -> Ptr FontDescription -> IO CInt
pango_font_description_better_match Ptr FontDescription
argPtr1 Ptr FontDescription
argPtr2 Ptr FontDescription
argPtr3) FontDescription
fd FontDescription
fdA FontDescription
fdB
fontDescriptionFromString :: GlibString string => string -> IO FontDescription
fontDescriptionFromString :: forall string. GlibString string => string -> IO FontDescription
fontDescriptionFromString string
descr = string -> (CString -> IO FontDescription) -> IO FontDescription
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
descr ((CString -> IO FontDescription) -> IO FontDescription)
-> (CString -> IO FontDescription) -> IO FontDescription
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
CString -> IO (Ptr FontDescription)
pango_font_description_from_string CString
strPtr IO (Ptr FontDescription)
-> (Ptr FontDescription -> IO FontDescription)
-> IO FontDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr FontDescription -> IO FontDescription
makeNewFontDescription
fontDescriptionToString :: GlibString string => FontDescription -> IO string
fontDescriptionToString :: forall string. GlibString string => FontDescription -> IO string
fontDescriptionToString FontDescription
fd = do
CString
strPtr <- (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CString) -> IO CString)
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CString
pango_font_description_to_string Ptr FontDescription
argPtr1) FontDescription
fd
string
str <- CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
Ptr () -> IO ()
g_free (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
strPtr)
string -> IO string
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return string
str
foreign import ccall unsafe "pango_font_description_new"
pango_font_description_new :: (IO (Ptr FontDescription))
foreign import ccall unsafe "pango_font_description_copy"
pango_font_description_copy :: ((Ptr FontDescription) -> (IO (Ptr FontDescription)))
foreign import ccall unsafe "pango_font_description_set_family"
pango_font_description_set_family :: ((Ptr FontDescription) -> ((Ptr CChar) -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_family"
pango_font_description_get_family :: ((Ptr FontDescription) -> (IO (Ptr CChar)))
foreign import ccall unsafe "pango_font_description_set_style"
pango_font_description_set_style :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_set_fields"
pango_font_description_get_set_fields :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_get_style"
pango_font_description_get_style :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_set_variant"
pango_font_description_set_variant :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_variant"
pango_font_description_get_variant :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_set_weight"
pango_font_description_set_weight :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_weight"
pango_font_description_get_weight :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_set_stretch"
pango_font_description_set_stretch :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_stretch"
pango_font_description_get_stretch :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_set_size"
pango_font_description_set_size :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_get_size"
pango_font_description_get_size :: ((Ptr FontDescription) -> (IO CInt))
foreign import ccall unsafe "pango_font_description_unset_fields"
pango_font_description_unset_fields :: ((Ptr FontDescription) -> (CInt -> (IO ())))
foreign import ccall unsafe "pango_font_description_merge"
pango_font_description_merge :: ((Ptr FontDescription) -> ((Ptr FontDescription) -> (CInt -> (IO ()))))
foreign import ccall unsafe "pango_font_description_better_match"
pango_font_description_better_match :: ((Ptr FontDescription) -> ((Ptr FontDescription) -> ((Ptr FontDescription) -> (IO CInt))))
foreign import ccall unsafe "pango_font_description_from_string"
pango_font_description_from_string :: ((Ptr CChar) -> (IO (Ptr FontDescription)))
foreign import ccall unsafe "pango_font_description_to_string"
pango_font_description_to_string :: ((Ptr FontDescription) -> (IO (Ptr CChar)))
foreign import ccall unsafe "g_free"
g_free :: ((Ptr ()) -> (IO ()))