{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @PangoFont@ is used to represent a font in a
-- rendering-system-independent manner.

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

module GI.Pango.Objects.Font
    ( 

-- * Exported types
    Font(..)                                ,
    IsFont                                  ,
    toFont                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [describe]("GI.Pango.Objects.Font#g:method:describe"), [describeWithAbsoluteSize]("GI.Pango.Objects.Font#g:method:describeWithAbsoluteSize"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasChar]("GI.Pango.Objects.Font#g:method:hasChar"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serialize]("GI.Pango.Objects.Font#g:method:serialize"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCoverage]("GI.Pango.Objects.Font#g:method:getCoverage"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFace]("GI.Pango.Objects.Font#g:method:getFace"), [getFeatures]("GI.Pango.Objects.Font#g:method:getFeatures"), [getFontMap]("GI.Pango.Objects.Font#g:method:getFontMap"), [getGlyphExtents]("GI.Pango.Objects.Font#g:method:getGlyphExtents"), [getLanguages]("GI.Pango.Objects.Font#g:method:getLanguages"), [getMetrics]("GI.Pango.Objects.Font#g:method:getMetrics"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFontMethod                       ,
#endif

-- ** describe #method:describe#

#if defined(ENABLE_OVERLOADING)
    FontDescribeMethodInfo                  ,
#endif
    fontDescribe                            ,


-- ** describeWithAbsoluteSize #method:describeWithAbsoluteSize#

#if defined(ENABLE_OVERLOADING)
    FontDescribeWithAbsoluteSizeMethodInfo  ,
#endif
    fontDescribeWithAbsoluteSize            ,


-- ** descriptionsFree #method:descriptionsFree#

    fontDescriptionsFree                    ,


-- ** deserialize #method:deserialize#

    fontDeserialize                         ,


-- ** getCoverage #method:getCoverage#

#if defined(ENABLE_OVERLOADING)
    FontGetCoverageMethodInfo               ,
#endif
    fontGetCoverage                         ,


-- ** getFace #method:getFace#

#if defined(ENABLE_OVERLOADING)
    FontGetFaceMethodInfo                   ,
#endif
    fontGetFace                             ,


-- ** getFeatures #method:getFeatures#

#if defined(ENABLE_OVERLOADING)
    FontGetFeaturesMethodInfo               ,
#endif
    fontGetFeatures                         ,


-- ** getFontMap #method:getFontMap#

#if defined(ENABLE_OVERLOADING)
    FontGetFontMapMethodInfo                ,
#endif
    fontGetFontMap                          ,


-- ** getGlyphExtents #method:getGlyphExtents#

#if defined(ENABLE_OVERLOADING)
    FontGetGlyphExtentsMethodInfo           ,
#endif
    fontGetGlyphExtents                     ,


-- ** getLanguages #method:getLanguages#

#if defined(ENABLE_OVERLOADING)
    FontGetLanguagesMethodInfo              ,
#endif
    fontGetLanguages                        ,


-- ** getMetrics #method:getMetrics#

#if defined(ENABLE_OVERLOADING)
    FontGetMetricsMethodInfo                ,
#endif
    fontGetMetrics                          ,


-- ** hasChar #method:hasChar#

#if defined(ENABLE_OVERLOADING)
    FontHasCharMethodInfo                   ,
#endif
    fontHasChar                             ,


-- ** serialize #method:serialize#

#if defined(ENABLE_OVERLOADING)
    FontSerializeMethodInfo                 ,
#endif
    fontSerialize                           ,




    ) 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 qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.HarfBuzz.Structs.FeatureT as HarfBuzz.FeatureT
import {-# SOURCE #-} qualified GI.Pango.Objects.Context as Pango.Context
import {-# SOURCE #-} qualified GI.Pango.Objects.Coverage as Pango.Coverage
import {-# SOURCE #-} qualified GI.Pango.Objects.FontFace as Pango.FontFace
import {-# SOURCE #-} qualified GI.Pango.Objects.FontMap as Pango.FontMap
import {-# SOURCE #-} qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import {-# SOURCE #-} qualified GI.Pango.Structs.FontMetrics as Pango.FontMetrics
import {-# SOURCE #-} qualified GI.Pango.Structs.Language as Pango.Language
import {-# SOURCE #-} qualified GI.Pango.Structs.Rectangle as Pango.Rectangle

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

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

foreign import ccall "pango_font_get_type"
    c_pango_font_get_type :: IO B.Types.GType

instance B.Types.TypedObject Font where
    glibType :: IO GType
glibType = IO GType
c_pango_font_get_type

instance B.Types.GObject Font

-- | Type class for types which can be safely cast to `Font`, for instance with `toFont`.
class (SP.GObject o, O.IsDescendantOf Font o) => IsFont o
instance (SP.GObject o, O.IsDescendantOf Font o) => IsFont o

instance O.HasParentTypes Font
type instance O.ParentTypes Font = '[GObject.Object.Object]

-- | Cast to `Font`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toFont :: (MIO.MonadIO m, IsFont o) => o -> m Font
toFont :: forall (m :: * -> *) o. (MonadIO m, IsFont o) => o -> m Font
toFont = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Font -> m Font) -> (o -> IO Font) -> o -> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Font -> Font) -> o -> IO Font
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Font -> Font
Font

-- | Convert 'Font' 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 Font) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_pango_font_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Font -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Font
P.Nothing = Ptr GValue -> Ptr Font -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Font
forall a. Ptr a
FP.nullPtr :: FP.Ptr Font)
    gvalueSet_ Ptr GValue
gv (P.Just Font
obj) = Font -> (Ptr Font -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Font
obj (Ptr GValue -> Ptr Font -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Font)
gvalueGet_ Ptr GValue
gv = do
        Ptr Font
ptr <- Ptr GValue -> IO (Ptr Font)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Font)
        if Ptr Font
ptr Ptr Font -> Ptr Font -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Font
forall a. Ptr a
FP.nullPtr
        then Font -> Maybe Font
forall a. a -> Maybe a
P.Just (Font -> Maybe Font) -> IO Font -> IO (Maybe Font)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Font -> Font) -> Ptr Font -> IO Font
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Font -> Font
Font Ptr Font
ptr
        else Maybe Font -> IO (Maybe Font)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Font
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveFontMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFontMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFontMethod "describe" o = FontDescribeMethodInfo
    ResolveFontMethod "describeWithAbsoluteSize" o = FontDescribeWithAbsoluteSizeMethodInfo
    ResolveFontMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFontMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFontMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFontMethod "hasChar" o = FontHasCharMethodInfo
    ResolveFontMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFontMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFontMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFontMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFontMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFontMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFontMethod "serialize" o = FontSerializeMethodInfo
    ResolveFontMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFontMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFontMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFontMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFontMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFontMethod "getCoverage" o = FontGetCoverageMethodInfo
    ResolveFontMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFontMethod "getFace" o = FontGetFaceMethodInfo
    ResolveFontMethod "getFeatures" o = FontGetFeaturesMethodInfo
    ResolveFontMethod "getFontMap" o = FontGetFontMapMethodInfo
    ResolveFontMethod "getGlyphExtents" o = FontGetGlyphExtentsMethodInfo
    ResolveFontMethod "getLanguages" o = FontGetLanguagesMethodInfo
    ResolveFontMethod "getMetrics" o = FontGetMetricsMethodInfo
    ResolveFontMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFontMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFontMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFontMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFontMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFontMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveFontMethod t Font, O.OverloadedMethod info Font p) => OL.IsLabel t (Font -> 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 ~ ResolveFontMethod t Font, O.OverloadedMethod info Font p, R.HasField t Font p) => R.HasField t Font p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Font = FontSignalList
type FontSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Font::describe
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_describe" pango_font_describe :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Returns a description of the font, with font size set in points.
-- 
-- Use 'GI.Pango.Objects.Font.fontDescribeWithAbsoluteSize' if you want
-- the font size in device units.
fontDescribe ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m Pango.FontDescription.FontDescription
    -- ^ __Returns:__ a newly-allocated @PangoFontDescription@ object.
fontDescribe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m FontDescription
fontDescribe a
font = IO FontDescription -> m FontDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDescription -> m FontDescription)
-> IO FontDescription -> m FontDescription
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr FontDescription
result <- Ptr Font -> IO (Ptr FontDescription)
pango_font_describe Ptr Font
font'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontDescribe" Ptr FontDescription
result
    FontDescription
result' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
Pango.FontDescription.FontDescription) Ptr FontDescription
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
data FontDescribeMethodInfo
instance (signature ~ (m Pango.FontDescription.FontDescription), MonadIO m, IsFont a) => O.OverloadedMethod FontDescribeMethodInfo a signature where
    overloadedMethod = fontDescribe

instance O.OverloadedMethodInfo FontDescribeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontDescribe",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontDescribe"
        })


