{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Pango.Structs.GlyphItem.GlyphItem' is a pair of a t'GI.Pango.Structs.Item.Item' and the glyphs
-- resulting from shaping the text corresponding to an item.
-- As an example of the usage of t'GI.Pango.Structs.GlyphItem.GlyphItem', the results
-- of shaping text with t'GI.Pango.Objects.Layout.Layout' is a list of t'GI.Pango.Structs.LayoutLine.LayoutLine',
-- each of which contains a list of t'GI.Pango.Structs.GlyphItem.GlyphItem'.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Pango.Structs.GlyphItem
    ( 

-- * Exported types
    GlyphItem(..)                           ,
    newZeroGlyphItem                        ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveGlyphItemMethod                  ,
#endif


-- ** applyAttrs #method:applyAttrs#

#if defined(ENABLE_OVERLOADING)
    GlyphItemApplyAttrsMethodInfo           ,
#endif
    glyphItemApplyAttrs                     ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    GlyphItemCopyMethodInfo                 ,
#endif
    glyphItemCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    GlyphItemFreeMethodInfo                 ,
#endif
    glyphItemFree                           ,


-- ** getLogicalWidths #method:getLogicalWidths#

#if defined(ENABLE_OVERLOADING)
    GlyphItemGetLogicalWidthsMethodInfo     ,
#endif
    glyphItemGetLogicalWidths               ,


-- ** letterSpace #method:letterSpace#

#if defined(ENABLE_OVERLOADING)
    GlyphItemLetterSpaceMethodInfo          ,
#endif
    glyphItemLetterSpace                    ,


-- ** split #method:split#

#if defined(ENABLE_OVERLOADING)
    GlyphItemSplitMethodInfo                ,
#endif
    glyphItemSplit                          ,




 -- * Properties
-- ** glyphs #attr:glyphs#
-- | corresponding t'GI.Pango.Structs.GlyphString.GlyphString'.

    clearGlyphItemGlyphs                    ,
    getGlyphItemGlyphs                      ,
#if defined(ENABLE_OVERLOADING)
    glyphItem_glyphs                        ,
#endif
    setGlyphItemGlyphs                      ,


-- ** item #attr:item#
-- | corresponding t'GI.Pango.Structs.Item.Item'.

    clearGlyphItemItem                      ,
    getGlyphItemItem                        ,
#if defined(ENABLE_OVERLOADING)
    glyphItem_item                          ,
#endif
    setGlyphItemItem                        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Pango.Structs.AttrList as Pango.AttrList
import {-# SOURCE #-} qualified GI.Pango.Structs.GlyphString as Pango.GlyphString
import {-# SOURCE #-} qualified GI.Pango.Structs.Item as Pango.Item
import {-# SOURCE #-} qualified GI.Pango.Structs.LogAttr as Pango.LogAttr

-- | Memory-managed wrapper type.
newtype GlyphItem = GlyphItem (SP.ManagedPtr GlyphItem)
    deriving (GlyphItem -> GlyphItem -> Bool
(GlyphItem -> GlyphItem -> Bool)
-> (GlyphItem -> GlyphItem -> Bool) -> Eq GlyphItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphItem -> GlyphItem -> Bool
$c/= :: GlyphItem -> GlyphItem -> Bool
== :: GlyphItem -> GlyphItem -> Bool
$c== :: GlyphItem -> GlyphItem -> Bool
Eq)

instance SP.ManagedPtrNewtype GlyphItem where
    toManagedPtr :: GlyphItem -> ManagedPtr GlyphItem
toManagedPtr (GlyphItem ManagedPtr GlyphItem
p) = ManagedPtr GlyphItem
p

foreign import ccall "pango_glyph_item_get_type" c_pango_glyph_item_get_type :: 
    IO GType

type instance O.ParentTypes GlyphItem = '[]
instance O.HasParentTypes GlyphItem

instance B.Types.TypedObject GlyphItem where
    glibType :: IO GType
glibType = IO GType
c_pango_glyph_item_get_type

instance B.Types.GBoxed GlyphItem

-- | Convert 'GlyphItem' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue GlyphItem where
    toGValue :: GlyphItem -> IO GValue
toGValue GlyphItem
o = do
        GType
gtype <- IO GType
c_pango_glyph_item_get_type
        GlyphItem -> (Ptr GlyphItem -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr GlyphItem
o (GType
-> (GValue -> Ptr GlyphItem -> IO ()) -> Ptr GlyphItem -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr GlyphItem -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO GlyphItem
fromGValue GValue
gv = do
        Ptr GlyphItem
ptr <- GValue -> IO (Ptr GlyphItem)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr GlyphItem)
        (ManagedPtr GlyphItem -> GlyphItem)
-> Ptr GlyphItem -> IO GlyphItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr GlyphItem -> GlyphItem
GlyphItem Ptr GlyphItem
ptr
        
    

-- | Construct a `GlyphItem` struct initialized to zero.
newZeroGlyphItem :: MonadIO m => m GlyphItem
newZeroGlyphItem :: m GlyphItem
newZeroGlyphItem = IO GlyphItem -> m GlyphItem
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlyphItem -> m GlyphItem) -> IO GlyphItem -> m GlyphItem
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr GlyphItem)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr GlyphItem)
-> (Ptr GlyphItem -> IO GlyphItem) -> IO GlyphItem
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr GlyphItem -> GlyphItem)
-> Ptr GlyphItem -> IO GlyphItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphItem -> GlyphItem
GlyphItem

instance tag ~ 'AttrSet => Constructible GlyphItem tag where
    new :: (ManagedPtr GlyphItem -> GlyphItem)
-> [AttrOp GlyphItem tag] -> m GlyphItem
new ManagedPtr GlyphItem -> GlyphItem
_ [AttrOp GlyphItem tag]
attrs = do
        GlyphItem
o <- m GlyphItem
forall (m :: * -> *). MonadIO m => m GlyphItem
newZeroGlyphItem
        GlyphItem -> [AttrOp GlyphItem 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set GlyphItem
o [AttrOp GlyphItem tag]
[AttrOp GlyphItem 'AttrSet]
attrs
        GlyphItem -> m GlyphItem
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphItem
o


-- | Get the value of the “@item@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' glyphItem #item
-- @
getGlyphItemItem :: MonadIO m => GlyphItem -> m (Maybe Pango.Item.Item)
getGlyphItemItem :: GlyphItem -> m (Maybe Item)
getGlyphItemItem GlyphItem
s = IO (Maybe Item) -> m (Maybe Item)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Item) -> m (Maybe Item))
-> IO (Maybe Item) -> m (Maybe Item)
forall a b. (a -> b) -> a -> b
$ GlyphItem -> (Ptr GlyphItem -> IO (Maybe Item)) -> IO (Maybe Item)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO (Maybe Item)) -> IO (Maybe Item))
-> (Ptr GlyphItem -> IO (Maybe Item)) -> IO (Maybe Item)
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr Item
val <- Ptr (Ptr Item) -> IO (Ptr Item)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr Item)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr Pango.Item.Item)
    Maybe Item
