{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @PangoLayoutIter@ can be used to iterate over the visual
-- extents of a @PangoLayout@.
-- 
-- To obtain a @PangoLayoutIter@, use 'GI.Pango.Objects.Layout.layoutGetIter'.
-- 
-- The @PangoLayoutIter@ structure is opaque, and has no user-visible fields.

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

module GI.Pango.Structs.LayoutIter
    ( 

-- * Exported types
    LayoutIter(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [atLastLine]("GI.Pango.Structs.LayoutIter#g:method:atLastLine"), [copy]("GI.Pango.Structs.LayoutIter#g:method:copy"), [free]("GI.Pango.Structs.LayoutIter#g:method:free"), [nextChar]("GI.Pango.Structs.LayoutIter#g:method:nextChar"), [nextCluster]("GI.Pango.Structs.LayoutIter#g:method:nextCluster"), [nextLine]("GI.Pango.Structs.LayoutIter#g:method:nextLine"), [nextRun]("GI.Pango.Structs.LayoutIter#g:method:nextRun").
-- 
-- ==== Getters
-- [getBaseline]("GI.Pango.Structs.LayoutIter#g:method:getBaseline"), [getCharExtents]("GI.Pango.Structs.LayoutIter#g:method:getCharExtents"), [getClusterExtents]("GI.Pango.Structs.LayoutIter#g:method:getClusterExtents"), [getIndex]("GI.Pango.Structs.LayoutIter#g:method:getIndex"), [getLayout]("GI.Pango.Structs.LayoutIter#g:method:getLayout"), [getLayoutExtents]("GI.Pango.Structs.LayoutIter#g:method:getLayoutExtents"), [getLine]("GI.Pango.Structs.LayoutIter#g:method:getLine"), [getLineExtents]("GI.Pango.Structs.LayoutIter#g:method:getLineExtents"), [getLineReadonly]("GI.Pango.Structs.LayoutIter#g:method:getLineReadonly"), [getLineYrange]("GI.Pango.Structs.LayoutIter#g:method:getLineYrange"), [getRun]("GI.Pango.Structs.LayoutIter#g:method:getRun"), [getRunBaseline]("GI.Pango.Structs.LayoutIter#g:method:getRunBaseline"), [getRunExtents]("GI.Pango.Structs.LayoutIter#g:method:getRunExtents"), [getRunReadonly]("GI.Pango.Structs.LayoutIter#g:method:getRunReadonly").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveLayoutIterMethod                 ,
#endif

-- ** atLastLine #method:atLastLine#

#if defined(ENABLE_OVERLOADING)
    LayoutIterAtLastLineMethodInfo          ,
#endif
    layoutIterAtLastLine                    ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    LayoutIterCopyMethodInfo                ,
#endif
    layoutIterCopy                          ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    LayoutIterFreeMethodInfo                ,
#endif
    layoutIterFree                          ,


-- ** getBaseline #method:getBaseline#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetBaselineMethodInfo         ,
#endif
    layoutIterGetBaseline                   ,


-- ** getCharExtents #method:getCharExtents#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetCharExtentsMethodInfo      ,
#endif
    layoutIterGetCharExtents                ,


-- ** getClusterExtents #method:getClusterExtents#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetClusterExtentsMethodInfo   ,
#endif
    layoutIterGetClusterExtents             ,


-- ** getIndex #method:getIndex#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetIndexMethodInfo            ,
#endif
    layoutIterGetIndex                      ,


-- ** getLayout #method:getLayout#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLayoutMethodInfo           ,
#endif
    layoutIterGetLayout                     ,


-- ** getLayoutExtents #method:getLayoutExtents#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLayoutExtentsMethodInfo    ,
#endif
    layoutIterGetLayoutExtents              ,


-- ** getLine #method:getLine#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLineMethodInfo             ,
#endif
    layoutIterGetLine                       ,


-- ** getLineExtents #method:getLineExtents#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLineExtentsMethodInfo      ,
#endif
    layoutIterGetLineExtents                ,


-- ** getLineReadonly #method:getLineReadonly#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLineReadonlyMethodInfo     ,
#endif
    layoutIterGetLineReadonly               ,


-- ** getLineYrange #method:getLineYrange#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetLineYrangeMethodInfo       ,
#endif
    layoutIterGetLineYrange                 ,


-- ** getRun #method:getRun#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetRunMethodInfo              ,
#endif
    layoutIterGetRun                        ,


-- ** getRunBaseline #method:getRunBaseline#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetRunBaselineMethodInfo      ,
#endif
    layoutIterGetRunBaseline                ,


-- ** getRunExtents #method:getRunExtents#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetRunExtentsMethodInfo       ,
#endif
    layoutIterGetRunExtents                 ,


-- ** getRunReadonly #method:getRunReadonly#

#if defined(ENABLE_OVERLOADING)
    LayoutIterGetRunReadonlyMethodInfo      ,
#endif
    layoutIterGetRunReadonly                ,


-- ** nextChar #method:nextChar#

#if defined(ENABLE_OVERLOADING)
    LayoutIterNextCharMethodInfo            ,
#endif
    layoutIterNextChar                      ,


-- ** nextCluster #method:nextCluster#

#if defined(ENABLE_OVERLOADING)
    LayoutIterNextClusterMethodInfo         ,
#endif
    layoutIterNextCluster                   ,


-- ** nextLine #method:nextLine#

#if defined(ENABLE_OVERLOADING)
    LayoutIterNextLineMethodInfo            ,
#endif
    layoutIterNextLine                      ,


-- ** nextRun #method:nextRun#

#if defined(ENABLE_OVERLOADING)
    LayoutIterNextRunMethodInfo             ,
#endif
    layoutIterNextRun                       ,




    ) 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.GArray as B.GArray
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.Coerce as Coerce
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 qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Pango.Objects.Layout as Pango.Layout
import {-# SOURCE #-} qualified GI.Pango.Structs.GlyphItem as Pango.GlyphItem
import {-# SOURCE #-} qualified GI.Pango.Structs.LayoutLine as Pango.LayoutLine
import {-# SOURCE #-} qualified GI.Pango.Structs.Rectangle as Pango.Rectangle

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

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

foreign import ccall "pango_layout_iter_get_type" c_pango_layout_iter_get_type :: 
    IO GType

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

instance B.Types.TypedObject LayoutIter where
    glibType :: IO GType
glibType = IO GType
c_pango_layout_iter_get_type

instance B.Types.GBoxed LayoutIter

-- | Convert 'LayoutIter' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe LayoutIter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_pango_layout_iter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe LayoutIter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe LayoutIter
P.Nothing = Ptr GValue -> Ptr LayoutIter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr LayoutIter
forall a. Ptr a
FP.nullPtr :: FP.Ptr LayoutIter)
    gvalueSet_ Ptr GValue
gv (P.Just LayoutIter
obj) = LayoutIter -> (Ptr LayoutIter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr LayoutIter
obj (Ptr GValue -> Ptr LayoutIter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe LayoutIter)
gvalueGet_ Ptr GValue
gv = do
        Ptr LayoutIter
ptr <- Ptr GValue -> IO (Ptr LayoutIter)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr LayoutIter)
        if Ptr LayoutIter
ptr Ptr LayoutIter -> Ptr LayoutIter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr LayoutIter
forall a. Ptr a
FP.nullPtr
        then LayoutIter -> Maybe LayoutIter
forall a. a -> Maybe a
P.Just (LayoutIter -> Maybe LayoutIter)
-> IO LayoutIter -> IO (Maybe LayoutIter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr LayoutIter -> LayoutIter)
-> Ptr LayoutIter -> IO LayoutIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr LayoutIter -> LayoutIter
LayoutIter Ptr LayoutIter
ptr
        else Maybe LayoutIter -> IO (Maybe LayoutIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LayoutIter
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList LayoutIter
type instance O.AttributeList LayoutIter = LayoutIterAttributeList
type LayoutIterAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method LayoutIter::at_last_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_at_last_line" pango_layout_iter_at_last_line :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO CInt

-- | Determines whether /@iter@/ is on the last line of the layout.
layoutIterAtLastLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@iter@/ is on the last line
layoutIterAtLastLine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Bool
layoutIterAtLastLine LayoutIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    CInt
result <- Ptr LayoutIter -> IO CInt
pango_layout_iter_at_last_line Ptr LayoutIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterAtLastLineMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod LayoutIterAtLastLineMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterAtLastLine

instance O.OverloadedMethodInfo LayoutIterAtLastLineMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterAtLastLine",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterAtLastLine"
        })


#endif

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

foreign import ccall "pango_layout_iter_copy" pango_layout_iter_copy :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr LayoutIter)

-- | Copies a @PangoLayoutIter@.
-- 
-- /Since: 1.20/
layoutIterCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m (Maybe LayoutIter)
    -- ^ __Returns:__ the newly allocated @PangoLayoutIter@
layoutIterCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Maybe LayoutIter)
layoutIterCopy LayoutIter
iter = IO (Maybe LayoutIter) -> m (Maybe LayoutIter)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LayoutIter) -> m (Maybe LayoutIter))
-> IO (Maybe LayoutIter) -> m (Maybe LayoutIter)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr LayoutIter
result <- Ptr LayoutIter -> IO (Ptr LayoutIter)
pango_layout_iter_copy Ptr LayoutIter
iter'
    Maybe LayoutIter
