{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Pango.Structs.FontMetrics.FontMetrics' structure holds the overall metric information
-- for a font (possibly restricted to a script). The fields of this
-- structure are private to implementations of a font backend. See
-- the documentation of the corresponding getters for documentation
-- of their meaning.

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

module GI.Pango.Structs.FontMetrics
    ( 

-- * Exported types
    FontMetrics(..)                         ,
    newZeroFontMetrics                      ,
    noFontMetrics                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFontMetricsMethod                ,
#endif


-- ** getApproximateCharWidth #method:getApproximateCharWidth#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetApproximateCharWidthMethodInfo,
#endif
    fontMetricsGetApproximateCharWidth      ,


-- ** getApproximateDigitWidth #method:getApproximateDigitWidth#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetApproximateDigitWidthMethodInfo,
#endif
    fontMetricsGetApproximateDigitWidth     ,


-- ** getAscent #method:getAscent#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetAscentMethodInfo          ,
#endif
    fontMetricsGetAscent                    ,


-- ** getDescent #method:getDescent#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetDescentMethodInfo         ,
#endif
    fontMetricsGetDescent                   ,


-- ** getStrikethroughPosition #method:getStrikethroughPosition#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetStrikethroughPositionMethodInfo,
#endif
    fontMetricsGetStrikethroughPosition     ,


-- ** getStrikethroughThickness #method:getStrikethroughThickness#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetStrikethroughThicknessMethodInfo,
#endif
    fontMetricsGetStrikethroughThickness    ,


-- ** getUnderlinePosition #method:getUnderlinePosition#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetUnderlinePositionMethodInfo,
#endif
    fontMetricsGetUnderlinePosition         ,


-- ** getUnderlineThickness #method:getUnderlineThickness#

#if defined(ENABLE_OVERLOADING)
    FontMetricsGetUnderlineThicknessMethodInfo,
#endif
    fontMetricsGetUnderlineThickness        ,


-- ** new #method:new#

    fontMetricsNew                          ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    FontMetricsRefMethodInfo                ,
#endif
    fontMetricsRef                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    FontMetricsUnrefMethodInfo              ,
#endif
    fontMetricsUnref                        ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified 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


-- | Memory-managed wrapper type.
newtype FontMetrics = FontMetrics (ManagedPtr FontMetrics)
    deriving (FontMetrics -> FontMetrics -> Bool
(FontMetrics -> FontMetrics -> Bool)
-> (FontMetrics -> FontMetrics -> Bool) -> Eq FontMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontMetrics -> FontMetrics -> Bool
$c/= :: FontMetrics -> FontMetrics -> Bool
== :: FontMetrics -> FontMetrics -> Bool
$c== :: FontMetrics -> FontMetrics -> Bool
Eq)
foreign import ccall "pango_font_metrics_get_type" c_pango_font_metrics_get_type :: 
    IO GType

instance BoxedObject FontMetrics where
    boxedType :: FontMetrics -> IO GType
boxedType _ = IO GType
c_pango_font_metrics_get_type

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

-- | Construct a `FontMetrics` struct initialized to zero.
newZeroFontMetrics :: MonadIO m => m FontMetrics
newZeroFontMetrics :: m FontMetrics
newZeroFontMetrics = 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
$ Int -> IO (Ptr FontMetrics)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 36 IO (Ptr FontMetrics)
-> (Ptr FontMetrics -> IO FontMetrics) -> IO FontMetrics
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr FontMetrics -> FontMetrics)
-> Ptr FontMetrics -> IO FontMetrics
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontMetrics -> FontMetrics
FontMetrics

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


-- | A convenience alias for `Nothing` :: `Maybe` `FontMetrics`.
noFontMetrics :: Maybe FontMetrics
noFontMetrics :: Maybe FontMetrics
noFontMetrics = Maybe FontMetrics
forall a. Maybe a
Nothing


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

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

foreign import ccall "pango_font_metrics_new" pango_font_metrics_new :: 
    IO (Ptr FontMetrics)

-- | Creates a new t'GI.Pango.Structs.FontMetrics.FontMetrics' structure. This is only for
-- internal use by Pango backends and there is no public way
-- to set the fields of the structure.
fontMetricsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FontMetrics
    -- ^ __Returns:__ a newly-created t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    --   with a reference count of 1.
fontMetricsNew :: m FontMetrics
fontMetricsNew  = 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 FontMetrics
result <- IO (Ptr FontMetrics)
pango_font_metrics_new
    Text -> Ptr FontMetrics -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "fontMetricsNew" Ptr FontMetrics
result
    FontMetrics
result' <- ((ManagedPtr FontMetrics -> FontMetrics)
-> Ptr FontMetrics -> IO FontMetrics
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontMetrics -> FontMetrics
FontMetrics) Ptr FontMetrics
result
    FontMetrics -> IO FontMetrics