result <- Ptr Item -> (Ptr Item -> IO Item) -> IO (Maybe Item)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Item
val ((Ptr Item -> IO Item) -> IO (Maybe Item))
-> (Ptr Item -> IO Item) -> IO (Maybe Item)
forall a b. (a -> b) -> a -> b
$ \Ptr Item
val' -> do
        Item
val'' <- ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Item -> Item
Pango.Item.Item) Ptr Item
val'
        Item -> IO Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item
val''
    Maybe Item -> IO (Maybe Item)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Item
result

-- | Set the value of the “@item@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' glyphItem [ #item 'Data.GI.Base.Attributes.:=' value ]
-- @
setGlyphItemItem :: MonadIO m => GlyphItem -> Ptr Pango.Item.Item -> m ()
setGlyphItemItem :: GlyphItem -> Ptr Item -> m ()
setGlyphItemItem GlyphItem
s Ptr Item
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GlyphItem -> (Ptr GlyphItem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO ()) -> IO ())
-> (Ptr GlyphItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr (Ptr Item) -> Ptr Item -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr Item)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr Item
val :: Ptr Pango.Item.Item)

-- | Set the value of the “@item@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #item
-- @
clearGlyphItemItem :: MonadIO m => GlyphItem -> m ()
clearGlyphItemItem :: GlyphItem -> m ()
clearGlyphItemItem GlyphItem
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GlyphItem -> (Ptr GlyphItem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO ()) -> IO ())
-> (Ptr GlyphItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr (Ptr Item) -> Ptr Item -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr Item)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr Item
forall a. Ptr a
FP.nullPtr :: Ptr Pango.Item.Item)

