{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Pango.Structs.GlyphString.GlyphString' structure is used to store strings
-- of glyphs with geometry and visual attribute information.
-- The storage for the glyph information is owned
-- by the structure which simplifies memory management.

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

module GI.Pango.Structs.GlyphString
    ( 

-- * Exported types
    GlyphString(..)                         ,
    newZeroGlyphString                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveGlyphStringMethod                ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    GlyphStringCopyMethodInfo               ,
#endif
    glyphStringCopy                         ,


-- ** extents #method:extents#

#if defined(ENABLE_OVERLOADING)
    GlyphStringExtentsMethodInfo            ,
#endif
    glyphStringExtents                      ,


-- ** extentsRange #method:extentsRange#

#if defined(ENABLE_OVERLOADING)
    GlyphStringExtentsRangeMethodInfo       ,
#endif
    glyphStringExtentsRange                 ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    GlyphStringFreeMethodInfo               ,
#endif
    glyphStringFree                         ,


-- ** getLogicalWidths #method:getLogicalWidths#

#if defined(ENABLE_OVERLOADING)
    GlyphStringGetLogicalWidthsMethodInfo   ,
#endif
    glyphStringGetLogicalWidths             ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    GlyphStringGetWidthMethodInfo           ,
#endif
    glyphStringGetWidth                     ,


-- ** indexToX #method:indexToX#

#if defined(ENABLE_OVERLOADING)
    GlyphStringIndexToXMethodInfo           ,
#endif
    glyphStringIndexToX                     ,


-- ** new #method:new#

    glyphStringNew                          ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    GlyphStringSetSizeMethodInfo            ,
#endif
    glyphStringSetSize                      ,


-- ** xToIndex #method:xToIndex#

#if defined(ENABLE_OVERLOADING)
    GlyphStringXToIndexMethodInfo           ,
#endif
    glyphStringXToIndex                     ,




 -- * Properties
-- ** logClusters #attr:logClusters#
-- | logical cluster info, indexed by the byte index
--                within the text corresponding to the glyph string.

    getGlyphStringLogClusters               ,
#if defined(ENABLE_OVERLOADING)
    glyphString_logClusters                 ,
#endif
    setGlyphStringLogClusters               ,


-- ** numGlyphs #attr:numGlyphs#
-- | number of the glyphs in this glyph string.

    getGlyphStringNumGlyphs                 ,
#if defined(ENABLE_OVERLOADING)
    glyphString_numGlyphs                   ,
#endif
    setGlyphStringNumGlyphs                 ,




    ) 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.Objects.Font as Pango.Font
import {-# SOURCE #-} qualified GI.Pango.Structs.Analysis as Pango.Analysis
import {-# SOURCE #-} qualified GI.Pango.Structs.Rectangle as Pango.Rectangle

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

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

foreign import ccall "pango_glyph_string_get_type" c_pango_glyph_string_get_type :: 
    IO GType

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

instance B.Types.TypedObject GlyphString where
    glibType :: IO GType
glibType = IO GType
c_pango_glyph_string_get_type

instance B.Types.GBoxed GlyphString

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

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

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


-- | Get the value of the “@num_glyphs@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' glyphString #numGlyphs
-- @
getGlyphStringNumGlyphs :: MonadIO m => GlyphString -> m Int32
getGlyphStringNumGlyphs :: GlyphString -> m Int32
getGlyphStringNumGlyphs GlyphString
s = 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
$ GlyphString -> (Ptr GlyphString -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphString
s ((Ptr GlyphString -> IO Int32) -> IO Int32)
-> (Ptr GlyphString -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphString
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr GlyphString
ptr Ptr GlyphString -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data GlyphStringNumGlyphsFieldInfo
instance AttrInfo GlyphStringNumGlyphsFieldInfo where
    type AttrBaseTypeConstraint GlyphStringNumGlyphsFieldInfo = (~) GlyphString
    type AttrAllowedOps GlyphStringNumGlyphsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GlyphStringNumGlyphsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint GlyphStringNumGlyphsFieldInfo = (~)Int32
    type AttrTransferType GlyphStringNumGlyphsFieldInfo = Int32
    type AttrGetType GlyphStringNumGlyphsFieldInfo = Int32
    type AttrLabel GlyphStringNumGlyphsFieldInfo = "num_glyphs"
    type AttrOrigin GlyphStringNumGlyphsFieldInfo = GlyphString
    attrGet = getGlyphStringNumGlyphs
    attrSet = setGlyphStringNumGlyphs
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

glyphString_numGlyphs :: AttrLabelProxy "numGlyphs"
glyphString_numGlyphs = AttrLabelProxy

#endif


-- XXX Skipped attribute for "GlyphString:glyphs"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 0 (TInterface (Name {namespace = "Pango", name = "GlyphInfo"}))
-- | Get the value of the “@log_clusters@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' glyphString #logClusters
-- @
getGlyphStringLogClusters :: MonadIO m => GlyphString -> m Int32
getGlyphStringLogClusters :: GlyphString -> m Int32
getGlyphStringLogClusters GlyphString
s = 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
$ GlyphString -> (Ptr GlyphString -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GlyphString
s ((Ptr GlyphString -> IO Int32) -> IO Int32)
-> (Ptr GlyphString -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphString
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr GlyphString
ptr Ptr GlyphString -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

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

#if defined(ENABLE_OVERLOADING)
data GlyphStringLogClustersFieldInfo
instance AttrInfo GlyphStringLogClustersFieldInfo where
    type AttrBaseTypeConstraint GlyphStringLogClustersFieldInfo = (~) GlyphString
    type AttrAllowedOps GlyphStringLogClustersFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GlyphStringLogClustersFieldInfo = (~) Int32
    type AttrTransferTypeConstraint GlyphStringLogClustersFieldInfo = (~)Int32
    type AttrTransferType GlyphStringLogClustersFieldInfo = Int32
    type AttrGetType GlyphStringLogClustersFieldInfo = Int32
    type AttrLabel GlyphStringLogClustersFieldInfo = "log_clusters"
    type AttrOrigin GlyphStringLogClustersFieldInfo = GlyphString
    attrGet = getGlyphStringLogClusters
    attrSet = setGlyphStringLogClusters
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

glyphString_logClusters :: AttrLabelProxy "logClusters"
glyphString_logClusters = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList GlyphString
type instance O.AttributeList GlyphString = GlyphStringAttributeList
type GlyphStringAttributeList = ('[ '("numGlyphs", GlyphStringNumGlyphsFieldInfo), '("logClusters", GlyphStringLogClustersFieldInfo)] :: [(Symbol, *)])
#endif

-- method GlyphString::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "GlyphString" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_string_new" pango_glyph_string_new :: 
    IO (Ptr GlyphString)

-- | Create a new t'GI.Pango.Structs.GlyphString.GlyphString'.
glyphStringNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GlyphString
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.GlyphString.GlyphString', which
    --               should be freed with 'GI.Pango.Structs.GlyphString.glyphStringFree'.
glyphStringNew :: m GlyphString
glyphStringNew  = IO GlyphString -> m GlyphString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlyphString -> m GlyphString)
-> IO GlyphString -> m GlyphString
forall a b. (a -> b) -> a -> b
$ do
    Ptr GlyphString
result <- IO (Ptr GlyphString)
pango_glyph_string_new
    Text -> Ptr GlyphString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"glyphStringNew" Ptr GlyphString
result
    GlyphString
result' <- ((ManagedPtr GlyphString -> GlyphString)
-> Ptr GlyphString -> IO GlyphString
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphString -> GlyphString
GlyphString) Ptr GlyphString
result
    GlyphString -> IO GlyphString
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphString
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "pango_glyph_string_copy" pango_glyph_string_copy :: 
    Ptr GlyphString ->                      -- string : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    IO (Ptr GlyphString)

-- | Copy a glyph string and associated storage.
glyphStringCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@string@/: a t'GI.Pango.Structs.GlyphString.GlyphString', may be 'P.Nothing'
    -> m (Maybe GlyphString)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.GlyphString.GlyphString',
    --               which should be freed with 'GI.Pango.Structs.GlyphString.glyphStringFree',
    --               or 'P.Nothing' if /@string@/ was 'P.Nothing'.
glyphStringCopy :: GlyphString -> m (Maybe GlyphString)
glyphStringCopy GlyphString
string = 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
$ do
    Ptr GlyphString
string' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
string
    Ptr GlyphString
result <- Ptr GlyphString -> IO (Ptr GlyphString)
pango_glyph_string_copy Ptr GlyphString
string'
    Maybe GlyphString
maybeResult <- Ptr GlyphString
-> (Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GlyphString
result ((Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString))
-> (Ptr GlyphString -> IO GlyphString) -> IO (Maybe GlyphString)
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphString
result' -> do
        GlyphString
result'' <- ((ManagedPtr GlyphString -> GlyphString)
-> Ptr GlyphString -> IO GlyphString
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GlyphString -> GlyphString
GlyphString) Ptr GlyphString
result'
        GlyphString -> IO GlyphString
forall (m :: * -> *) a. Monad m => a -> m a
return GlyphString
result''
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
string
    Maybe GlyphString -> IO (Maybe GlyphString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphString
maybeResult

#if defined(ENABLE_OVERLOADING)
data GlyphStringCopyMethodInfo
instance (signature ~ (m (Maybe GlyphString)), MonadIO m) => O.MethodInfo GlyphStringCopyMethodInfo GlyphString signature where
    overloadedMethod = glyphStringCopy

#endif

-- method GlyphString::extents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "font"
--           , argType = TInterface Name { namespace = "Pango" , name = "Font" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFont" , 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 used to store the extents of the glyph string\n           as drawn or %NULL to indicate that the result is not needed."
--                 , 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 used to store the logical extents of the\n           glyph string or %NULL to indicate that the result is not needed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_string_extents" pango_glyph_string_extents :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    Ptr Pango.Font.Font ->                  -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    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 ()

-- | Compute the logical and ink extents of a glyph string. See the documentation
-- for 'GI.Pango.Objects.Font.fontGetGlyphExtents' for details about the interpretation
-- of the rectangles.
-- 
-- Examples of logical (red) and ink (green) rects:
-- 
-- <<http://developer.gnome.org/pango/stable/rects1.png>> <<http://developer.gnome.org/pango/stable/rects2.png>>
glyphStringExtents ::
    (B.CallStack.HasCallStack, MonadIO m, Pango.Font.IsFont a) =>
    GlyphString
    -- ^ /@glyphs@/: a t'GI.Pango.Structs.GlyphString.GlyphString'
    -> a
    -- ^ /@font@/: a t'GI.Pango.Objects.Font.Font'
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
glyphStringExtents :: GlyphString -> a -> m (Rectangle, Rectangle)
glyphStringExtents GlyphString
glyphs a
font = 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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    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 GlyphString
-> Ptr Font -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_glyph_string_extents Ptr GlyphString
glyphs' Ptr Font
font' 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
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data GlyphStringExtentsMethodInfo
instance (signature ~ (a -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m, Pango.Font.IsFont a) => O.MethodInfo GlyphStringExtentsMethodInfo GlyphString signature where
    overloadedMethod = glyphStringExtents

#endif

-- method GlyphString::extents_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "end index (the range is the set of bytes with\n\t      indices such that start <= index < end)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "font"
--           , argType = TInterface Name { namespace = "Pango" , name = "Font" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFont" , 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 used to\n           store the extents of the glyph string range as drawn or\n           %NULL to indicate that the result is not needed."
--                 , 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 used to\n           store the logical extents of the glyph string range or\n           %NULL to indicate that the result is not needed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_string_extents_range" pango_glyph_string_extents_range :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    Int32 ->                                -- start : TBasicType TInt
    Int32 ->                                -- end : TBasicType TInt
    Ptr Pango.Font.Font ->                  -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    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 ()

-- | Computes the extents of a sub-portion of a glyph string. The extents are
-- relative to the start of the glyph string range (the origin of their
-- coordinate system is at the start of the range, not at the start of the entire
-- glyph string).
glyphStringExtentsRange ::
    (B.CallStack.HasCallStack, MonadIO m, Pango.Font.IsFont a) =>
    GlyphString
    -- ^ /@glyphs@/: a t'GI.Pango.Structs.GlyphString.GlyphString'
    -> Int32
    -- ^ /@start@/: start index
    -> Int32
    -- ^ /@end@/: end index (the range is the set of bytes with
    -- 	      indices such that start \<= index \< end)
    -> a
    -- ^ /@font@/: a t'GI.Pango.Objects.Font.Font'
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
glyphStringExtentsRange :: GlyphString -> Int32 -> Int32 -> a -> m (Rectangle, Rectangle)
glyphStringExtentsRange GlyphString
glyphs Int32
start Int32
end a
font = 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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    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 GlyphString
-> Int32
-> Int32
-> Ptr Font
-> Ptr Rectangle
-> Ptr Rectangle
-> IO ()
pango_glyph_string_extents_range Ptr GlyphString
glyphs' Int32
start Int32
end Ptr Font
font' 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
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    (Rectangle, Rectangle) -> IO (Rectangle, Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
inkRect', Rectangle
logicalRect')

#if defined(ENABLE_OVERLOADING)
data GlyphStringExtentsRangeMethodInfo
instance (signature ~ (Int32 -> Int32 -> a -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m, Pango.Font.IsFont a) => O.MethodInfo GlyphStringExtentsRangeMethodInfo GlyphString signature where
    overloadedMethod = glyphStringExtentsRange

#endif

-- method GlyphString::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString, 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_string_free" pango_glyph_string_free :: 
    Ptr GlyphString ->                      -- string : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    IO ()

-- | Free a glyph string and associated storage.
glyphStringFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@string@/: a t'GI.Pango.Structs.GlyphString.GlyphString', may be 'P.Nothing'
    -> m ()
glyphStringFree :: GlyphString -> m ()
glyphStringFree GlyphString
string = 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 GlyphString
string' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
string
    Ptr GlyphString -> IO ()
pango_glyph_string_free Ptr GlyphString
string'
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
string
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GlyphStringFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo GlyphStringFreeMethodInfo GlyphString signature where
    overloadedMethod = glyphStringFree

#endif

-- method GlyphString::get_logical_widths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString"
--                 , 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 "the text corresponding to the glyphs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @text, in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "embedding_level"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the embedding level of the string"
--                 , 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 text (equal to g_utf8_strlen (text,\n                 length) unless text has NUL bytes) to be filled in\n                 with 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_string_get_logical_widths" pango_glyph_string_get_logical_widths :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    Int32 ->                                -- embedding_level : TBasicType TInt
    Ptr Int32 ->                            -- logical_widths : TCArray False (-1) (-1) (TBasicType TInt)
    IO ()

-- | Given a t'GI.Pango.Structs.GlyphString.GlyphString' resulting from 'GI.Pango.Functions.shape' 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.GlyphItem.glyphItemGetLogicalWidths'.
glyphStringGetLogicalWidths ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@glyphs@/: a t'GI.Pango.Structs.GlyphString.GlyphString'
    -> T.Text
    -- ^ /@text@/: the text corresponding to the glyphs
    -> Int32
    -- ^ /@length@/: the length of /@text@/, in bytes
    -> Int32
    -- ^ /@embeddingLevel@/: the embedding level of the string
    -> [Int32]
    -- ^ /@logicalWidths@/: an array whose length is the number of
    --                  characters in text (equal to g_utf8_strlen (text,
    --                  length) unless text has NUL bytes) to be filled in
    --                  with the resulting character widths.
    -> m ()
glyphStringGetLogicalWidths :: GlyphString -> Text -> Int32 -> Int32 -> [Int32] -> m ()
glyphStringGetLogicalWidths GlyphString
glyphs Text
text Int32
length_ Int32
embeddingLevel [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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    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 GlyphString -> CString -> Int32 -> Int32 -> Ptr Int32 -> IO ()
pango_glyph_string_get_logical_widths Ptr GlyphString
glyphs' CString
text' Int32
length_ Int32
embeddingLevel Ptr Int32
logicalWidths'
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    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 GlyphStringGetLogicalWidthsMethodInfo
instance (signature ~ (T.Text -> Int32 -> Int32 -> [Int32] -> m ()), MonadIO m) => O.MethodInfo GlyphStringGetLogicalWidthsMethodInfo GlyphString signature where
    overloadedMethod = glyphStringGetLogicalWidths

#endif

-- method GlyphString::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString"
--                 , 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_glyph_string_get_width" pango_glyph_string_get_width :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    IO Int32

-- | Computes the logical width of the glyph string as can also be computed
-- using 'GI.Pango.Structs.GlyphString.glyphStringExtents'.  However, since this only computes the
-- width, it\'s much faster.  This is in fact only a convenience function that
-- computes the sum of geometry.width for each glyph in the /@glyphs@/.
-- 
-- /Since: 1.14/
glyphStringGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@glyphs@/: a t'GI.Pango.Structs.GlyphString.GlyphString'
    -> m Int32
    -- ^ __Returns:__ the logical width of the glyph string.
glyphStringGetWidth :: GlyphString -> m Int32
glyphStringGetWidth GlyphString
glyphs = 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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    Int32
result <- Ptr GlyphString -> IO Int32
pango_glyph_string_get_width Ptr GlyphString
glyphs'
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data GlyphStringGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo GlyphStringGetWidthMethodInfo GlyphString signature where
    overloadedMethod = glyphStringGetWidth

#endif

-- method GlyphString::index_to_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the glyphs return from pango_shape()"
--                 , 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 "the text for the run"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of bytes (not characters) in @text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "analysis"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Analysis" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the analysis information return from pango_itemize()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the byte index within @text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trailing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether we should compute the result for the beginning (%FALSE)\n            or end (%TRUE) of the character."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_string_index_to_x" pango_glyph_string_index_to_x :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    Ptr Pango.Analysis.Analysis ->          -- analysis : TInterface (Name {namespace = "Pango", name = "Analysis"})
    Int32 ->                                -- index_ : TBasicType TInt
    CInt ->                                 -- trailing : TBasicType TBoolean
    Ptr Int32 ->                            -- x_pos : TBasicType TInt
    IO ()

-- | Converts from character position to x position. (X position
-- is measured from the left edge of the run). Character positions
-- are computed by dividing up each cluster into equal portions.
glyphStringIndexToX ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@glyphs@/: the glyphs return from 'GI.Pango.Functions.shape'
    -> T.Text
    -- ^ /@text@/: the text for the run
    -> Int32
    -- ^ /@length@/: the number of bytes (not characters) in /@text@/.
    -> Pango.Analysis.Analysis
    -- ^ /@analysis@/: the analysis information return from 'GI.Pango.Functions.itemize'
    -> Int32
    -- ^ /@index_@/: the byte index within /@text@/
    -> Bool
    -- ^ /@trailing@/: whether we should compute the result for the beginning ('P.False')
    --             or end ('P.True') of the character.
    -> m (Int32)
glyphStringIndexToX :: GlyphString
-> Text -> Int32 -> Analysis -> Int32 -> Bool -> m Int32
glyphStringIndexToX GlyphString
glyphs Text
text Int32
length_ Analysis
analysis Int32
index_ Bool
trailing = 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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr Analysis
analysis' <- Analysis -> IO (Ptr Analysis)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Analysis
analysis
    let trailing' :: CInt
trailing' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
trailing
    Ptr Int32
xPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr GlyphString
-> CString
-> Int32
-> Ptr Analysis
-> Int32
-> CInt
-> Ptr Int32
-> IO ()
pango_glyph_string_index_to_x Ptr GlyphString
glyphs' CString
text' Int32
length_ Ptr Analysis
analysis' Int32
index_ CInt
trailing' Ptr Int32
xPos
    Int32
xPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
xPos
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    Analysis -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Analysis
analysis
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
xPos
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
xPos'

#if defined(ENABLE_OVERLOADING)
data GlyphStringIndexToXMethodInfo
instance (signature ~ (T.Text -> Int32 -> Pango.Analysis.Analysis -> Int32 -> Bool -> m (Int32)), MonadIO m) => O.MethodInfo GlyphStringIndexToXMethodInfo GlyphString signature where
    overloadedMethod = glyphStringIndexToX

#endif

-- method GlyphString::set_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoGlyphString."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_len"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new length of the string."
--                 , 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_string_set_size" pango_glyph_string_set_size :: 
    Ptr GlyphString ->                      -- string : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    Int32 ->                                -- new_len : TBasicType TInt
    IO ()

-- | Resize a glyph string to the given length.
glyphStringSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@string@/: a t'GI.Pango.Structs.GlyphString.GlyphString'.
    -> Int32
    -- ^ /@newLen@/: the new length of the string.
    -> m ()
glyphStringSetSize :: GlyphString -> Int32 -> m ()
glyphStringSetSize GlyphString
string Int32
newLen = 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 GlyphString
string' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
string
    Ptr GlyphString -> Int32 -> IO ()
pango_glyph_string_set_size Ptr GlyphString
string' Int32
newLen
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
string
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GlyphStringSetSizeMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.MethodInfo GlyphStringSetSizeMethodInfo GlyphString signature where
    overloadedMethod = glyphStringSetSize

#endif

-- method GlyphString::x_to_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the glyphs returned from pango_shape()"
--                 , 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 "the text for the run"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes (not characters) in text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "analysis"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Analysis" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the analysis information return from pango_itemize()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x offset (in Pango units)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store calculated byte index within @text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "trailing"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store a boolean indicating\n            whether the user clicked on the leading or trailing\n            edge of the character."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_glyph_string_x_to_index" pango_glyph_string_x_to_index :: 
    Ptr GlyphString ->                      -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    Ptr Pango.Analysis.Analysis ->          -- analysis : TInterface (Name {namespace = "Pango", name = "Analysis"})
    Int32 ->                                -- x_pos : TBasicType TInt
    Ptr Int32 ->                            -- index_ : TBasicType TInt
    Ptr Int32 ->                            -- trailing : TBasicType TInt
    IO ()

-- | Convert from x offset to character position. Character positions
-- are computed by dividing up each cluster into equal portions.
-- In scripts where positioning within a cluster is not allowed
-- (such as Thai), the returned value may not be a valid cursor
-- position; the caller must combine the result with the logical
-- attributes for the text to compute the valid cursor position.
glyphStringXToIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GlyphString
    -- ^ /@glyphs@/: the glyphs returned from 'GI.Pango.Functions.shape'
    -> T.Text
    -- ^ /@text@/: the text for the run
    -> Int32
    -- ^ /@length@/: the number of bytes (not characters) in text.
    -> Pango.Analysis.Analysis
    -- ^ /@analysis@/: the analysis information return from 'GI.Pango.Functions.itemize'
    -> Int32
    -- ^ /@xPos@/: the x offset (in Pango units)
    -> m ((Int32, Int32))
glyphStringXToIndex :: GlyphString
-> Text -> Int32 -> Analysis -> Int32 -> m (Int32, Int32)
glyphStringXToIndex GlyphString
glyphs Text
text Int32
length_ Analysis
analysis Int32
xPos = 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 GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr Analysis
analysis' <- Analysis -> IO (Ptr Analysis)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Analysis
analysis
    Ptr Int32
index_ <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
trailing <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr GlyphString
-> CString
-> Int32
-> Ptr Analysis
-> Int32
-> Ptr Int32
-> Ptr Int32
-> IO ()
pango_glyph_string_x_to_index Ptr GlyphString
glyphs' CString
text' Int32
length_ Ptr Analysis
analysis' Int32
xPos Ptr Int32
index_ Ptr Int32
trailing
    Int32
index_' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
index_
    Int32
trailing' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
trailing
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    Analysis -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Analysis
analysis
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
index_
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
trailing
    (Int32, Int32) -> IO (Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
index_', Int32
trailing')

#if defined(ENABLE_OVERLOADING)
data GlyphStringXToIndexMethodInfo
instance (signature ~ (T.Text -> Int32 -> Pango.Analysis.Analysis -> Int32 -> m ((Int32, Int32))), MonadIO m) => O.MethodInfo GlyphStringXToIndexMethodInfo GlyphString signature where
    overloadedMethod = glyphStringXToIndex

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveGlyphStringMethod (t :: Symbol) (o :: *) :: * where
    ResolveGlyphStringMethod "copy" o = GlyphStringCopyMethodInfo
    ResolveGlyphStringMethod "extents" o = GlyphStringExtentsMethodInfo
    ResolveGlyphStringMethod "extentsRange" o = GlyphStringExtentsRangeMethodInfo
    ResolveGlyphStringMethod "free" o = GlyphStringFreeMethodInfo
    ResolveGlyphStringMethod "indexToX" o = GlyphStringIndexToXMethodInfo
    ResolveGlyphStringMethod "xToIndex" o = GlyphStringXToIndexMethodInfo
    ResolveGlyphStringMethod "getLogicalWidths" o = GlyphStringGetLogicalWidthsMethodInfo
    ResolveGlyphStringMethod "getWidth" o = GlyphStringGetWidthMethodInfo
    ResolveGlyphStringMethod "setSize" o = GlyphStringSetSizeMethodInfo
    ResolveGlyphStringMethod l o = O.MethodResolutionFailed l o

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

#endif