#endif

-- method Font::describe_with_absolute_size
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Pango" , name = "FontDescription" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_describe_with_absolute_size" pango_font_describe_with_absolute_size :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Returns a description of the font, with absolute font size set
-- in device units.
-- 
-- Use 'GI.Pango.Objects.Font.fontDescribe' if you want the font size in points.
-- 
-- /Since: 1.14/
fontDescribeWithAbsoluteSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m Pango.FontDescription.FontDescription
    -- ^ __Returns:__ a newly-allocated @PangoFontDescription@ object.
fontDescribeWithAbsoluteSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m FontDescription
fontDescribeWithAbsoluteSize a
font = IO FontDescription -> m FontDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontDescription -> m FontDescription)
-> IO FontDescription -> m FontDescription
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr FontDescription
result <- Ptr Font -> IO (Ptr FontDescription)
pango_font_describe_with_absolute_size Ptr Font
font'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontDescribeWithAbsoluteSize" Ptr FontDescription
result
    FontDescription
result' <- ((ManagedPtr FontDescription -> FontDescription)
-> Ptr FontDescription -> IO FontDescription
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontDescription -> FontDescription
Pango.FontDescription.FontDescription) Ptr FontDescription
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
data FontDescribeWithAbsoluteSizeMethodInfo
instance (signature ~ (m Pango.FontDescription.FontDescription), MonadIO m, IsFont a) => O.OverloadedMethod FontDescribeWithAbsoluteSizeMethodInfo a signature where
    overloadedMethod = fontDescribeWithAbsoluteSize