forall (m :: * -> *) a. Monad m => a -> m a
return FontMetrics
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "pango_font_metrics_get_approximate_char_width" pango_font_metrics_get_approximate_char_width :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the approximate character width for a font metrics structure.
-- This is merely a representative value useful, for example, for
-- determining the initial size for a window. Actual characters in
-- text will be wider and narrower than this.
fontMetricsGetApproximateCharWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the character width, in Pango units.
fontMetricsGetApproximateCharWidth :: FontMetrics -> m Int32
fontMetricsGetApproximateCharWidth metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_approximate_char_width Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetApproximateCharWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetApproximateCharWidthMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetApproximateCharWidth

#endif

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

foreign import ccall "pango_font_metrics_get_approximate_digit_width" pango_font_metrics_get_approximate_digit_width :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the approximate digit width for a font metrics structure.
-- This is merely a representative value useful, for example, for
-- determining the initial size for a window. Actual digits in
-- text can be wider or narrower than this, though this value
-- is generally somewhat more accurate than the result of
-- 'GI.Pango.Structs.FontMetrics.fontMetricsGetApproximateCharWidth' for digits.
fontMetricsGetApproximateDigitWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the digit width, in Pango units.
fontMetricsGetApproximateDigitWidth :: FontMetrics -> m Int32
fontMetricsGetApproximateDigitWidth metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_approximate_digit_width Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetApproximateDigitWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetApproximateDigitWidthMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetApproximateDigitWidth

#endif

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

foreign import ccall "pango_font_metrics_get_ascent" pango_font_metrics_get_ascent :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the ascent from a font metrics structure. The ascent is
-- the distance from the baseline to the logical top of a line
-- of text. (The logical top may be above or below the top of the
-- actual drawn ink. It is necessary to lay out the text to figure
-- where the ink will be.)
fontMetricsGetAscent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the ascent, in Pango units.
fontMetricsGetAscent :: FontMetrics -> m Int32
fontMetricsGetAscent metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_ascent Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetAscentMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetAscentMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetAscent

#endif

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

foreign import ccall "pango_font_metrics_get_descent" pango_font_metrics_get_descent :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the descent from a font metrics structure. The descent is
-- the distance from the baseline to the logical bottom of a line
-- of text. (The logical bottom may be above or below the bottom of the
-- actual drawn ink. It is necessary to lay out the text to figure
-- where the ink will be.)
fontMetricsGetDescent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the descent, in Pango units.
fontMetricsGetDescent :: FontMetrics -> m Int32
fontMetricsGetDescent metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_descent Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetDescentMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetDescentMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetDescent

#endif

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

foreign import ccall "pango_font_metrics_get_strikethrough_position" pango_font_metrics_get_strikethrough_position :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the suggested position to draw the strikethrough.
-- The value returned is the distance \<emphasis>above\<\/emphasis> the
-- baseline of the top of the strikethrough.
-- 
-- /Since: 1.6/
fontMetricsGetStrikethroughPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the suggested strikethrough position, in Pango units.
fontMetricsGetStrikethroughPosition :: FontMetrics -> m Int32
fontMetricsGetStrikethroughPosition metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_strikethrough_position Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetStrikethroughPositionMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetStrikethroughPositionMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetStrikethroughPosition

#endif

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

foreign import ccall "pango_font_metrics_get_strikethrough_thickness" pango_font_metrics_get_strikethrough_thickness :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the suggested thickness to draw for the strikethrough.
-- 
-- /Since: 1.6/
fontMetricsGetStrikethroughThickness ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the suggested strikethrough thickness, in Pango units.
fontMetricsGetStrikethroughThickness :: FontMetrics -> m Int32
fontMetricsGetStrikethroughThickness metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_strikethrough_thickness Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetStrikethroughThicknessMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetStrikethroughThicknessMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetStrikethroughThickness

#endif

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

foreign import ccall "pango_font_metrics_get_underline_position" pango_font_metrics_get_underline_position :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the suggested position to draw the underline.
-- The value returned is the distance \<emphasis>above\<\/emphasis> the
-- baseline of the top of the underline. Since most fonts have
-- underline positions beneath the baseline, this value is typically
-- negative.
-- 
-- /Since: 1.6/
fontMetricsGetUnderlinePosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the suggested underline position, in Pango units.
fontMetricsGetUnderlinePosition :: FontMetrics -> m Int32
fontMetricsGetUnderlinePosition metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_underline_position Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetUnderlinePositionMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetUnderlinePositionMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetUnderlinePosition

#endif

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

foreign import ccall "pango_font_metrics_get_underline_thickness" pango_font_metrics_get_underline_thickness :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO Int32

-- | Gets the suggested thickness to draw for the underline.
-- 
-- /Since: 1.6/
fontMetricsGetUnderlineThickness ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure
    -> m Int32
    -- ^ __Returns:__ the suggested underline thickness, in Pango units.