#if defined(ENABLE_OVERLOADING)
data GlyphItemItemFieldInfo
instance AttrInfo GlyphItemItemFieldInfo where
    type AttrBaseTypeConstraint GlyphItemItemFieldInfo = (~) GlyphItem
    type AttrAllowedOps GlyphItemItemFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint GlyphItemItemFieldInfo = (~) (Ptr Pango.Item.Item)
    type AttrTransferTypeConstraint GlyphItemItemFieldInfo = (~)(Ptr Pango.Item.Item)
    type AttrTransferType GlyphItemItemFieldInfo = (Ptr Pango.Item.Item)
    type AttrGetType GlyphItemItemFieldInfo = Maybe Pango.Item.Item
    type AttrLabel GlyphItemItemFieldInfo = "item"
    type AttrOrigin GlyphItemItemFieldInfo = GlyphItem
    attrGet = getGlyphItemItem
    attrSet = setGlyphItemItem
    attrConstruct = undefined
    attrClear = clearGlyphItemItem
    attrTransfer _ v = do
        return v

glyphItem_item :: AttrLabelProxy "item"
glyphItem_item = AttrLabelProxy

#endif


-- | Get the value of the “@glyphs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' glyphItem #glyphs
-- @
getGlyphItemGlyphs :: MonadIO m => GlyphItem -> m (Maybe Pango.GlyphString.GlyphString)
getGlyphItemGlyphs :: GlyphItem -> m (Maybe GlyphString)
getGlyphItemGlyphs GlyphItem
s = IO (Maybe GlyphString) -> m (Maybe GlyphString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GlyphString) -> m (Maybe GlyphString))
-> IO (Maybe GlyphString) -> m (Maybe GlyphString)
forall a b. (a -> b) -> a -> b
$ GlyphItem
-> (Ptr GlyphItem -> IO (Maybe GlyphString))
-> IO (Maybe GlyphString)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO (Maybe GlyphString))
 -> IO (Maybe GlyphString))
-> (Ptr GlyphItem -> IO (Maybe GlyphString))
-> IO (Maybe GlyphString)
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr GlyphString
val <- Ptr (Ptr GlyphString) -> IO (Ptr GlyphString)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr GlyphString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr Pango.GlyphString.GlyphString)
    Maybe GlyphString