instance O.OverloadedMethodInfo FontDescribeWithAbsoluteSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontDescribeWithAbsoluteSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontDescribeWithAbsoluteSize"
        })


#endif

-- method Font::get_coverage
-- method type : OrdinaryMethod
-- Args: [ 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 = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the language tag" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Coverage" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_coverage" pango_font_get_coverage :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO (Ptr Pango.Coverage.Coverage)

-- | Computes the coverage map for a given font and language tag.
fontGetCoverage ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> Pango.Language.Language
    -- ^ /@language@/: the language tag
    -> m Pango.Coverage.Coverage
    -- ^ __Returns:__ a newly-allocated @PangoCoverage@
    --   object.
fontGetCoverage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> Language -> m Coverage
fontGetCoverage a
font Language
language = IO Coverage -> m Coverage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coverage -> m Coverage) -> IO Coverage -> m Coverage
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr Language
language' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
language
    Ptr Coverage
result <- Ptr Font -> Ptr Language -> IO (Ptr Coverage)
pango_font_get_coverage Ptr Font
font' Ptr Language
language'
    Text -> Ptr Coverage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontGetCoverage" Ptr Coverage
result
    Coverage
result' <- ((ManagedPtr Coverage -> Coverage) -> Ptr Coverage -> IO Coverage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Coverage -> Coverage
Pango.Coverage.Coverage) Ptr Coverage
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Language
language
    Coverage -> IO Coverage
forall (m :: * -> *) a. Monad m => a -> m a
return Coverage
result'

#if defined(ENABLE_OVERLOADING)
data FontGetCoverageMethodInfo
instance (signature ~ (Pango.Language.Language -> m Pango.Coverage.Coverage), MonadIO m, IsFont a) => O.OverloadedMethod FontGetCoverageMethodInfo a signature where
    overloadedMethod = fontGetCoverage

instance O.OverloadedMethodInfo FontGetCoverageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetCoverage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetCoverage"
        })


#endif

-- method Font::get_face
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontFace" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_face" pango_font_get_face :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr Pango.FontFace.FontFace)

-- | Gets the @PangoFontFace@ to which /@font@/ belongs.
-- 
-- /Since: 1.46/
fontGetFace ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m Pango.FontFace.FontFace
    -- ^ __Returns:__ the @PangoFontFace@
fontGetFace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m FontFace
fontGetFace a
font = IO FontFace -> m FontFace
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontFace -> m FontFace) -> IO FontFace -> m FontFace
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr FontFace
result <- Ptr Font -> IO (Ptr FontFace)
pango_font_get_face Ptr Font
font'
    Text -> Ptr FontFace -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontGetFace" Ptr FontFace