maybeResult <- Ptr LayoutIter
-> (Ptr LayoutIter -> IO LayoutIter) -> IO (Maybe LayoutIter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr LayoutIter
result ((Ptr LayoutIter -> IO LayoutIter) -> IO (Maybe LayoutIter))
-> (Ptr LayoutIter -> IO LayoutIter) -> IO (Maybe LayoutIter)
forall a b. (a -> b) -> a -> b
$ \Ptr LayoutIter
result' -> do
        LayoutIter
result'' <- ((ManagedPtr LayoutIter -> LayoutIter)
-> Ptr LayoutIter -> IO LayoutIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr LayoutIter -> LayoutIter
LayoutIter) Ptr LayoutIter
result'
        LayoutIter -> IO LayoutIter
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutIter
result''
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Maybe LayoutIter -> IO (Maybe LayoutIter)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LayoutIter
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayoutIterCopyMethodInfo
instance (signature ~ (m (Maybe LayoutIter)), MonadIO m) => O.OverloadedMethod LayoutIterCopyMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterCopy

instance O.OverloadedMethodInfo LayoutIterCopyMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterCopy"
        })


#endif

-- method LayoutIter::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`, 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_layout_iter_free" pango_layout_iter_free :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO ()

-- | Frees an iterator that\'s no longer in use.
layoutIterFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@, may be 'P.Nothing'
    -> m ()
layoutIterFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m ()
layoutIterFree LayoutIter
iter = 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 LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr LayoutIter -> IO ()
pango_layout_iter_free Ptr LayoutIter
iter'
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayoutIterFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod LayoutIterFreeMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterFree

instance O.OverloadedMethodInfo LayoutIterFreeMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterFree"
        })


#endif

-- method LayoutIter::get_baseline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_baseline" pango_layout_iter_get_baseline :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO Int32

-- | Gets the Y position of the current line\'s baseline, in layout
-- coordinates.
-- 
-- Layout coordinates have the origin at the top left of the entire layout.
layoutIterGetBaseline ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Int32
    -- ^ __Returns:__ baseline of current line
layoutIterGetBaseline :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Int32
layoutIterGetBaseline LayoutIter
iter = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Int32
result <- Ptr LayoutIter -> IO Int32
pango_layout_iter_get_baseline Ptr LayoutIter
iter'
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetBaselineMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod LayoutIterGetBaselineMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetBaseline

instance O.OverloadedMethodInfo LayoutIterGetBaselineMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetBaseline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetBaseline"
        })


#endif

-- method LayoutIter::get_char_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with\n  logical extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_char_extents" pango_layout_iter_get_char_extents :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Pango.Rectangle.Rectangle ->        -- logical_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | Gets the extents of the current character, in layout coordinates.
-- 
-- Layout coordinates have the origin at the top left of the entire layout.
-- 
-- Only logical extents can sensibly be obtained for characters;
-- ink extents make sense only down to the level of clusters.
layoutIterGetCharExtents ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m (Pango.Rectangle.Rectangle)
layoutIterGetCharExtents :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Rectangle
layoutIterGetCharExtents LayoutIter
iter = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Rectangle
logicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr LayoutIter -> Ptr Rectangle -> IO ()
pango_layout_iter_get_char_extents Ptr LayoutIter
iter' Ptr Rectangle
logicalRect
    Rectangle
logicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
logicalRect
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
logicalRect'

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetCharExtentsMethodInfo
instance (signature ~ (m (Pango.Rectangle.Rectangle)), MonadIO m) => O.OverloadedMethod LayoutIterGetCharExtentsMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetCharExtents

instance O.OverloadedMethodInfo LayoutIterGetCharExtentsMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetCharExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetCharExtents"
        })


#endif

-- method LayoutIter::get_cluster_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ink_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with ink extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with logical extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_cluster_extents" pango_layout_iter_get_cluster_extents :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Pango.Rectangle.Rectangle ->        -- ink_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    Ptr Pango.Rectangle.Rectangle ->        -- logical_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | Gets the extents of the current cluster, in layout coordinates.
-- 
-- Layout coordinates have the origin at the top left of the entire layout.
layoutIterGetClusterExtents ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
layoutIterGetClusterExtents :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Rectangle, Rectangle)
layoutIterGetClusterExtents LayoutIter
iter = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Rectangle
inkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr Rectangle
logicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr LayoutIter -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_layout_iter_get_cluster_extents Ptr LayoutIter
iter' Ptr Rectangle
inkRect Ptr Rectangle
logicalRect
    Rectangle
inkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
inkRect
    Rectangle
logicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
logicalRect
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetClusterExtentsMethodInfo
instance (signature ~ (m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m) => O.OverloadedMethod LayoutIterGetClusterExtentsMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetClusterExtents

instance O.OverloadedMethodInfo LayoutIterGetClusterExtentsMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetClusterExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetClusterExtents"
        })


#endif

-- method LayoutIter::get_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_index" pango_layout_iter_get_index :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO Int32

-- | Gets the current byte index.
-- 
-- Note that iterating forward by char moves in visual order,
-- not logical order, so indexes may not be sequential. Also,
-- the index may be equal to the length of the text in the
-- layout, if on the 'P.Nothing' run (see 'GI.Pango.Structs.LayoutIter.layoutIterGetRun').
layoutIterGetIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Int32
    -- ^ __Returns:__ current byte index
layoutIterGetIndex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Int32
layoutIterGetIndex LayoutIter
iter = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Int32
result <- Ptr LayoutIter -> IO Int32
pango_layout_iter_get_index Ptr LayoutIter
iter'
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetIndexMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod LayoutIterGetIndexMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetIndex

instance O.OverloadedMethodInfo LayoutIterGetIndexMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetIndex"
        })


#endif

-- method LayoutIter::get_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Layout" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_layout" pango_layout_iter_get_layout :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr Pango.Layout.Layout)

-- | Gets the layout associated with a @PangoLayoutIter@.
-- 
-- /Since: 1.20/
layoutIterGetLayout ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Pango.Layout.Layout
    -- ^ __Returns:__ the layout associated with /@iter@/
layoutIterGetLayout :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Layout
layoutIterGetLayout LayoutIter
iter = IO Layout -> m Layout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Layout -> m Layout) -> IO Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Layout
result <- Ptr LayoutIter -> IO (Ptr Layout)
pango_layout_iter_get_layout Ptr LayoutIter
iter'
    Text -> Ptr Layout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutIterGetLayout" Ptr Layout
result
    Layout
result' <- ((ManagedPtr Layout -> Layout) -> Ptr Layout -> IO Layout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Layout -> Layout
Pango.Layout.Layout) Ptr Layout
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Layout -> IO Layout
forall (m :: * -> *) a. Monad m => a -> m a
return Layout
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLayoutMethodInfo
instance (signature ~ (m Pango.Layout.Layout), MonadIO m) => O.OverloadedMethod LayoutIterGetLayoutMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLayout

instance O.OverloadedMethodInfo LayoutIterGetLayoutMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLayout"
        })


#endif

-- method LayoutIter::get_layout_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ink_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with ink extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with logical extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_layout_extents" pango_layout_iter_get_layout_extents :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Pango.Rectangle.Rectangle ->        -- ink_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    Ptr Pango.Rectangle.Rectangle ->        -- logical_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | Obtains the extents of the @PangoLayout@ being iterated over.
layoutIterGetLayoutExtents ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
layoutIterGetLayoutExtents :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Rectangle, Rectangle)
layoutIterGetLayoutExtents LayoutIter
iter = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Rectangle
inkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr Rectangle
logicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr LayoutIter -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_layout_iter_get_layout_extents Ptr LayoutIter
iter' Ptr Rectangle
inkRect Ptr Rectangle
logicalRect
    Rectangle
inkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
inkRect
    Rectangle
logicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
logicalRect
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLayoutExtentsMethodInfo
instance (signature ~ (m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m) => O.OverloadedMethod LayoutIterGetLayoutExtentsMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLayoutExtents

instance O.OverloadedMethodInfo LayoutIterGetLayoutExtentsMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLayoutExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLayoutExtents"
        })


#endif

-- method LayoutIter::get_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "LayoutLine" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_line" pango_layout_iter_get_line :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr Pango.LayoutLine.LayoutLine)

-- | Gets the current line.
-- 
-- Use the faster 'GI.Pango.Structs.LayoutIter.layoutIterGetLineReadonly' if
-- you do not plan to modify the contents of the line (glyphs,
-- glyph widths, etc.).
layoutIterGetLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Pango.LayoutLine.LayoutLine
    -- ^ __Returns:__ the current line
layoutIterGetLine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m LayoutLine
layoutIterGetLine LayoutIter
iter = IO LayoutLine -> m LayoutLine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LayoutLine -> m LayoutLine) -> IO LayoutLine -> m LayoutLine
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr LayoutLine
result <- Ptr LayoutIter -> IO (Ptr LayoutLine)
pango_layout_iter_get_line Ptr LayoutIter
iter'
    Text -> Ptr LayoutLine -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutIterGetLine" Ptr LayoutLine
result
    LayoutLine
result' <- ((ManagedPtr LayoutLine -> LayoutLine)
-> Ptr LayoutLine -> IO LayoutLine
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr LayoutLine -> LayoutLine
Pango.LayoutLine.LayoutLine) Ptr LayoutLine
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    LayoutLine -> IO LayoutLine
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutLine
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLineMethodInfo
instance (signature ~ (m Pango.LayoutLine.LayoutLine), MonadIO m) => O.OverloadedMethod LayoutIterGetLineMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLine

instance O.OverloadedMethodInfo LayoutIterGetLineMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLine",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLine"
        })


#endif

-- method LayoutIter::get_line_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ink_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with ink extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with logical extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_line_extents" pango_layout_iter_get_line_extents :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Pango.Rectangle.Rectangle ->        -- ink_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    Ptr Pango.Rectangle.Rectangle ->        -- logical_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | Obtains the extents of the current line.
-- 
-- Extents are in layout coordinates (origin is the top-left corner
-- of the entire @PangoLayout@). Thus the extents returned by this
-- function will be the same width\/height but not at the same x\/y
-- as the extents returned from 'GI.Pango.Structs.LayoutLine.layoutLineGetExtents'.
layoutIterGetLineExtents ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
layoutIterGetLineExtents :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Rectangle, Rectangle)
layoutIterGetLineExtents LayoutIter
iter = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Rectangle
inkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr Rectangle
logicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr LayoutIter -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_layout_iter_get_line_extents Ptr LayoutIter
iter' Ptr Rectangle
inkRect Ptr Rectangle
logicalRect
    Rectangle
inkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
inkRect
    Rectangle
logicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
logicalRect
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLineExtentsMethodInfo
instance (signature ~ (m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m) => O.OverloadedMethod LayoutIterGetLineExtentsMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLineExtents

instance O.OverloadedMethodInfo LayoutIterGetLineExtentsMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLineExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLineExtents"
        })


#endif

-- method LayoutIter::get_line_readonly
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "LayoutLine" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_line_readonly" pango_layout_iter_get_line_readonly :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr Pango.LayoutLine.LayoutLine)

-- | Gets the current line for read-only access.
-- 
-- This is a faster alternative to 'GI.Pango.Structs.LayoutIter.layoutIterGetLine',
-- but the user is not expected to modify the contents of the line
-- (glyphs, glyph widths, etc.).
-- 
-- /Since: 1.16/
layoutIterGetLineReadonly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Pango.LayoutLine.LayoutLine
    -- ^ __Returns:__ the current line, that should not be
    --   modified
layoutIterGetLineReadonly :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m LayoutLine
layoutIterGetLineReadonly LayoutIter
iter = IO LayoutLine -> m LayoutLine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LayoutLine -> m LayoutLine) -> IO LayoutLine -> m LayoutLine
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr LayoutLine
result <- Ptr LayoutIter -> IO (Ptr LayoutLine)
pango_layout_iter_get_line_readonly Ptr LayoutIter
iter'
    Text -> Ptr LayoutLine -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutIterGetLineReadonly" Ptr LayoutLine
result
    LayoutLine
result' <- ((ManagedPtr LayoutLine -> LayoutLine)
-> Ptr LayoutLine -> IO LayoutLine
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr LayoutLine -> LayoutLine
Pango.LayoutLine.LayoutLine) Ptr LayoutLine
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    LayoutLine -> IO LayoutLine
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutLine
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLineReadonlyMethodInfo
instance (signature ~ (m Pango.LayoutLine.LayoutLine), MonadIO m) => O.OverloadedMethod LayoutIterGetLineReadonlyMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLineReadonly

instance O.OverloadedMethodInfo LayoutIterGetLineReadonlyMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLineReadonly",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLineReadonly"
        })


#endif

-- method LayoutIter::get_line_yrange
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y0_"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of line" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y1_"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "end of line" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_line_yrange" pango_layout_iter_get_line_yrange :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Int32 ->                            -- y0_ : TBasicType TInt
    Ptr Int32 ->                            -- y1_ : TBasicType TInt
    IO ()

-- | Divides the vertical space in the @PangoLayout@ being iterated over
-- between the lines in the layout, and returns the space belonging to
-- the current line.
-- 
-- A line\'s range includes the line\'s logical extents. plus half of the
-- spacing above and below the line, if 'GI.Pango.Objects.Layout.layoutSetSpacing'
-- has been called to set layout spacing. The Y positions are in layout
-- coordinates (origin at top left of the entire layout).
-- 
-- Note: Since 1.44, Pango uses line heights for placing lines, and there
-- may be gaps between the ranges returned by this function.
layoutIterGetLineYrange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m ((Int32, Int32))
layoutIterGetLineYrange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Int32, Int32)
layoutIterGetLineYrange LayoutIter
iter = IO (Int32, Int32) -> m (Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Int32
y0_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
y1_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr LayoutIter -> Ptr Int32 -> Ptr Int32 -> IO ()
pango_layout_iter_get_line_yrange Ptr LayoutIter
iter' Ptr Int32
y0_ Ptr Int32
y1_
    Int32
y0_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y0_
    Int32
y1_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y1_
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
y0_
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
y1_
    (Int32, Int32) -> IO (Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
y0_', Int32
y1_')

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetLineYrangeMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m) => O.OverloadedMethod LayoutIterGetLineYrangeMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetLineYrange

instance O.OverloadedMethodInfo LayoutIterGetLineYrangeMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetLineYrange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetLineYrange"
        })


#endif

-- method LayoutIter::get_run
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , 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_layout_iter_get_run" pango_layout_iter_get_run :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr Pango.GlyphItem.GlyphItem)

-- | Gets the current run.
-- 
-- When iterating by run, at the end of each line, there\'s a position
-- with a 'P.Nothing' run, so this function can return 'P.Nothing'. The 'P.Nothing' run
-- at the end of each line ensures that all lines have at least one run,
-- even lines consisting of only a newline.
-- 
-- Use the faster 'GI.Pango.Structs.LayoutIter.layoutIterGetRunReadonly' if you do not
-- plan to modify the contents of the run (glyphs, glyph widths, etc.).
layoutIterGetRun ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m (Maybe Pango.GlyphItem.GlyphItem)
    -- ^ __Returns:__ the current run
layoutIterGetRun :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Maybe GlyphItem)
layoutIterGetRun LayoutIter
iter = 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 LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr GlyphItem
result <- Ptr LayoutIter -> IO (Ptr GlyphItem)
pango_layout_iter_get_run Ptr LayoutIter
iter'
    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
newBoxed ManagedPtr GlyphItem -> GlyphItem
Pango.GlyphItem.GlyphItem) Ptr GlyphItem
result'
        GlyphItem -> IO GlyphItem
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphItem
result''
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Maybe GlyphItem -> IO (Maybe GlyphItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetRunMethodInfo
instance (signature ~ (m (Maybe Pango.GlyphItem.GlyphItem)), MonadIO m) => O.OverloadedMethod LayoutIterGetRunMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetRun

instance O.OverloadedMethodInfo LayoutIterGetRunMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetRun",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetRun"
        })


#endif

-- method LayoutIter::get_run_baseline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_run_baseline" pango_layout_iter_get_run_baseline :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO Int32

-- | Gets the Y position of the current run\'s baseline, in layout
-- coordinates.
-- 
-- Layout coordinates have the origin at the top left of the entire layout.
-- 
-- The run baseline can be different from the line baseline, for
-- example due to superscript or subscript positioning.
-- 
-- /Since: 1.50/
layoutIterGetRunBaseline ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Int32
layoutIterGetRunBaseline :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Int32
layoutIterGetRunBaseline LayoutIter
iter = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Int32
result <- Ptr LayoutIter -> IO Int32
pango_layout_iter_get_run_baseline Ptr LayoutIter
iter'
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetRunBaselineMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod LayoutIterGetRunBaselineMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetRunBaseline

instance O.OverloadedMethodInfo LayoutIterGetRunBaselineMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetRunBaseline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetRunBaseline"
        })


#endif

-- method LayoutIter::get_run_extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ink_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with ink extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "logical_rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle to fill with logical extents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_get_run_extents" pango_layout_iter_get_run_extents :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    Ptr Pango.Rectangle.Rectangle ->        -- ink_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    Ptr Pango.Rectangle.Rectangle ->        -- logical_rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | Gets the extents of the current run in layout coordinates.
-- 
-- Layout coordinates have the origin at the top left of the entire layout.
layoutIterGetRunExtents ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
layoutIterGetRunExtents :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Rectangle, Rectangle)
layoutIterGetRunExtents LayoutIter
iter = IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> m (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr Rectangle
inkRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr Rectangle
logicalRect <- Int -> IO (Ptr Rectangle)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
16 :: IO (Ptr Pango.Rectangle.Rectangle)
    Ptr LayoutIter -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_layout_iter_get_run_extents Ptr LayoutIter
iter' Ptr Rectangle
inkRect Ptr Rectangle
logicalRect
    Rectangle
inkRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
inkRect
    Rectangle
logicalRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Rectangle -> Rectangle
Pango.Rectangle.Rectangle) Ptr Rectangle
logicalRect
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetRunExtentsMethodInfo
instance (signature ~ (m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m) => O.OverloadedMethod LayoutIterGetRunExtentsMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetRunExtents

instance O.OverloadedMethodInfo LayoutIterGetRunExtentsMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetRunExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetRunExtents"
        })


#endif

-- method LayoutIter::get_run_readonly
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , 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_layout_iter_get_run_readonly" pango_layout_iter_get_run_readonly :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO (Ptr Pango.GlyphItem.GlyphItem)

-- | Gets the current run for read-only access.
-- 
-- When iterating by run, at the end of each line, there\'s a position
-- with a 'P.Nothing' run, so this function can return 'P.Nothing'. The 'P.Nothing' run
-- at the end of each line ensures that all lines have at least one run,
-- even lines consisting of only a newline.
-- 
-- This is a faster alternative to 'GI.Pango.Structs.LayoutIter.layoutIterGetRun',
-- but the user is not expected to modify the contents of the run (glyphs,
-- glyph widths, etc.).
-- 
-- /Since: 1.16/
layoutIterGetRunReadonly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m (Maybe Pango.GlyphItem.GlyphItem)
    -- ^ __Returns:__ the current run, that
    --   should not be modified
layoutIterGetRunReadonly :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m (Maybe GlyphItem)
layoutIterGetRunReadonly LayoutIter
iter = 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 LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    Ptr GlyphItem
result <- Ptr LayoutIter -> IO (Ptr GlyphItem)
pango_layout_iter_get_run_readonly Ptr LayoutIter
iter'
    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
newBoxed ManagedPtr GlyphItem -> GlyphItem
Pango.GlyphItem.GlyphItem) Ptr GlyphItem
result'
        GlyphItem -> IO GlyphItem
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphItem
result''
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Maybe GlyphItem -> IO (Maybe GlyphItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayoutIterGetRunReadonlyMethodInfo
instance (signature ~ (m (Maybe Pango.GlyphItem.GlyphItem)), MonadIO m) => O.OverloadedMethod LayoutIterGetRunReadonlyMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterGetRunReadonly

instance O.OverloadedMethodInfo LayoutIterGetRunReadonlyMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterGetRunReadonly",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterGetRunReadonly"
        })


#endif

-- method LayoutIter::next_char
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_next_char" pango_layout_iter_next_char :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO CInt

-- | Moves /@iter@/ forward to the next character in visual order.
-- 
-- If /@iter@/ was already at the end of the layout, returns 'P.False'.
layoutIterNextChar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Bool
    -- ^ __Returns:__ whether motion was possible
layoutIterNextChar :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Bool
layoutIterNextChar LayoutIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    CInt
result <- Ptr LayoutIter -> IO CInt
pango_layout_iter_next_char Ptr LayoutIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterNextCharMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod LayoutIterNextCharMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterNextChar

instance O.OverloadedMethodInfo LayoutIterNextCharMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterNextChar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterNextChar"
        })


#endif

-- method LayoutIter::next_cluster
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_next_cluster" pango_layout_iter_next_cluster :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO CInt

-- | Moves /@iter@/ forward to the next cluster in visual order.
-- 
-- If /@iter@/ was already at the end of the layout, returns 'P.False'.
layoutIterNextCluster ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Bool
    -- ^ __Returns:__ whether motion was possible
layoutIterNextCluster :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Bool
layoutIterNextCluster LayoutIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    CInt
result <- Ptr LayoutIter -> IO CInt
pango_layout_iter_next_cluster Ptr LayoutIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterNextClusterMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod LayoutIterNextClusterMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterNextCluster

instance O.OverloadedMethodInfo LayoutIterNextClusterMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterNextCluster",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterNextCluster"
        })


#endif

-- method LayoutIter::next_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_next_line" pango_layout_iter_next_line :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO CInt

-- | Moves /@iter@/ forward to the start of the next line.
-- 
-- If /@iter@/ is already on the last line, returns 'P.False'.
layoutIterNextLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Bool
    -- ^ __Returns:__ whether motion was possible
layoutIterNextLine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Bool
layoutIterNextLine LayoutIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    CInt
result <- Ptr LayoutIter -> IO CInt
pango_layout_iter_next_line Ptr LayoutIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterNextLineMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod LayoutIterNextLineMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterNextLine

instance O.OverloadedMethodInfo LayoutIterNextLineMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterNextLine",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterNextLine"
        })


#endif

-- method LayoutIter::next_run
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "LayoutIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoLayoutIter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "pango_layout_iter_next_run" pango_layout_iter_next_run :: 
    Ptr LayoutIter ->                       -- iter : TInterface (Name {namespace = "Pango", name = "LayoutIter"})
    IO CInt

-- | Moves /@iter@/ forward to the next run in visual order.
-- 
-- If /@iter@/ was already at the end of the layout, returns 'P.False'.
layoutIterNextRun ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LayoutIter
    -- ^ /@iter@/: a @PangoLayoutIter@
    -> m Bool
    -- ^ __Returns:__ whether motion was possible
layoutIterNextRun :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LayoutIter -> m Bool
layoutIterNextRun LayoutIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LayoutIter
iter' <- LayoutIter -> IO (Ptr LayoutIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LayoutIter
iter
    CInt
result <- Ptr LayoutIter -> IO CInt
pango_layout_iter_next_run Ptr LayoutIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    LayoutIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LayoutIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayoutIterNextRunMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod LayoutIterNextRunMethodInfo LayoutIter signature where
    overloadedMethod = layoutIterNextRun

instance O.OverloadedMethodInfo LayoutIterNextRunMethodInfo LayoutIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Structs.LayoutIter.layoutIterNextRun",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.26/docs/GI-Pango-Structs-LayoutIter.html#v:layoutIterNextRun"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveLayoutIterMethod (t :: Symbol) (o :: *) :: * where
    ResolveLayoutIterMethod "atLastLine" o = LayoutIterAtLastLineMethodInfo
    ResolveLayoutIterMethod "copy" o = LayoutIterCopyMethodInfo
    ResolveLayoutIterMethod "free" o = LayoutIterFreeMethodInfo
    ResolveLayoutIterMethod "nextChar" o = LayoutIterNextCharMethodInfo
    ResolveLayoutIterMethod "nextCluster" o = LayoutIterNextClusterMethodInfo
    ResolveLayoutIterMethod "nextLine" o = LayoutIterNextLineMethodInfo
    ResolveLayoutIterMethod "nextRun" o = LayoutIterNextRunMethodInfo
    ResolveLayoutIterMethod "getBaseline" o = LayoutIterGetBaselineMethodInfo
    ResolveLayoutIterMethod "getCharExtents" o = LayoutIterGetCharExtentsMethodInfo
    ResolveLayoutIterMethod "getClusterExtents" o = LayoutIterGetClusterExtentsMethodInfo
    ResolveLayoutIterMethod "getIndex" o = LayoutIterGetIndexMethodInfo
    ResolveLayoutIterMethod "getLayout" o = LayoutIterGetLayoutMethodInfo
    ResolveLayoutIterMethod "getLayoutExtents" o = LayoutIterGetLayoutExtentsMethodInfo
    ResolveLayoutIterMethod "getLine" o = LayoutIterGetLineMethodInfo
    ResolveLayoutIterMethod "getLineExtents" o = LayoutIterGetLineExtentsMethodInfo
    ResolveLayoutIterMethod "getLineReadonly" o = LayoutIterGetLineReadonlyMethodInfo
    ResolveLayoutIterMethod "getLineYrange" o = LayoutIterGetLineYrangeMethodInfo
    ResolveLayoutIterMethod "getRun" o = LayoutIterGetRunMethodInfo
    ResolveLayoutIterMethod "getRunBaseline" o = LayoutIterGetRunBaselineMethodInfo
    ResolveLayoutIterMethod "getRunExtents" o = LayoutIterGetRunExtentsMethodInfo
    ResolveLayoutIterMethod "getRunReadonly" o = LayoutIterGetRunReadonlyMethodInfo
    ResolveLayoutIterMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveLayoutIterMethod t LayoutIter, O.OverloadedMethod info LayoutIter p, R.HasField t LayoutIter p) => R.HasField t LayoutIter p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveLayoutIterMethod t LayoutIter, O.OverloadedMethodInfo info LayoutIter) => OL.IsLabel t (O.MethodProxy info LayoutIter) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif