{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @PangoFontFace@ is used to represent a group of fonts with
-- the same family, slant, weight, and width, but varying sizes.

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

module GI.Pango.Objects.FontFace
    ( 

-- * Exported types
    FontFace(..)                            ,
    IsFontFace                              ,
    toFontFace                              ,


 -- * 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.FontFace#g:method:describe"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSynthesized]("GI.Pango.Objects.FontFace#g:method:isSynthesized"), [listSizes]("GI.Pango.Objects.FontFace#g:method:listSizes"), [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"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFaceName]("GI.Pango.Objects.FontFace#g:method:getFaceName"), [getFamily]("GI.Pango.Objects.FontFace#g:method:getFamily"), [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)
    ResolveFontFaceMethod                   ,
#endif

-- ** describe #method:describe#

#if defined(ENABLE_OVERLOADING)
    FontFaceDescribeMethodInfo              ,
#endif
    fontFaceDescribe                        ,


-- ** getFaceName #method:getFaceName#

#if defined(ENABLE_OVERLOADING)
    FontFaceGetFaceNameMethodInfo           ,
#endif
    fontFaceGetFaceName                     ,


-- ** getFamily #method:getFamily#

#if defined(ENABLE_OVERLOADING)
    FontFaceGetFamilyMethodInfo             ,
#endif
    fontFaceGetFamily                       ,


-- ** isSynthesized #method:isSynthesized#

#if defined(ENABLE_OVERLOADING)
    FontFaceIsSynthesizedMethodInfo         ,
#endif
    fontFaceIsSynthesized                   ,


-- ** listSizes #method:listSizes#

#if defined(ENABLE_OVERLOADING)
    FontFaceListSizesMethodInfo             ,
#endif
    fontFaceListSizes                       ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Pango.Objects.FontFamily as Pango.FontFamily
import {-# SOURCE #-} qualified GI.Pango.Structs.FontDescription as Pango.FontDescription

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

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

foreign import ccall "pango_font_face_get_type"
    c_pango_font_face_get_type :: IO B.Types.GType

instance B.Types.TypedObject FontFace where
    glibType :: IO GType
glibType = IO GType
c_pango_font_face_get_type

instance B.Types.GObject FontFace

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFontFaceMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontFaceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFontFaceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFontFaceMethod "describe" o = FontFaceDescribeMethodInfo
    ResolveFontFaceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFontFaceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFontFaceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFontFaceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFontFaceMethod "isSynthesized" o = FontFaceIsSynthesizedMethodInfo
    ResolveFontFaceMethod "listSizes" o = FontFaceListSizesMethodInfo
    ResolveFontFaceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFontFaceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFontFaceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFontFaceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFontFaceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFontFaceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFontFaceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFontFaceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFontFaceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFontFaceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFontFaceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFontFaceMethod "getFaceName" o = FontFaceGetFaceNameMethodInfo
    ResolveFontFaceMethod "getFamily" o = FontFaceGetFamilyMethodInfo
    ResolveFontFaceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFontFaceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFontFaceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFontFaceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFontFaceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFontFaceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method FontFace::describe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoFontFace`" , 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_face_describe" pango_font_face_describe :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO (Ptr Pango.FontDescription.FontDescription)

-- | Returns a font description that matches the face.
-- 
-- The resulting font description will have the family, style,
-- variant, weight and stretch of the face, but its size field
-- will be unset.
fontFaceDescribe ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a @PangoFontFace@
    -> m Pango.FontDescription.FontDescription
    -- ^ __Returns:__ a newly-created @PangoFontDescription@ structure
    --   holding the description of the face. Use 'GI.Pango.Structs.FontDescription.fontDescriptionFree'
    --   to free the result.
fontFaceDescribe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontFace a) =>
a -> m FontDescription
fontFaceDescribe a
face = 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 FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    Ptr FontDescription
result <- Ptr FontFace -> IO (Ptr FontDescription)
pango_font_face_describe Ptr FontFace
face'
    Text -> Ptr FontDescription -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontFaceDescribe" 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
face
    FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceDescribeMethodInfo
instance (signature ~ (m Pango.FontDescription.FontDescription), MonadIO m, IsFontFace a) => O.OverloadedMethod FontFaceDescribeMethodInfo a signature where
    overloadedMethod = fontFaceDescribe

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


#endif

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

foreign import ccall "pango_font_face_get_face_name" pango_font_face_get_face_name :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO CString

-- | Gets a name representing the style of this face.
-- 
-- Note that a font family may contain multiple faces
-- with the same name (e.g. a variable and a non-variable
-- face for the same style).
fontFaceGetFaceName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a @PangoFontFace@.
    -> m T.Text
    -- ^ __Returns:__ the face name for the face. This string is
    --   owned by the face object and must not be modified or freed.
fontFaceGetFaceName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontFace a) =>
a -> m Text
fontFaceGetFaceName a
face = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    CString
result <- Ptr FontFace -> IO CString
pango_font_face_get_face_name Ptr FontFace
face'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontFaceGetFaceName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceGetFaceNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFontFace a) => O.OverloadedMethod FontFaceGetFaceNameMethodInfo a signature where
    overloadedMethod = fontFaceGetFaceName

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


#endif

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

foreign import ccall "pango_font_face_get_family" pango_font_face_get_family :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO (Ptr Pango.FontFamily.FontFamily)

-- | Gets the @PangoFontFamily@ that /@face@/ belongs to.
-- 
-- /Since: 1.46/
fontFaceGetFamily ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a @PangoFontFace@
    -> m Pango.FontFamily.FontFamily
    -- ^ __Returns:__ the @PangoFontFamily@
fontFaceGetFamily :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontFace a) =>
a -> m FontFamily
fontFaceGetFamily a
face = IO FontFamily -> m FontFamily
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontFamily -> m FontFamily) -> IO FontFamily -> m FontFamily
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    Ptr FontFamily
result <- Ptr FontFace -> IO (Ptr FontFamily)
pango_font_face_get_family Ptr FontFace
face'
    Text -> Ptr FontFamily -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontFaceGetFamily" Ptr FontFamily
result
    FontFamily
result' <- ((ManagedPtr FontFamily -> FontFamily)
-> Ptr FontFamily -> IO FontFamily
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontFamily -> FontFamily
Pango.FontFamily.FontFamily) Ptr FontFamily
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    FontFamily -> IO FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceGetFamilyMethodInfo
instance (signature ~ (m Pango.FontFamily.FontFamily), MonadIO m, IsFontFace a) => O.OverloadedMethod FontFaceGetFamilyMethodInfo a signature where
    overloadedMethod = fontFaceGetFamily

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


#endif

-- method FontFace::is_synthesized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoFontFace`" , 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_face_is_synthesized" pango_font_face_is_synthesized :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    IO CInt

-- | Returns whether a @PangoFontFace@ is synthesized.
-- 
-- This will be the case if the underlying font rendering engine
-- creates this face from another face, by shearing, emboldening,
-- lightening or modifying it in some other way.
-- 
-- /Since: 1.18/
fontFaceIsSynthesized ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a @PangoFontFace@
    -> m Bool
    -- ^ __Returns:__ whether /@face@/ is synthesized
fontFaceIsSynthesized :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontFace a) =>
a -> m Bool
fontFaceIsSynthesized a
face = 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 FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    CInt
result <- Ptr FontFace -> IO CInt
pango_font_face_is_synthesized Ptr FontFace
face'
    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
face
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontFaceIsSynthesizedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFontFace a) => O.OverloadedMethod FontFaceIsSynthesizedMethodInfo a signature where
    overloadedMethod = fontFaceIsSynthesized

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


#endif

-- method FontFace::list_sizes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "face"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontFace" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoFontFace`." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sizes"
--           , argType = TCArray False (-1) 2 (TBasicType TInt)
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n  location to store a pointer to an array of int. This array\n  should be freed with g_free()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_sizes"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store the number of elements in @sizes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_sizes"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "location to store the number of elements in @sizes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_font_face_list_sizes" pango_font_face_list_sizes :: 
    Ptr FontFace ->                         -- face : TInterface (Name {namespace = "Pango", name = "FontFace"})
    Ptr (Ptr Int32) ->                      -- sizes : TCArray False (-1) 2 (TBasicType TInt)
    Ptr Int32 ->                            -- n_sizes : TBasicType TInt
    IO ()

-- | List the available sizes for a font.
-- 
-- This is only applicable to bitmap fonts. For scalable fonts, stores
-- 'P.Nothing' at the location pointed to by /@sizes@/ and 0 at the location pointed
-- to by /@nSizes@/. The sizes returned are in Pango units and are sorted
-- in ascending order.
-- 
-- /Since: 1.4/
fontFaceListSizes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontFace a) =>
    a
    -- ^ /@face@/: a @PangoFontFace@.
    -> m ((Maybe [Int32]))