result
    FontFace
result' <- ((ManagedPtr FontFace -> FontFace) -> Ptr FontFace -> IO FontFace
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontFace -> FontFace
Pango.FontFace.FontFace) Ptr FontFace
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    FontFace -> IO FontFace
forall (m :: * -> *) a. Monad m => a -> m a
return FontFace
result'

#if defined(ENABLE_OVERLOADING)
data FontGetFaceMethodInfo
instance (signature ~ (m Pango.FontFace.FontFace), MonadIO m, IsFont a) => O.OverloadedMethod FontGetFaceMethodInfo a signature where
    overloadedMethod = fontGetFace

instance O.OverloadedMethodInfo FontGetFaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetFace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetFace"
        })


#endif

-- method Font::get_features
-- method type : OrdinaryMethod
-- Args: [ 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 = "features"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "HarfBuzz" , name = "feature_t" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Array to features in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @features"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "num_features"
--           , argType = TBasicType TUInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of used items in @features"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "len"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @features"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_features" pango_font_get_features :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    Ptr HarfBuzz.FeatureT.FeatureT ->       -- features : TCArray False (-1) 2 (TInterface (Name {namespace = "HarfBuzz", name = "feature_t"}))
    Word32 ->                               -- len : TBasicType TUInt
    Ptr Word32 ->                           -- num_features : TBasicType TUInt
    IO ()

-- | Obtain the OpenType features that are provided by the font.
-- 
-- These are passed to the rendering system, together with features
-- that have been explicitly set via attributes.
-- 
-- Note that this does not include OpenType features which the
-- rendering system enables by default.
-- 
-- /Since: 1.44/
fontGetFeatures ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> [HarfBuzz.FeatureT.FeatureT]
    -- ^ /@features@/: Array to features in
    -> Word32
    -- ^ /@numFeatures@/: the number of used items in /@features@/
    -> m (([HarfBuzz.FeatureT.FeatureT], Word32))
fontGetFeatures :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> [FeatureT] -> Word32 -> m ([FeatureT], Word32)
fontGetFeatures a
font [FeatureT]
features Word32
numFeatures = IO ([FeatureT], Word32) -> m ([FeatureT], Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FeatureT], Word32) -> m ([FeatureT], Word32))
-> IO ([FeatureT], Word32) -> m ([FeatureT], Word32)
forall a b. (a -> b) -> a -> b
$ do
    let len :: Word32
len = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [FeatureT] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [FeatureT]
features
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    [Ptr FeatureT]
features' <- (FeatureT -> IO (Ptr FeatureT)) -> [FeatureT] -> IO [Ptr FeatureT]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FeatureT -> IO (Ptr FeatureT)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [FeatureT]
features
    Ptr FeatureT
features'' <- Int -> [Ptr FeatureT] -> IO (Ptr FeatureT)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr FeatureT]
features'
    Ptr Word32
numFeatures' <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
numFeatures' Word32
numFeatures
    Ptr Font -> Ptr FeatureT -> Word32 -> Ptr Word32 -> IO ()
pango_font_get_features Ptr Font
font' Ptr FeatureT
features'' Word32
len Ptr Word32
numFeatures'
    [Ptr FeatureT]
features''' <- (Int -> Word32 -> Ptr FeatureT -> IO [Ptr FeatureT]
forall a b.
(Integral a, GBoxed b) =>
Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength Int
16 Word32
len) Ptr FeatureT
features''
    [FeatureT]
features'''' <- (Ptr FeatureT -> IO FeatureT) -> [Ptr FeatureT] -> IO [FeatureT]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr FeatureT -> FeatureT) -> Ptr FeatureT -> IO FeatureT
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FeatureT -> FeatureT
HarfBuzz.FeatureT.FeatureT) [Ptr FeatureT]
features'''
    Ptr FeatureT -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr FeatureT
features''
    Word32
numFeatures'' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
numFeatures'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    (FeatureT -> IO ()) -> [FeatureT] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FeatureT -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [FeatureT]
features
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
numFeatures'
    ([FeatureT], Word32) -> IO ([FeatureT], Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FeatureT]
features'''', Word32
numFeatures'')

#if defined(ENABLE_OVERLOADING)
data FontGetFeaturesMethodInfo
instance (signature ~ ([HarfBuzz.FeatureT.FeatureT] -> Word32 -> m (([HarfBuzz.FeatureT.FeatureT], Word32))), MonadIO m, IsFont a) => O.OverloadedMethod FontGetFeaturesMethodInfo a signature where
    overloadedMethod = fontGetFeatures

