{-# LINE 2 "./Graphics/Rendering/Pango/Attributes.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Rendering.Pango.Attributes (
withAttrList,
parseMarkup,
fromAttrList,
readAttrList
) where
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GError
import System.Glib.GList
import Graphics.Rendering.Pango.Structs
import Graphics.Rendering.Pango.BasicTypes
{-# LINE 44 "./Graphics/Rendering/Pango/Attributes.chs" #-}
import Data.List ( sortBy )
import Data.Char ( ord, chr )
import Control.Monad ( liftM )
{-# LINE 49 "./Graphics/Rendering/Pango/Attributes.chs" #-}
foreign import ccall unsafe "pango_attr_list_unref"
pango_attr_list_unref :: PangoAttrList -> IO ()
withAttrList :: PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
withAttrList :: forall a.
PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
withAttrList PangoString
_ [] Ptr () -> IO a
act = Ptr () -> IO a
act Ptr ()
forall a. Ptr a
nullPtr
withAttrList (PangoString UTFCorrection
correct CInt
_ ForeignPtr CChar
_) [PangoAttribute]
pas Ptr () -> IO a
act = do
Ptr ()
alPtr <- IO (Ptr ())
pango_attr_list_new
{-# LINE 58 "./Graphics/Rendering/Pango/Attributes.chs" #-}
let pas' = sortBy (\pa1 pa2 -> case compare (paStart pa1) (paStart pa2) of
EQ -> compare (paEnd pa1) (paEnd pa2)
other -> other) pas
(PangoAttribute -> IO ()) -> [PangoAttribute] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\PangoAttribute
pa -> do
Ptr ()
paPtr <- UTFCorrection -> PangoAttribute -> IO (Ptr ())
crAttr UTFCorrection
correct PangoAttribute
pa
Ptr () -> Ptr () -> IO ()
pango_attr_list_insert Ptr ()
alPtr (Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
paPtr)) [PangoAttribute]
pas'
a
res <- Ptr () -> IO a
act Ptr ()
alPtr
Ptr () -> IO ()
pango_attr_list_unref Ptr ()
alPtr
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
crAttr :: UTFCorrection -> PangoAttribute -> IO CPangoAttribute
crAttr :: UTFCorrection -> PangoAttribute -> IO (Ptr ())
crAttr UTFCorrection
c AttrLanguage { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paLang :: PangoAttribute -> Language
paLang = Language
lang } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (\(Language Ptr Language
arg1) -> Ptr Language -> IO (Ptr ())
pango_attr_language_new Ptr Language
arg1) Language
lang
crAttr UTFCorrection
c AttrFamily { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFamily :: PangoAttribute -> DefaultGlibString
paFamily = DefaultGlibString
fam } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ DefaultGlibString -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. DefaultGlibString -> (CString -> IO a) -> IO a
withUTFString DefaultGlibString
fam ((CString -> IO (Ptr ())) -> IO (Ptr ()))
-> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CString -> IO (Ptr ())
pango_attr_family_new
{-# LINE 74 "./Graphics/Rendering/Pango/Attributes.chs" #-}
crAttr c AttrStyle { paStart=s, paEnd=e, paStyle = style } =
setAttrPos c s e $
pango_attr_style_new (fromIntegral (fromEnum style))
crAttr UTFCorrection
c AttrWeight { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paWeight :: PangoAttribute -> Weight
paWeight = Weight
weight } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_weight_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Weight -> Int
forall a. Enum a => a -> Int
fromEnum Weight
weight))
crAttr UTFCorrection
c AttrVariant { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paVariant :: PangoAttribute -> Variant
paVariant = Variant
variant } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_variant_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variant -> Int
forall a. Enum a => a -> Int
fromEnum Variant
variant))
crAttr UTFCorrection
c AttrStretch { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paStretch :: PangoAttribute -> Stretch
paStretch = Stretch
stretch } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_stretch_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Stretch -> Int
forall a. Enum a => a -> Int
fromEnum Stretch
stretch))
crAttr UTFCorrection
c AttrSize { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paSize :: PangoAttribute -> Double
paSize = Double
pu } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_size_new (Double -> CInt
puToInt Double
pu)
crAttr UTFCorrection
c AttrAbsSize { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paSize :: PangoAttribute -> Double
paSize = Double
pu } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_size_new_absolute (Double -> CInt
puToInt Double
pu)
crAttr UTFCorrection
c AttrFontDescription { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFontDescription :: PangoAttribute -> FontDescription
paFontDescription = FontDescription
fd } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr FontDescription -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO (Ptr ())
pango_attr_font_desc_new Ptr FontDescription
argPtr1) FontDescription
fd
crAttr UTFCorrection
c AttrForeground { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_foreground_new
{-# LINE 96 "./Graphics/Rendering/Pango/Attributes.chs" #-}
(fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrBackground { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_background_new
{-# LINE 99 "./Graphics/Rendering/Pango/Attributes.chs" #-}
(fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrUnderline { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paUnderline :: PangoAttribute -> Underline
paUnderline = Underline
underline } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
CInt -> IO (Ptr ())
pango_attr_underline_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Underline -> Int
forall a. Enum a => a -> Int
fromEnum Underline
underline))
crAttr UTFCorrection
c AttrUnderlineColor {paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_underline_color_new
{-# LINE 107 "./Graphics/Rendering/Pango/Attributes.chs" #-}
(fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrStrikethrough { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paStrikethrough :: PangoAttribute -> Bool
paStrikethrough = Bool
st } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
CInt -> IO (Ptr ())
pango_attr_strikethrough_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
st))
crAttr UTFCorrection
c AttrStrikethroughColor {paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paColor :: PangoAttribute -> Color
paColor = Color Word16
r Word16
g Word16
b } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CUShort -> CUShort -> CUShort -> IO (Ptr ())
pango_attr_strikethrough_color_new
{-# LINE 116 "./Graphics/Rendering/Pango/Attributes.chs" #-}
(fromIntegral r) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b)
crAttr UTFCorrection
c AttrRise { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paRise :: PangoAttribute -> Double
paRise = Double
pu } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ CInt -> IO (Ptr ())
pango_attr_rise_new (Double -> CInt
puToInt Double
pu)
crAttr UTFCorrection
c AttrShape { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paInk :: PangoAttribute -> PangoRectangle
paInk = PangoRectangle
rect1, paLogical :: PangoAttribute -> PangoRectangle
paLogical = PangoRectangle
rect2 } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr PangoRectangle
rect1Ptr -> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr PangoRectangle -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr PangoRectangle
rect2Ptr -> do
Ptr PangoRectangle -> PangoRectangle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr PangoRectangle
rect1Ptr PangoRectangle
rect1
Ptr PangoRectangle -> PangoRectangle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr PangoRectangle
rect2Ptr PangoRectangle
rect2
Ptr () -> Ptr () -> IO (Ptr ())
pango_attr_shape_new (Ptr PangoRectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr PangoRectangle
rect1Ptr) (Ptr PangoRectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr PangoRectangle
rect2Ptr)
crAttr UTFCorrection
c AttrScale { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paScale :: PangoAttribute -> Double
paScale = Double
scale } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CDouble -> IO (Ptr ())
pango_attr_scale_new (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scale)
crAttr UTFCorrection
c AttrFallback { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paFallback :: PangoAttribute -> Bool
paFallback = Bool
fb } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_fallback_new (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
fb)
crAttr UTFCorrection
c AttrLetterSpacing { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paLetterSpacing :: PangoAttribute -> Double
paLetterSpacing = Double
pu } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_letter_spacing_new (Double -> CInt
puToInt Double
pu)
crAttr UTFCorrection
c AttrGravity { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paGravity :: PangoAttribute -> PangoGravity
paGravity = PangoGravity
g } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_gravity_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PangoGravity -> Int
forall a. Enum a => a -> Int
fromEnum PangoGravity
g))
crAttr UTFCorrection
c AttrGravityHint { paStart :: PangoAttribute -> Int
paStart=Int
s, paEnd :: PangoAttribute -> Int
paEnd=Int
e, paGravityHint :: PangoAttribute -> PangoGravityHint
paGravityHint = PangoGravityHint
g } =
UTFCorrection -> Int -> Int -> IO (Ptr ()) -> IO (Ptr ())
setAttrPos UTFCorrection
c Int
s Int
e (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$
CInt -> IO (Ptr ())
pango_attr_gravity_hint_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PangoGravityHint -> Int
forall a. Enum a => a -> Int
fromEnum PangoGravityHint
g))
parseMarkup ::
(GlibString markup, GlibString string)
=> markup
-> Char
-> IO ([[PangoAttribute]], Char, string)
parseMarkup :: forall markup string.
(GlibString markup, GlibString string) =>
markup -> Char -> IO ([[PangoAttribute]], Char, string)
parseMarkup markup
markup Char
accelMarker = (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string))
-> (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtr ->
markup
-> (CStringLen -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a. markup -> (CStringLen -> IO a) -> IO a
forall s a. GlibString s => s -> (CStringLen -> IO a) -> IO a
withUTFStringLen markup
markup ((CStringLen -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string))
-> (CStringLen -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \(CString
markupPtr,Int
markupLen) ->
(Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string))
-> (Ptr (Ptr ()) -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
attrListPtr ->
(Ptr CString -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string))
-> (Ptr CString -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
strPtrPtr ->
(Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string))
-> (Ptr CUInt -> IO ([[PangoAttribute]], Char, string))
-> IO ([[PangoAttribute]], Char, string)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
accelPtr -> do
Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
accelPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
accelMarker))
CInt
success <- CString
-> CInt
-> CUInt
-> Ptr ()
-> Ptr CString
-> Ptr CUInt
-> Ptr (Ptr ())
-> IO CInt
pango_parse_markup CString
markupPtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
markupLen) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
accelMarker))
(Ptr (Ptr ()) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr ())
attrListPtr) Ptr CString
strPtrPtr Ptr CUInt
accelPtr Ptr (Ptr ())
errPtr
if Bool -> Bool
not (CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
success) then ([[PangoAttribute]], Char, string)
-> IO ([[PangoAttribute]], Char, string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[PangoAttribute]], Char, string)
forall a. HasCallStack => a
undefined else do
CUInt
accel <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
accelPtr
CString
strPtr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
strPtrPtr
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)
Ptr ()
attrList <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
attrListPtr
[[PangoAttribute]]
attrs <- UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
fromAttrList (string -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs string
str) Ptr ()
attrList
([[PangoAttribute]], Char, string)
-> IO ([[PangoAttribute]], Char, string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[PangoAttribute]]
attrs, Int -> Char
chr (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
accel), string
str)
type PangoAttrIterator = Ptr (())
{-# LINE 191 "./Graphics/Rendering/Pango/Attributes.chs" #-}
fromAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
fromAttrList :: UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
fromAttrList UTFCorrection
correct Ptr ()
attrListPtr = do
Ptr ()
iter <- Ptr () -> IO (Ptr ())
pango_attr_list_get_iterator Ptr ()
attrListPtr
let readIter :: IO [[PangoAttribute]]
readIter = do
Ptr ()
list <- Ptr () -> IO (Ptr ())
pango_attr_iterator_get_attrs Ptr ()
iter
[PangoAttribute]
attrs <- if Ptr ()
listPtr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr ()
forall a. Ptr a
nullPtr then [PangoAttribute] -> IO [PangoAttribute]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
[Ptr ()]
attrPtrs <- Ptr () -> IO [Ptr ()]
forall a. Ptr () -> IO [Ptr a]
fromGSList Ptr ()
list
(Ptr () -> IO PangoAttribute) -> [Ptr ()] -> IO [PangoAttribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UTFCorrection -> Ptr () -> IO PangoAttribute
fromAttr UTFCorrection
correct) [Ptr ()]
attrPtrs
CInt
more <- Ptr () -> IO CInt
pango_attr_iterator_next Ptr ()
iter
if CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
more then ([[PangoAttribute]] -> [[PangoAttribute]])
-> IO [[PangoAttribute]] -> IO [[PangoAttribute]]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((:) [PangoAttribute]
attrs) (IO [[PangoAttribute]] -> IO [[PangoAttribute]])
-> IO [[PangoAttribute]] -> IO [[PangoAttribute]]
forall a b. (a -> b) -> a -> b
$ IO [[PangoAttribute]]
readIter else [[PangoAttribute]] -> IO [[PangoAttribute]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[[PangoAttribute]]
elems <- IO [[PangoAttribute]]
readIter
Ptr () -> IO ()
pango_attr_iterator_destroy Ptr ()
iter
[[PangoAttribute]] -> IO [[PangoAttribute]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[PangoAttribute]]
elems
fromAttr :: UTFCorrection -> CPangoAttribute -> IO PangoAttribute
fromAttr :: UTFCorrection -> Ptr () -> IO PangoAttribute
fromAttr UTFCorrection
correct Ptr ()
attrPtr = do
PangoAttribute
attr <- UTFCorrection -> Ptr () -> IO PangoAttribute
readAttr UTFCorrection
correct Ptr ()
attrPtr
Ptr () -> IO ()
pango_attribute_destroy Ptr ()
attrPtr
PangoAttribute -> IO PangoAttribute
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PangoAttribute
attr
readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
readAttrList :: UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
readAttrList UTFCorrection
correct Ptr ()
attrListPtr = do
[[PangoAttribute]]
elems <- UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
fromAttrList UTFCorrection
correct Ptr ()
attrListPtr
Ptr () -> IO ()
pango_attr_list_unref Ptr ()
attrListPtr
[[PangoAttribute]] -> IO [[PangoAttribute]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[PangoAttribute]]
elems
foreign import ccall unsafe "pango_attr_list_new"
pango_attr_list_new :: (IO (Ptr ()))
foreign import ccall unsafe "pango_attr_list_insert"
pango_attr_list_insert :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))
foreign import ccall unsafe "pango_attr_language_new"
pango_attr_language_new :: ((Ptr Language) -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_family_new"
pango_attr_family_new :: ((Ptr CChar) -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_style_new"
pango_attr_style_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_weight_new"
pango_attr_weight_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_variant_new"
pango_attr_variant_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_stretch_new"
pango_attr_stretch_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_size_new"
pango_attr_size_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_size_new_absolute"
pango_attr_size_new_absolute :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_font_desc_new"
pango_attr_font_desc_new :: ((Ptr FontDescription) -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_foreground_new"
pango_attr_foreground_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))
foreign import ccall unsafe "pango_attr_background_new"
pango_attr_background_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))
foreign import ccall unsafe "pango_attr_underline_new"
pango_attr_underline_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_underline_color_new"
pango_attr_underline_color_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))
foreign import ccall unsafe "pango_attr_strikethrough_new"
pango_attr_strikethrough_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_strikethrough_color_new"
pango_attr_strikethrough_color_new :: (CUShort -> (CUShort -> (CUShort -> (IO (Ptr ())))))
foreign import ccall unsafe "pango_attr_rise_new"
pango_attr_rise_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_shape_new"
pango_attr_shape_new :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall unsafe "pango_attr_scale_new"
pango_attr_scale_new :: (CDouble -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_fallback_new"
pango_attr_fallback_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_letter_spacing_new"
pango_attr_letter_spacing_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_gravity_new"
pango_attr_gravity_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_gravity_hint_new"
pango_attr_gravity_hint_new :: (CInt -> (IO (Ptr ())))
foreign import ccall unsafe "pango_parse_markup"
pango_parse_markup :: ((Ptr CChar) -> (CInt -> (CUInt -> ((Ptr ()) -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> ((Ptr (Ptr ())) -> (IO CInt))))))))
foreign import ccall unsafe "g_free"
g_free :: ((Ptr ()) -> (IO ()))
foreign import ccall unsafe "pango_attr_list_get_iterator"
pango_attr_list_get_iterator :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_iterator_get_attrs"
pango_attr_iterator_get_attrs :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall unsafe "pango_attr_iterator_next"
pango_attr_iterator_next :: ((Ptr ()) -> (IO CInt))
foreign import ccall unsafe "pango_attr_iterator_destroy"
pango_attr_iterator_destroy :: ((Ptr ()) -> (IO ()))
foreign import ccall unsafe "pango_attribute_destroy"
pango_attribute_destroy :: ((Ptr ()) -> (IO ()))