fontFaceListSizes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontFace a) =>
a -> m (Maybe [Int32])
fontFaceListSizes a
face = IO (Maybe [Int32]) -> m (Maybe [Int32])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Int32]) -> m (Maybe [Int32]))
-> IO (Maybe [Int32]) -> m (Maybe [Int32])
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontFace
face' <- a -> IO (Ptr FontFace)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
face
    Ptr (Ptr Int32)
sizes <- IO (Ptr (Ptr Int32))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Int32))
    Ptr Int32
nSizes <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr FontFace -> Ptr (Ptr Int32) -> Ptr Int32 -> IO ()
pango_font_face_list_sizes Ptr FontFace
face' Ptr (Ptr Int32)
sizes Ptr Int32
nSizes
    Int32
nSizes' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nSizes
    Ptr Int32
sizes' <- Ptr (Ptr Int32) -> IO (Ptr Int32)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Int32)
sizes
    Maybe [Int32]
maybeSizes' <- Ptr Int32 -> (Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Int32
sizes' ((Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32]))
-> (Ptr Int32 -> IO [Int32]) -> IO (Maybe [Int32])
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
sizes'' -> do
        [Int32]
sizes''' <- (Int32 -> Ptr Int32 -> IO [Int32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Int32
nSizes') Ptr Int32
sizes''
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
sizes''
        [Int32] -> IO [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
sizes'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
face
    Ptr (Ptr Int32) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Int32)
sizes
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nSizes
    Maybe [Int32] -> IO (Maybe [Int32])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int32]
maybeSizes'

#if defined(ENABLE_OVERLOADING)
data FontFaceListSizesMethodInfo
instance (signature ~ (m ((Maybe [Int32]))), MonadIO m, IsFontFace a) => O.OverloadedMethod FontFaceListSizesMethodInfo a signature where
    overloadedMethod = fontFaceListSizes

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


#endif