instance O.OverloadedMethodInfo FontGetFeaturesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetFeatures",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetFeatures"
        })


#endif

-- method Font::get_font_map
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontMap" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_font_map" pango_font_get_font_map :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr Pango.FontMap.FontMap)

-- | Gets the font map for which the font was created.
-- 
-- Note that the font maintains a *weak* reference to
-- the font map, so if all references to font map are
-- dropped, the font map will be finalized even if there
-- are fonts created with the font map that are still alive.
-- In that case this function will return 'P.Nothing'.
-- 
-- It is the responsibility of the user to ensure that the
-- font map is kept alive. In most uses this is not an issue
-- as a @PangoContext@ holds a reference to the font map.
-- 
-- /Since: 1.10/
fontGetFontMap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m (Maybe Pango.FontMap.FontMap)
    -- ^ __Returns:__ the @PangoFontMap@
    --   for the font
fontGetFontMap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m (Maybe FontMap)
fontGetFontMap a
font = IO (Maybe FontMap) -> m (Maybe FontMap)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontMap) -> m (Maybe FontMap))
-> IO (Maybe FontMap) -> m (Maybe FontMap)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr FontMap
result <- Ptr Font -> IO (Ptr FontMap)
pango_font_get_font_map Ptr Font
font'
    Maybe FontMap
maybeResult <- Ptr FontMap -> (Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontMap
result ((Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap))
-> (Ptr FontMap -> IO FontMap) -> IO (Maybe FontMap)
forall a b. (a -> b) -> a -> b
$ \Ptr FontMap
result' -> do
        FontMap
result'' <- ((ManagedPtr FontMap -> FontMap) -> Ptr FontMap -> IO FontMap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontMap -> FontMap
Pango.FontMap.FontMap) Ptr FontMap
result'
        FontMap -> IO FontMap
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Maybe FontMap -> IO (Maybe FontMap)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontMap
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontGetFontMapMethodInfo
instance (signature ~ (m (Maybe Pango.FontMap.FontMap)), MonadIO m, IsFont a) => O.OverloadedMethod FontGetFontMapMethodInfo a signature where
    overloadedMethod = fontGetFontMap

instance O.OverloadedMethodInfo FontGetFontMapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetFontMap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetFontMap"
        })


#endif

-- method Font::get_glyph_extents
-- method type : OrdinaryMethod
-- Args: [ 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 = "glyph"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the glyph index" , 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 as drawn"
--                 , 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 glyph"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_glyph_extents" pango_font_get_glyph_extents :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    Word32 ->                               -- glyph : TBasicType TUInt32
    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 logical and ink extents of a glyph within a font.
-- 
-- The coordinate system for each rectangle has its origin at the
-- base line and horizontal origin of the character with increasing
-- coordinates extending to the right and down. The macros @/PANGO_ASCENT()/@,
-- @/PANGO_DESCENT()/@, @/PANGO_LBEARING()/@, and @/PANGO_RBEARING()/@ can be used to convert
-- from the extents rectangle to more traditional font metrics. The units
-- of the rectangles are in 1\/PANGO_SCALE of a device unit.
-- 
-- If /@font@/ is 'P.Nothing', this function gracefully sets some sane values in the
-- output variables and returns.
fontGetGlyphExtents ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> Word32
    -- ^ /@glyph@/: the glyph index
    -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))
fontGetGlyphExtents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> Word32 -> m (Rectangle, Rectangle)
fontGetGlyphExtents a
font Word32
glyph = 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 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 Font -> Word32 -> Ptr Rectangle -> Ptr Rectangle -> IO ()
pango_font_get_glyph_extents Ptr Font
font' Word32
glyph 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
    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 FontGetGlyphExtentsMethodInfo
instance (signature ~ (Word32 -> m ((Pango.Rectangle.Rectangle, Pango.Rectangle.Rectangle))), MonadIO m, IsFont a) => O.OverloadedMethod FontGetGlyphExtentsMethodInfo a signature where
    overloadedMethod = fontGetGlyphExtents

instance O.OverloadedMethodInfo FontGetGlyphExtentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetGlyphExtents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetGlyphExtents"
        })


#endif