result <- Ptr GlyphString
-> (Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr GlyphString
val ((Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString))
-> (Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString)
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphString
val' -> do
        GlyphString
val'' <- ((ManagedPtr GlyphString -> GlyphString)
-> Ptr GlyphString -> IO GlyphString
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GlyphString -> GlyphString
Pango.GlyphString.GlyphString) Ptr GlyphString
val'
        GlyphString -> IO GlyphString
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphString
val''
    Maybe GlyphString -> IO (Maybe GlyphString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphString
result

-- | Set the value of the “@glyphs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' glyphItem [ #glyphs 'Data.GI.Base.Attributes.:=' value ]
-- @
setGlyphItemGlyphs :: MonadIO m => GlyphItem -> Ptr Pango.GlyphString.GlyphString -> m ()
setGlyphItemGlyphs :: GlyphItem -> Ptr GlyphString -> m ()
setGlyphItemGlyphs GlyphItem
s Ptr GlyphString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GlyphItem -> (Ptr GlyphItem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO ()) -> IO ())
-> (Ptr GlyphItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr (Ptr GlyphString) -> Ptr GlyphString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr GlyphString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr GlyphString
val :: Ptr Pango.GlyphString.GlyphString)

-- | Set the value of the “@glyphs@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #glyphs
-- @
clearGlyphItemGlyphs :: MonadIO m => GlyphItem -> m ()
clearGlyphItemGlyphs :: GlyphItem -> m ()
clearGlyphItemGlyphs GlyphItem
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GlyphItem -> (Ptr GlyphItem -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphItem
s ((Ptr GlyphItem -> IO ()) -> IO ())
-> (Ptr GlyphItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
ptr -> do
    Ptr (Ptr GlyphString) -> Ptr GlyphString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr GlyphItem
ptr Ptr GlyphItem -> Int -> Ptr (Ptr GlyphString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr GlyphString
forall a. Ptr a
FP.nullPtr :: Ptr Pango.GlyphString.GlyphString)

#if defined(ENABLE_OVERLOADING)
data GlyphItemGlyphsFieldInfo
instance AttrInfo GlyphItemGlyphsFieldInfo where
    type AttrBaseTypeConstraint GlyphItemGlyphsFieldInfo = (~) GlyphItem
    type AttrAllowedOps GlyphItemGlyphsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint GlyphItemGlyphsFieldInfo = (~) (Ptr Pango.GlyphString.GlyphString)
    type AttrTransferTypeConstraint GlyphItemGlyphsFieldInfo = (~)(Ptr Pango.GlyphString.GlyphString)
    type AttrTransferType GlyphItemGlyphsFieldInfo = (Ptr Pango.GlyphString.GlyphString)
    type AttrGetType GlyphItemGlyphsFieldInfo = Maybe Pango.GlyphString.GlyphString
    type AttrLabel GlyphItemGlyphsFieldInfo = "glyphs"
    type AttrOrigin GlyphItemGlyphsFieldInfo = GlyphItem
    attrGet = getGlyphItemGlyphs
    attrSet = setGlyphItemGlyphs
    attrConstruct = undefined
    attrClear = clearGlyphItemGlyphs
    attrTransfer _ v = do
        return v

glyphItem_glyphs :: AttrLabelProxy "glyphs"
glyphItem_glyphs = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList GlyphItem
type instance O.AttributeList GlyphItem = GlyphItemAttributeList
type GlyphItemAttributeList = ('[ '("item", GlyphItemItemFieldInfo), '("glyphs", GlyphItemGlyphsFieldInfo)] :: [(Symbol, *)])
#endif

-- method GlyphItem::apply_attrs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyph_item"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a shaped item" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text that @list applies to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "Pango" , name = "GlyphItem" }))
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_apply_attrs" pango_glyph_item_apply_attrs :: 
    Ptr GlyphItem ->                        -- glyph_item : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    CString ->                              -- text : TBasicType TUTF8
    Ptr Pango.AttrList.AttrList ->          -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO (Ptr (GSList (Ptr GlyphItem)))

-- | Splits a shaped item (PangoGlyphItem) into multiple items based
-- on an attribute list. The idea is that if you have attributes
-- that don\'t affect shaping, such as color or underline, to avoid
-- affecting shaping, you filter them out ('GI.Pango.Structs.AttrList.attrListFilter'),
-- apply the shaping process and then reapply them to the result using
-- this function.
-- 
-- All attributes that start or end inside a cluster are applied
-- to that cluster; for instance, if half of a cluster is underlined
-- and the other-half strikethrough, then the cluster will end
-- up with both underline and strikethrough attributes. In these
-- cases, it may happen that item->extra_attrs for some of the
-- result items can have multiple attributes of the same type.
-- 
-- This function takes ownership of /@glyphItem@/; it will be reused
-- as one of the elements in the list.
-- 
-- /Since: 1.2/
glyphItemApplyAttrs ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@glyphItem@/: a shaped item
    -> T.Text
    -- ^ /@text@/: text that /@list@/ applies to
    -> Pango.AttrList.AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> m [GlyphItem]
    -- ^ __Returns:__ a
    --   list of glyph items resulting from splitting /@glyphItem@/. Free
    --   the elements using 'GI.Pango.Structs.GlyphItem.glyphItemFree', the list using
    --   @/g_slist_free()/@.
glyphItemApplyAttrs :: GlyphItem -> Text -> AttrList -> m [GlyphItem]
glyphItemApplyAttrs GlyphItem
glyphItem Text
text AttrList
list = IO [GlyphItem] -> m [GlyphItem]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GlyphItem] -> m [GlyphItem])
-> IO [GlyphItem] -> m [GlyphItem]
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
glyphItem' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
glyphItem
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr (GSList (Ptr GlyphItem))
result <- Ptr GlyphItem
-> CString -> Ptr AttrList -> IO (Ptr (GSList (Ptr GlyphItem)))
pango_glyph_item_apply_attrs Ptr GlyphItem
glyphItem' CString
text' Ptr AttrList
list'
    [Ptr GlyphItem]
result' <- Ptr (GSList (Ptr GlyphItem)) -> IO [Ptr GlyphItem]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr GlyphItem))
result
    [GlyphItem]
result'' <- (Ptr GlyphItem -> IO GlyphItem)
-> [Ptr GlyphItem] -> IO [GlyphItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr GlyphItem -> GlyphItem)
-> Ptr GlyphItem -> IO GlyphItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphItem -> GlyphItem
GlyphItem) [Ptr GlyphItem]
result'
    Ptr (GSList (Ptr GlyphItem)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr GlyphItem))