fontMetricsGetUnderlineThickness :: FontMetrics -> m Int32
fontMetricsGetUnderlineThickness metrics :: FontMetrics
metrics = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Int32
result <- Ptr FontMetrics -> IO Int32
pango_font_metrics_get_underline_thickness Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FontMetricsGetUnderlineThicknessMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo FontMetricsGetUnderlineThicknessMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsGetUnderlineThickness

#endif

-- method FontMetrics::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "metrics"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "FontMetrics" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoFontMetrics structure, may be %NULL"
--                 , 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_metrics_ref" pango_font_metrics_ref :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO (Ptr FontMetrics)

-- | Increase the reference count of a font metrics structure by one.
fontMetricsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure, may be 'P.Nothing'
    -> m (Maybe FontMetrics)
    -- ^ __Returns:__ /@metrics@/
fontMetricsRef :: FontMetrics -> m (Maybe FontMetrics)
fontMetricsRef metrics :: FontMetrics
metrics = IO (Maybe FontMetrics) -> m (Maybe FontMetrics)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontMetrics) -> m (Maybe FontMetrics))
-> IO (Maybe FontMetrics) -> m (Maybe FontMetrics)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Ptr FontMetrics
result <- Ptr FontMetrics -> IO (Ptr FontMetrics)
pango_font_metrics_ref Ptr FontMetrics
metrics'
    Maybe FontMetrics
maybeResult <- Ptr FontMetrics
-> (Ptr FontMetrics -> IO FontMetrics) -> IO (Maybe FontMetrics)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontMetrics
result ((Ptr FontMetrics -> IO FontMetrics) -> IO (Maybe FontMetrics))
-> (Ptr FontMetrics -> IO FontMetrics) -> IO (Maybe FontMetrics)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr FontMetrics
result' -> do
        FontMetrics
result'' <- ((ManagedPtr FontMetrics -> FontMetrics)
-> Ptr FontMetrics -> IO FontMetrics
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontMetrics -> FontMetrics
FontMetrics) Ptr FontMetrics
result'
        FontMetrics -> IO FontMetrics
forall (m :: * -> *) a. Monad m => a -> m a
return FontMetrics
result''
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    Maybe FontMetrics -> IO (Maybe FontMetrics)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontMetrics
maybeResult

#if defined(ENABLE_OVERLOADING)
data FontMetricsRefMethodInfo
instance (signature ~ (m (Maybe FontMetrics)), MonadIO m) => O.MethodInfo FontMetricsRefMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsRef

#endif

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

foreign import ccall "pango_font_metrics_unref" pango_font_metrics_unref :: 
    Ptr FontMetrics ->                      -- metrics : TInterface (Name {namespace = "Pango", name = "FontMetrics"})
    IO ()

-- | Decrease the reference count of a font metrics structure by one. If
-- the result is zero, frees the structure and any associated
-- memory.
fontMetricsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontMetrics
    -- ^ /@metrics@/: a t'GI.Pango.Structs.FontMetrics.FontMetrics' structure, may be 'P.Nothing'
    -> m ()
fontMetricsUnref :: FontMetrics -> m ()
fontMetricsUnref metrics :: FontMetrics
metrics = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMetrics
metrics' <- FontMetrics -> IO (Ptr FontMetrics)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontMetrics
metrics
    Ptr FontMetrics -> IO ()
pango_font_metrics_unref Ptr FontMetrics
metrics'
    FontMetrics -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontMetrics
metrics
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontMetricsUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FontMetricsUnrefMethodInfo FontMetrics signature where
    overloadedMethod = fontMetricsUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFontMetricsMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontMetricsMethod "ref" o = FontMetricsRefMethodInfo
    ResolveFontMetricsMethod "unref" o = FontMetricsUnrefMethodInfo
    ResolveFontMetricsMethod "getApproximateCharWidth" o = FontMetricsGetApproximateCharWidthMethodInfo
    ResolveFontMetricsMethod "getApproximateDigitWidth" o = FontMetricsGetApproximateDigitWidthMethodInfo
    ResolveFontMetricsMethod "getAscent" o = FontMetricsGetAscentMethodInfo
    ResolveFontMetricsMethod "getDescent" o = FontMetricsGetDescentMethodInfo
    ResolveFontMetricsMethod "getStrikethroughPosition" o = FontMetricsGetStrikethroughPositionMethodInfo
    ResolveFontMetricsMethod "getStrikethroughThickness" o = FontMetricsGetStrikethroughThicknessMethodInfo
    ResolveFontMetricsMethod "getUnderlinePosition" o = FontMetricsGetUnderlinePositionMethodInfo
    ResolveFontMetricsMethod "getUnderlineThickness" o = FontMetricsGetUnderlineThicknessMethodInfo
    ResolveFontMetricsMethod l o = O.MethodResolutionFailed l o

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

#endif