-- method Font::get_languages
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TCArray
--                  True
--                  (-1)
--                  (-1)
--                  (TInterface Name { namespace = "Pango" , name = "Language" }))
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_languages" pango_font_get_languages :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr (Ptr Pango.Language.Language))

-- | Returns the languages that are supported by /@font@/.
-- 
-- If the font backend does not provide this information,
-- 'P.Nothing' is returned. For the fontconfig backend, this
-- corresponds to the FC_LANG member of the FcPattern.
-- 
-- The returned array is only valid as long as the font
-- and its fontmap are valid.
-- 
-- /Since: 1.50/
fontGetLanguages ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m (Maybe [Pango.Language.Language])
    -- ^ __Returns:__ an array of @PangoLanguage@
fontGetLanguages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m (Maybe [Language])
fontGetLanguages a
font = IO (Maybe [Language]) -> m (Maybe [Language])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Language]) -> m (Maybe [Language]))
-> IO (Maybe [Language]) -> m (Maybe [Language])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr (Ptr Language)
result <- Ptr Font -> IO (Ptr (Ptr Language))
pango_font_get_languages Ptr Font
font'
    Maybe [Language]
maybeResult <- Ptr (Ptr Language)
-> (Ptr (Ptr Language) -> IO [Language]) -> IO (Maybe [Language])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (Ptr Language)
result ((Ptr (Ptr Language) -> IO [Language]) -> IO (Maybe [Language]))
-> (Ptr (Ptr Language) -> IO [Language]) -> IO (Maybe [Language])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Language)
result' -> do
        [Ptr Language]
result'' <- Ptr (Ptr Language) -> IO [Ptr Language]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr Language)
result'
        [Language]