result
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
glyphItem
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    [GlyphItem] -> IO [GlyphItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [GlyphItem]
result''

#if defined(ENABLE_OVERLOADING)
data GlyphItemApplyAttrsMethodInfo
instance (signature ~ (T.Text -> Pango.AttrList.AttrList -> m [GlyphItem]), MonadIO m) => O.MethodInfo GlyphItemApplyAttrsMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemApplyAttrs

#endif

-- method GlyphItem::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "orig"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphItem, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "GlyphItem" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_copy" pango_glyph_item_copy :: 
    Ptr GlyphItem ->                        -- orig : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    IO (Ptr GlyphItem)

-- | Make a deep copy of an existing t'GI.Pango.Structs.GlyphItem.GlyphItem' structure.
-- 
-- /Since: 1.20/
glyphItemCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@orig@/: a t'GI.Pango.Structs.GlyphItem.GlyphItem', may be 'P.Nothing'
    -> m (Maybe GlyphItem)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.GlyphItem.GlyphItem', which should
    --               be freed with 'GI.Pango.Structs.GlyphItem.glyphItemFree', or 'P.Nothing'
    --               if /@orig@/ was 'P.Nothing'.
glyphItemCopy :: GlyphItem -> m (Maybe GlyphItem)
glyphItemCopy GlyphItem
orig = IO (Maybe GlyphItem) -> m (Maybe GlyphItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GlyphItem) -> m (Maybe GlyphItem))
-> IO (Maybe GlyphItem) -> m (Maybe GlyphItem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
orig' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
orig
    Ptr GlyphItem
result <- Ptr GlyphItem -> IO (Ptr GlyphItem)
pango_glyph_item_copy Ptr GlyphItem
orig'
    Maybe GlyphItem
maybeResult <- Ptr GlyphItem
-> (Ptr GlyphItem -> IO GlyphItem) -> IO (Maybe GlyphItem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GlyphItem
result ((Ptr GlyphItem -> IO GlyphItem) -> IO (Maybe GlyphItem))
-> (Ptr GlyphItem -> IO GlyphItem) -> IO (Maybe GlyphItem)
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphItem
result' -> do
        GlyphItem
result'' <- ((ManagedPtr GlyphItem -> GlyphItem)
-> Ptr GlyphItem -> IO GlyphItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphItem -> GlyphItem
GlyphItem) Ptr GlyphItem
result'
        GlyphItem -> IO GlyphItem
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphItem
result''
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
orig
    Maybe GlyphItem -> IO (Maybe GlyphItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data GlyphItemCopyMethodInfo
instance (signature ~ (m (Maybe GlyphItem)), MonadIO m) => O.MethodInfo GlyphItemCopyMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemCopy

#endif

-- method GlyphItem::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyph_item"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphItem, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_free" pango_glyph_item_free :: 
    Ptr GlyphItem ->                        -- glyph_item : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    IO ()

-- | Frees a t'GI.Pango.Structs.GlyphItem.GlyphItem' and resources to which it points.
-- 
-- /Since: 1.6/
glyphItemFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@glyphItem@/: a t'GI.Pango.Structs.GlyphItem.GlyphItem', may be 'P.Nothing'
    -> m ()
glyphItemFree :: GlyphItem -> m ()
glyphItemFree GlyphItem
glyphItem = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
glyphItem' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
glyphItem
    Ptr GlyphItem -> IO ()
pango_glyph_item_free Ptr GlyphItem
glyphItem'
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
glyphItem
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GlyphItemFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo GlyphItemFreeMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemFree

#endif

-- method GlyphItem::get_logical_widths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyph_item"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphItem" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "text that @glyph_item corresponds to\n  (glyph_item->item->offset is an offset from the\n   start of @text)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_widths"
--           , argType = TCArray False (-1) (-1) (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an array whose length is the number of\n                 characters in glyph_item (equal to\n                 glyph_item->item->num_chars) to be filled in with\n                 the resulting character widths."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_get_logical_widths" pango_glyph_item_get_logical_widths :: 
    Ptr GlyphItem ->                        -- glyph_item : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    CString ->                              -- text : TBasicType TUTF8
    Ptr Int32 ->                            -- logical_widths : TCArray False (-1) (-1) (TBasicType TInt)
    IO ()

-- | Given a t'GI.Pango.Structs.GlyphItem.GlyphItem' and the corresponding
-- text, determine the screen width corresponding to each character. When
-- multiple characters compose a single cluster, the width of the entire
-- cluster is divided equally among the characters.
-- 
-- See also 'GI.Pango.Structs.GlyphString.glyphStringGetLogicalWidths'.
-- 
-- /Since: 1.26/
glyphItemGetLogicalWidths ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@glyphItem@/: a t'GI.Pango.Structs.GlyphItem.GlyphItem'
    -> T.Text
    -- ^ /@text@/: text that /@glyphItem@/ corresponds to
    --   (glyph_item->item->offset is an offset from the
    --    start of /@text@/)
    -> [Int32]
    -- ^ /@logicalWidths@/: an array whose length is the number of
    --                  characters in glyph_item (equal to
    --                  glyph_item->item->num_chars) to be filled in with
    --                  the resulting character widths.
    -> m ()
glyphItemGetLogicalWidths :: GlyphItem -> Text -> [Int32] -> m ()
glyphItemGetLogicalWidths GlyphItem
glyphItem Text
text [Int32]
logicalWidths = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
glyphItem' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
glyphItem
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr Int32
logicalWidths' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
logicalWidths
    Ptr GlyphItem -> CString -> Ptr Int32 -> IO ()
pango_glyph_item_get_logical_widths Ptr GlyphItem
glyphItem' CString
text' Ptr Int32
logicalWidths'
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
glyphItem
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
logicalWidths'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GlyphItemGetLogicalWidthsMethodInfo
instance (signature ~ (T.Text -> [Int32] -> m ()), MonadIO m) => O.MethodInfo GlyphItemGetLogicalWidthsMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemGetLogicalWidths

#endif

-- method GlyphItem::letter_space
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyph_item"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphItem" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "text that @glyph_item corresponds to\n  (glyph_item->item->offset is an offset from the\n   start of @text)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "log_attrs"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "Pango" , name = "LogAttr" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "logical attributes for the item\n  (the first logical attribute refers to the position\n  before the first character in the item)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "letter_spacing"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "amount of letter spacing to add\n  in Pango units. May be negative, though too large\n  negative values will give ugly results."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_letter_space" pango_glyph_item_letter_space :: 
    Ptr GlyphItem ->                        -- glyph_item : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    CString ->                              -- text : TBasicType TUTF8
    Ptr Pango.LogAttr.LogAttr ->            -- log_attrs : TCArray False (-1) (-1) (TInterface (Name {namespace = "Pango", name = "LogAttr"}))
    Int32 ->                                -- letter_spacing : TBasicType TInt
    IO ()

-- | Adds spacing between the graphemes of /@glyphItem@/ to
-- give the effect of typographic letter spacing.
-- 
-- /Since: 1.6/
glyphItemLetterSpace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@glyphItem@/: a t'GI.Pango.Structs.GlyphItem.GlyphItem'
    -> T.Text
    -- ^ /@text@/: text that /@glyphItem@/ corresponds to
    --   (glyph_item->item->offset is an offset from the
    --    start of /@text@/)
    -> [Pango.LogAttr.LogAttr]
    -- ^ /@logAttrs@/: logical attributes for the item
    --   (the first logical attribute refers to the position
    --   before the first character in the item)
    -> Int32
    -- ^ /@letterSpacing@/: amount of letter spacing to add
    --   in Pango units. May be negative, though too large
    --   negative values will give ugly results.
    -> m ()
glyphItemLetterSpace :: GlyphItem -> Text -> [LogAttr] -> Int32 -> m ()
glyphItemLetterSpace GlyphItem
glyphItem Text
text [LogAttr]
logAttrs Int32
letterSpacing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
glyphItem' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
glyphItem
    CString
text' <- Text -> IO CString
textToCString Text
text
    [Ptr LogAttr]
logAttrs' <- (LogAttr -> IO (Ptr LogAttr)) -> [LogAttr] -> IO [Ptr LogAttr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LogAttr -> IO (Ptr LogAttr)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [LogAttr]
logAttrs
    Ptr LogAttr
logAttrs'' <- Int -> [Ptr LogAttr] -> IO (Ptr LogAttr)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
52 [Ptr LogAttr]
logAttrs'
    Ptr GlyphItem -> CString -> Ptr LogAttr -> Int32 -> IO ()
pango_glyph_item_letter_space Ptr GlyphItem
glyphItem' CString
text' Ptr LogAttr
logAttrs'' Int32
letterSpacing
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
glyphItem
    (LogAttr -> IO ()) -> [LogAttr] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogAttr -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [LogAttr]
logAttrs
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr LogAttr -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr LogAttr
logAttrs''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GlyphItemLetterSpaceMethodInfo
instance (signature ~ (T.Text -> [Pango.LogAttr.LogAttr] -> Int32 -> m ()), MonadIO m) => O.MethodInfo GlyphItemLetterSpaceMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemLetterSpace

#endif

-- method GlyphItem::split
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "orig"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoItem" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text to which positions in @orig apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "split_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "byte index of position to split item, relative to the start of the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "GlyphItem" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_item_split" pango_glyph_item_split :: 
    Ptr GlyphItem ->                        -- orig : TInterface (Name {namespace = "Pango", name = "GlyphItem"})
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- split_index : TBasicType TInt
    IO (Ptr GlyphItem)

-- | Modifies /@orig@/ to cover only the text after /@splitIndex@/, and
-- returns a new item that covers the text before /@splitIndex@/ that
-- used to be in /@orig@/. You can think of /@splitIndex@/ as the length of
-- the returned item. /@splitIndex@/ may not be 0, and it may not be
-- greater than or equal to the length of /@orig@/ (that is, there must
-- be at least one byte assigned to each item, you can\'t create a
-- zero-length item).
-- 
-- This function is similar in function to 'GI.Pango.Structs.Item.itemSplit' (and uses
-- it internally.)
-- 
-- /Since: 1.2/
glyphItemSplit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphItem
    -- ^ /@orig@/: a t'GI.Pango.Structs.Item.Item'
    -> T.Text
    -- ^ /@text@/: text to which positions in /@orig@/ apply
    -> Int32
    -- ^ /@splitIndex@/: byte index of position to split item, relative to the start of the item
    -> m GlyphItem
    -- ^ __Returns:__ the newly allocated item representing text before
    --               /@splitIndex@/, which should be freed
    --               with 'GI.Pango.Structs.GlyphItem.glyphItemFree'.
glyphItemSplit :: GlyphItem -> Text -> Int32 -> m GlyphItem
glyphItemSplit GlyphItem
orig Text
text Int32
splitIndex = IO GlyphItem -> m GlyphItem
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlyphItem -> m GlyphItem) -> IO GlyphItem -> m GlyphItem
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphItem
orig' <- GlyphItem -> IO (Ptr GlyphItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphItem
orig
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr GlyphItem
result <- Ptr GlyphItem -> CString -> Int32 -> IO (Ptr GlyphItem)
pango_glyph_item_split Ptr GlyphItem
orig' CString
text' Int32
splitIndex
    Text -> Ptr GlyphItem -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"glyphItemSplit" Ptr GlyphItem
result
    GlyphItem
result' <- ((ManagedPtr GlyphItem -> GlyphItem)
-> Ptr GlyphItem -> IO GlyphItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphItem -> GlyphItem
GlyphItem) Ptr GlyphItem
result
    GlyphItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphItem
orig
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    GlyphItem -> IO GlyphItem
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphItem
result'

#if defined(ENABLE_OVERLOADING)
data GlyphItemSplitMethodInfo
instance (signature ~ (T.Text -> Int32 -> m GlyphItem), MonadIO m) => O.MethodInfo GlyphItemSplitMethodInfo GlyphItem signature where
    overloadedMethod = glyphItemSplit

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveGlyphItemMethod (t :: Symbol) (o :: *) :: * where
    ResolveGlyphItemMethod "applyAttrs" o = GlyphItemApplyAttrsMethodInfo
    ResolveGlyphItemMethod "copy" o = GlyphItemCopyMethodInfo
    ResolveGlyphItemMethod "free" o = GlyphItemFreeMethodInfo
    ResolveGlyphItemMethod "letterSpace" o = GlyphItemLetterSpaceMethodInfo
    ResolveGlyphItemMethod "split" o = GlyphItemSplitMethodInfo
    ResolveGlyphItemMethod "getLogicalWidths" o = GlyphItemGetLogicalWidthsMethodInfo
    ResolveGlyphItemMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveGlyphItemMethod t GlyphItem, O.MethodInfo info GlyphItem p) => OL.IsLabel t (GlyphItem -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif