    {-# LINE 2 "./Graphics/Rendering/Pango/Attributes.chs" #-}
    {-# OPTIONS_HADDOCK hide #-}
    -- -*-haskell-*-
    -- GIMP Toolkit (GTK) - pango text attributes
    --
    -- Author : Axel Simon
    --
    -- Created: 20 October 2005
    --
    -- Copyright (C) 1999-2005 Axel Simon
    --
    -- This library is free software; you can redistribute it and/or
    -- modify it under the terms of the GNU Lesser General Public
    -- License as published by the Free Software Foundation; either
    -- version 2.1 of the License, or (at your option) any later version.
    --
    -- This library is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
    -- Lesser General Public License for more details.
    --
    -- #hide

    -- |
    -- Maintainer : gtk2hs-users@lists.sourceforge.net
    -- Stability : provisional
    -- Portability : portable (depends on GHC)
    --
    -- Defines text attributes.
    --
    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 ()

    -- Create an attribute list.
    withAttrList :: PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
    withAttrList _ [] act = act nullPtr
    withAttrList (PangoString correct _ _) pas act = do
      alPtr <- 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
      mapM_ (\pa -> do
        paPtr <- crAttr correct pa
        pango_attr_list_insert alPtr (castPtr paPtr)) pas'
      res <- act alPtr
      pango_attr_list_unref alPtr
      return res

    -- Create a PangoAttribute.
    crAttr :: UTFCorrection -> PangoAttribute -> IO CPangoAttribute
    crAttr c AttrLanguage { paStart=s, paEnd=e, paLang = lang } =
      setAttrPos c s e $ (\(Language arg1) -> pango_attr_language_new arg1) lang
    crAttr c AttrFamily { paStart=s, paEnd=e, paFamily = fam } =
      setAttrPos c s e $ withUTFString fam $ 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 c AttrWeight { paStart=s, paEnd=e, paWeight = weight } =
      setAttrPos c s e $
      pango_attr_weight_new (fromIntegral (fromEnum weight))
    crAttr c AttrVariant { paStart=s, paEnd=e, paVariant = variant } =
      setAttrPos c s e $
      pango_attr_variant_new (fromIntegral (fromEnum variant))
    crAttr c AttrStretch { paStart=s, paEnd=e, paStretch = stretch } =
      setAttrPos c s e $
      pango_attr_stretch_new (fromIntegral (fromEnum stretch))
    crAttr c AttrSize { paStart=s, paEnd=e, paSize = pu } =
      setAttrPos c s e $ pango_attr_size_new (puToInt pu)

    crAttr c AttrAbsSize { paStart=s, paEnd=e, paSize = pu } =
      setAttrPos c s e $ pango_attr_size_new_absolute (puToInt pu)

    crAttr c AttrFontDescription { paStart=s, paEnd=e, paFontDescription = fd } =
      setAttrPos c s e $ (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_attr_font_desc_new argPtr1) fd
    crAttr c AttrForeground { paStart=s, paEnd=e, paColor = Color r g b } =
      setAttrPos c s e $ pango_attr_foreground_new
    {-# LINE 96 "./Graphics/Rendering/Pango/Attributes.chs" #-}
      (fromIntegral r) (fromIntegral g) (fromIntegral b)
    crAttr c AttrBackground { paStart=s, paEnd=e, paColor = Color r g b } =
      setAttrPos c s e $ pango_attr_background_new
    {-# LINE 99 "./Graphics/Rendering/Pango/Attributes.chs" #-}
      (fromIntegral r) (fromIntegral g) (fromIntegral b)
    crAttr c AttrUnderline { paStart=s, paEnd=e, paUnderline = underline } =
      setAttrPos c s e $ do
      pango_attr_underline_new (fromIntegral (fromEnum underline))

    crAttr c AttrUnderlineColor {paStart=s, paEnd=e, paColor = Color r g b } =
      setAttrPos c s e $ pango_attr_underline_color_new
    {-# LINE 107 "./Graphics/Rendering/Pango/Attributes.chs" #-}
      (fromIntegral r) (fromIntegral g) (fromIntegral b)

    crAttr c AttrStrikethrough { paStart=s, paEnd=e, paStrikethrough = st } =
      setAttrPos c s e $ do
      pango_attr_strikethrough_new (fromIntegral (fromEnum st))

    crAttr c AttrStrikethroughColor {paStart=s, paEnd=e, paColor = Color r g b } =
      setAttrPos c s e $ pango_attr_strikethrough_color_new
    {-# LINE 116 "./Graphics/Rendering/Pango/Attributes.chs" #-}
      (fromIntegral r) (fromIntegral g) (fromIntegral b)

    crAttr c AttrRise { paStart=s, paEnd=e, paRise = pu } =
      setAttrPos c s e $ pango_attr_rise_new (puToInt pu)

    crAttr c AttrShape { paStart=s, paEnd=e, paInk = rect1, paLogical = rect2 } =
      setAttrPos c s e $ alloca $ \rect1Ptr -> alloca $ \rect2Ptr -> do
        poke rect1Ptr rect1
        poke rect2Ptr rect2
        pango_attr_shape_new (castPtr rect1Ptr) (castPtr rect2Ptr)

    crAttr c AttrScale { paStart=s, paEnd=e, paScale = scale } =
      setAttrPos c s e $
      pango_attr_scale_new (realToFrac scale)

    crAttr c AttrFallback { paStart=s, paEnd=e, paFallback = fb } =
      setAttrPos c s e $
      pango_attr_fallback_new (fromBool fb)

    crAttr c AttrLetterSpacing { paStart=s, paEnd=e, paLetterSpacing = pu } =
      setAttrPos c s e $
      pango_attr_letter_spacing_new (puToInt pu)

    crAttr c AttrGravity { paStart=s, paEnd=e, paGravity = g } =
      setAttrPos c s e $
      pango_attr_gravity_new (fromIntegral (fromEnum g))
    crAttr c AttrGravityHint { paStart=s, paEnd=e, paGravityHint = g } =
      setAttrPos c s e $
      pango_attr_gravity_hint_new (fromIntegral (fromEnum g))

    -- | Parse the marked-up text (see 'Graphics.Rendering.Pango.Markup.Markup'
    -- format) to create a plain-text string and an attribute list.
    --
    -- * The attribute list is a list of lists of attribute. Each list describes
    -- the attributes for the same span.
    --
    -- * If @accelMarker@ is not @'\0'@ (a zero character), the given character
    -- will mark the character following it as an accelerator. For example,
    -- @accelMarker@ might be an ampersand or underscore. All characters marked
    -- as an accelerator will receive a 'UnderlineLow' attribute, and the
    -- first character so marked will be returned as @accelChar@. If no
    -- accelerator character is found, the @accelMarker@ character itself is
    -- returned. Two @accelMarker@ characters following each other produce a
    -- single literal @accelMarker@ character.
    --
    -- * If a parsing error occurs a 'System.Glib.GError.GError' is thrown.
    --
    parseMarkup :: Markup -- ^ the string containing markup
      -> Char -- ^ @accelMarker@ - the character that prefixes an accelerator
      -> IO ([[PangoAttribute]], Char, String) -- ^ list of attributes, the accelerator character found and the input string
      -- without markup
    parseMarkup markup accelMarker = propagateGError $ \errPtr ->
      withUTFStringLen markup $ \(markupPtr,markupLen) ->
      alloca $ \attrListPtr ->
      alloca $ \strPtrPtr ->
      alloca $ \accelPtr -> do
        poke accelPtr (fromIntegral (ord accelMarker))
        success <- pango_parse_markup markupPtr
          (fromIntegral markupLen) (fromIntegral (ord accelMarker))
          (castPtr attrListPtr) strPtrPtr accelPtr errPtr
        if not (toBool success) then return undefined else do
          accel <- peek accelPtr
          strPtr <- peek strPtrPtr
          str <- peekUTFString strPtr
          g_free (castPtr strPtr)
          attrList <- peek attrListPtr
          attrs <- fromAttrList (genUTFOfs str) attrList
          return (attrs, chr (fromIntegral accel), str)

    type PangoAttrIterator = Ptr (())
    {-# LINE 189 "./Graphics/Rendering/Pango/Attributes.chs" #-}

    -- | Convert an attribute list into a list of attributes.
    fromAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
    fromAttrList correct attrListPtr = do
      iter <- pango_attr_list_get_iterator attrListPtr
      let readIter = do
            list <- pango_attr_iterator_get_attrs iter
            attrs <- if list==nullPtr then return [] else do
              attrPtrs <- fromGSList list
              mapM (fromAttr correct) attrPtrs
            more <- pango_attr_iterator_next iter
            if toBool more then liftM ((:) attrs) $ readIter else return []
      elems <- readIter
      pango_attr_iterator_destroy iter
      return elems

    -- | Extract and delete an attribute.
    --
    fromAttr :: UTFCorrection -> CPangoAttribute -> IO PangoAttribute
    fromAttr correct attrPtr = do
      attr <- readAttr correct attrPtr
      pango_attribute_destroy attrPtr
      return attr

    readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
    readAttrList correct attrListPtr = do
      elems <- fromAttrList correct attrListPtr
      pango_attr_list_unref attrListPtr
      return 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 ()))