result''' <- (Ptr Language -> IO Language) -> [Ptr Language] -> IO [Language]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Language -> Language) -> Ptr Language -> IO Language
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Language -> Language
Pango.Language.Language) [Ptr Language]
result''
        [Language] -> IO [Language]
forall (m :: * -> *) a. Monad m => a -> m a
return [Language]
result'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Maybe [Language] -> IO (Maybe [Language])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Language]
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontGetLanguagesMethodInfo
instance (signature ~ (m (Maybe [Pango.Language.Language])), MonadIO m, IsFont a) => O.OverloadedMethod FontGetLanguagesMethodInfo a signature where
    overloadedMethod = fontGetLanguages

instance O.OverloadedMethodInfo FontGetLanguagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetLanguages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetLanguages"
        })


#endif

-- method Font::get_metrics
-- method type : OrdinaryMethod
-- Args: [ 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 = "language"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Language" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "language tag used to determine which script\n  to get the metrics for, or %NULL to indicate to get the metrics for\n  the entire font."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "FontMetrics" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_get_metrics" pango_font_get_metrics :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    Ptr Pango.Language.Language ->          -- language : TInterface (Name {namespace = "Pango", name = "Language"})
    IO (Ptr Pango.FontMetrics.FontMetrics)

-- | Gets overall metric information for a font.
-- 
-- Since the metrics may be substantially different for different scripts,
-- a language tag can be provided to indicate that the metrics should be
-- retrieved that correspond to the script(s) used by that language.
-- 
-- If /@font@/ is 'P.Nothing', this function gracefully sets some sane values in the
-- output variables and returns.
fontGetMetrics ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> Maybe (Pango.Language.Language)
    -- ^ /@language@/: language tag used to determine which script
    --   to get the metrics for, or 'P.Nothing' to indicate to get the metrics for
    --   the entire font.
    -> m Pango.FontMetrics.FontMetrics
    -- ^ __Returns:__ a @PangoFontMetrics@ object. The caller must call
    --   'GI.Pango.Structs.FontMetrics.fontMetricsUnref' when finished using the object.
fontGetMetrics :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> Maybe Language -> m FontMetrics
fontGetMetrics a
font Maybe Language
language = IO FontMetrics -> m FontMetrics
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMetrics -> m FontMetrics)
-> IO FontMetrics -> m FontMetrics
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr Language
maybeLanguage <- case Maybe Language
language of
        Maybe Language
Nothing -> Ptr Language -> IO (Ptr Language)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Language
forall a. Ptr a
nullPtr
        Just Language
jLanguage -> do
            Ptr Language
jLanguage' <- Language -> IO (Ptr Language)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Language
jLanguage
            Ptr Language -> IO (Ptr Language)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Language
jLanguage'
    Ptr FontMetrics
result <- Ptr Font -> Ptr Language -> IO (Ptr FontMetrics)
pango_font_get_metrics Ptr Font
font' Ptr Language
maybeLanguage
    Text -> Ptr FontMetrics -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontGetMetrics" Ptr FontMetrics
result
    FontMetrics
result' <- ((ManagedPtr FontMetrics -> FontMetrics)
-> Ptr FontMetrics -> IO FontMetrics
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontMetrics -> FontMetrics
Pango.FontMetrics.FontMetrics) Ptr FontMetrics
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Maybe Language -> (Language -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Language
language Language -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    FontMetrics -> IO FontMetrics
forall (m :: * -> *) a. Monad m => a -> m a
return FontMetrics
result'

#if defined(ENABLE_OVERLOADING)
data FontGetMetricsMethodInfo
instance (signature ~ (Maybe (Pango.Language.Language) -> m Pango.FontMetrics.FontMetrics), MonadIO m, IsFont a) => O.OverloadedMethod FontGetMetricsMethodInfo a signature where
    overloadedMethod = fontGetMetrics

instance O.OverloadedMethodInfo FontGetMetricsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontGetMetrics",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontGetMetrics"
        })


#endif

-- method Font::has_char
-- method type : OrdinaryMethod
-- Args: [ 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 = "wc"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a Unicode character"
--                 , 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_font_has_char" pango_font_has_char :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    CInt ->                                 -- wc : TBasicType TUniChar
    IO CInt

-- | Returns whether the font provides a glyph for this character.
-- 
-- Returns 'P.True' if /@font@/ can render /@wc@/
-- 
-- /Since: 1.44/
fontHasChar ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> Char
    -- ^ /@wc@/: a Unicode character
    -> m Bool
fontHasChar :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> Char -> m Bool
fontHasChar a
font Char
wc = 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 Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    let wc' :: CInt
wc' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
wc
    CInt
result <- Ptr Font -> CInt -> IO CInt
pango_font_has_char Ptr Font
font' CInt
wc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontHasCharMethodInfo
instance (signature ~ (Char -> m Bool), MonadIO m, IsFont a) => O.OverloadedMethod FontHasCharMethodInfo a signature where
    overloadedMethod = fontHasChar

instance O.OverloadedMethodInfo FontHasCharMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontHasChar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontHasChar"
        })


#endif

-- method Font::serialize
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_serialize" pango_font_serialize :: 
    Ptr Font ->                             -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Serializes the /@font@/ in a way that can be uniquely identified.
-- 
-- There are no guarantees about the format of the output across different
-- versions of Pango.
-- 
-- The intended use of this function is testing, benchmarking and debugging.
-- The format is not meant as a permanent storage format.
-- 
-- To recreate a font from its serialized form, use [func/@pango@/.Font.deserialize].
-- 
-- /Since: 1.50/
fontSerialize ::
    (B.CallStack.HasCallStack, MonadIO m, IsFont a) =>
    a
    -- ^ /@font@/: a @PangoFont@
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a @GBytes@ containing the serialized form of /@font@/
fontSerialize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> m Bytes
fontSerialize a
font = IO Bytes -> m Bytes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr Bytes
result <- Ptr Font -> IO (Ptr Bytes)
pango_font_serialize Ptr Font
font'
    Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontSerialize" Ptr Bytes
result
    Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'

#if defined(ENABLE_OVERLOADING)
data FontSerializeMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m, IsFont a) => O.OverloadedMethod FontSerializeMethodInfo a signature where
    overloadedMethod = fontSerialize

instance O.OverloadedMethodInfo FontSerializeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Pango.Objects.Font.fontSerialize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pango-1.0.25/docs/GI-Pango-Objects-Font.html#v:fontSerialize"
        })


#endif

-- method Font::descriptions_free
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "descs"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface
--                    Name { namespace = "Pango" , name = "FontDescription" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer\n  to an array of `PangoFontDescription`, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_descs"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of font descriptions in @descs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_descs"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of font descriptions in @descs"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_descriptions_free" pango_font_descriptions_free :: 
    Ptr (Ptr Pango.FontDescription.FontDescription) -> -- descs : TCArray False (-1) 1 (TInterface (Name {namespace = "Pango", name = "FontDescription"}))
    Int32 ->                                -- n_descs : TBasicType TInt
    IO ()

-- | Frees an array of font descriptions.
fontDescriptionsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([Pango.FontDescription.FontDescription])
    -- ^ /@descs@/: a pointer
    --   to an array of @PangoFontDescription@, may be 'P.Nothing'
    -> m ()
fontDescriptionsFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [FontDescription] -> m ()
fontDescriptionsFree Maybe [FontDescription]
descs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nDescs :: Int32
nDescs = case Maybe [FontDescription]
descs of
            Maybe [FontDescription]
Nothing -> Int32
0
            Just [FontDescription]
jDescs -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [FontDescription] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [FontDescription]
jDescs
    Ptr (Ptr FontDescription)
maybeDescs <- case Maybe [FontDescription]
descs of
        Maybe [FontDescription]
Nothing -> Ptr (Ptr FontDescription) -> IO (Ptr (Ptr FontDescription))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr FontDescription)
forall a. Ptr a
nullPtr
        Just [FontDescription]
jDescs -> do
            [Ptr FontDescription]
jDescs' <- (FontDescription -> IO (Ptr FontDescription))
-> [FontDescription] -> IO [Ptr FontDescription]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FontDescription -> IO (Ptr FontDescription)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [FontDescription]
jDescs
            Ptr (Ptr FontDescription)
jDescs'' <- [Ptr FontDescription] -> IO (Ptr (Ptr FontDescription))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr FontDescription]
jDescs'
            Ptr (Ptr FontDescription) -> IO (Ptr (Ptr FontDescription))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr FontDescription)
jDescs''
    Ptr (Ptr FontDescription) -> Int32 -> IO ()
pango_font_descriptions_free Ptr (Ptr FontDescription)
maybeDescs Int32
nDescs
    Maybe [FontDescription] -> ([FontDescription] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [FontDescription]
descs ((FontDescription -> IO ()) -> [FontDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FontDescription -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Font::deserialize
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoContext`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bytes containing the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Font" })
-- throws : True
-- Skip return : False

foreign import ccall "pango_font_deserialize" pango_font_deserialize :: 
    Ptr Pango.Context.Context ->            -- context : TInterface (Name {namespace = "Pango", name = "Context"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Font)

-- | Loads data previously created via 'GI.Pango.Objects.Font.fontSerialize'.
-- 
-- For a discussion of the supported format, see that function.
-- 
-- Note: to verify that the returned font is identical to
-- the one that was serialized, you can compare /@bytes@/ to the
-- result of serializing the font again.
-- 
-- /Since: 1.50/
fontDeserialize ::
    (B.CallStack.HasCallStack, MonadIO m, Pango.Context.IsContext a) =>
    a
    -- ^ /@context@/: a @PangoContext@
    -> GLib.Bytes.Bytes
    -- ^ /@bytes@/: the bytes containing the data
    -> m (Maybe Font)
    -- ^ __Returns:__ a new @PangoFont@ /(Can throw 'Data.GI.Base.GError.GError')/
fontDeserialize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Bytes -> m (Maybe Font)
fontDeserialize a
context Bytes
bytes = IO (Maybe Font) -> m (Maybe Font)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Font) -> m (Maybe Font))
-> IO (Maybe Font) -> m (Maybe Font)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    IO (Maybe Font) -> IO () -> IO (Maybe Font)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Font
result <- (Ptr (Ptr GError) -> IO (Ptr Font)) -> IO (Ptr Font)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Font)) -> IO (Ptr Font))
-> (Ptr (Ptr GError) -> IO (Ptr Font)) -> IO (Ptr Font)
forall a b. (a -> b) -> a -> b
$ Ptr Context -> Ptr Bytes -> Ptr (Ptr GError) -> IO (Ptr Font)
pango_font_deserialize Ptr Context
context' Ptr Bytes
bytes'
        Maybe Font
maybeResult <- Ptr Font -> (Ptr Font -> IO Font) -> IO (Maybe Font)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Font
result ((Ptr Font -> IO Font) -> IO (Maybe Font))
-> (Ptr Font -> IO Font) -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$ \Ptr Font
result' -> do
            Font
result'' <- ((ManagedPtr Font -> Font) -> Ptr Font -> IO Font
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Font -> Font
Font) Ptr Font
result'
            Font -> IO Font
forall (m :: * -> *) a. Monad m => a -> m a
return Font
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
        Maybe Font -> IO (Maybe Font)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Font
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif