{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @PangoCairoFontMap@ is an interface exported by font maps for
-- use with Cairo.
-- 
-- The actual type of the font map will depend on the particular
-- font technology Cairo was compiled to use.
-- 
-- /Since: 1.10/

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

module GI.PangoCairo.Interfaces.FontMap
    ( 

-- * Exported types
    FontMap(..)                             ,
    IsFontMap                               ,
    toFontMap                               ,


 -- * 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"), [changed]("GI.Pango.Objects.FontMap#g:method:changed"), [createContext]("GI.Pango.Objects.FontMap#g:method:createContext"), [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"), [listFamilies]("GI.Pango.Objects.FontMap#g:method:listFamilies"), [loadFont]("GI.Pango.Objects.FontMap#g:method:loadFont"), [loadFontset]("GI.Pango.Objects.FontMap#g:method:loadFontset"), [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"), [getFamily]("GI.Pango.Objects.FontMap#g:method:getFamily"), [getFontType]("GI.PangoCairo.Interfaces.FontMap#g:method:getFontType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResolution]("GI.PangoCairo.Interfaces.FontMap#g:method:getResolution"), [getSerial]("GI.Pango.Objects.FontMap#g:method:getSerial").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefault]("GI.PangoCairo.Interfaces.FontMap#g:method:setDefault"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setResolution]("GI.PangoCairo.Interfaces.FontMap#g:method:setResolution").

#if defined(ENABLE_OVERLOADING)
    ResolveFontMapMethod                    ,
#endif

-- ** getDefault #method:getDefault#

    fontMapGetDefault                       ,


-- ** getFontType #method:getFontType#

#if defined(ENABLE_OVERLOADING)
    FontMapGetFontTypeMethodInfo            ,
#endif
    fontMapGetFontType                      ,


-- ** getResolution #method:getResolution#

#if defined(ENABLE_OVERLOADING)
    FontMapGetResolutionMethodInfo          ,
#endif
    fontMapGetResolution                    ,


-- ** new #method:new#

    fontMapNew                              ,


-- ** newForFontType #method:newForFontType#

    fontMapNewForFontType                   ,


-- ** setDefault #method:setDefault#

#if defined(ENABLE_OVERLOADING)
    FontMapSetDefaultMethodInfo             ,
#endif
    fontMapSetDefault                       ,


-- ** setResolution #method:setResolution#

#if defined(ENABLE_OVERLOADING)
    FontMapSetResolutionMethodInfo          ,
#endif
    fontMapSetResolution                    ,




    ) 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.Cairo.Enums as Cairo.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Pango.Objects.FontMap as Pango.FontMap

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

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

foreign import ccall "pango_cairo_font_map_get_type"
    c_pango_cairo_font_map_get_type :: IO B.Types.GType

instance B.Types.TypedObject FontMap where
    glibType :: IO GType
glibType = IO GType
c_pango_cairo_font_map_get_type

instance B.Types.GObject FontMap

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

instance O.HasParentTypes FontMap
type instance O.ParentTypes FontMap = '[Pango.FontMap.FontMap, GObject.Object.Object]

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFontMapMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontMapMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFontMapMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFontMapMethod "changed" o = Pango.FontMap.FontMapChangedMethodInfo
    ResolveFontMapMethod "createContext" o = Pango.FontMap.FontMapCreateContextMethodInfo
    ResolveFontMapMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFontMapMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFontMapMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFontMapMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFontMapMethod "listFamilies" o = Pango.FontMap.FontMapListFamiliesMethodInfo
    ResolveFontMapMethod "loadFont" o = Pango.FontMap.FontMapLoadFontMethodInfo
    ResolveFontMapMethod "loadFontset" o = Pango.FontMap.FontMapLoadFontsetMethodInfo
    ResolveFontMapMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFontMapMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFontMapMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFontMapMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFontMapMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFontMapMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFontMapMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFontMapMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFontMapMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFontMapMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFontMapMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFontMapMethod "getFamily" o = Pango.FontMap.FontMapGetFamilyMethodInfo
    ResolveFontMapMethod "getFontType" o = FontMapGetFontTypeMethodInfo
    ResolveFontMapMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFontMapMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFontMapMethod "getResolution" o = FontMapGetResolutionMethodInfo
    ResolveFontMapMethod "getSerial" o = Pango.FontMap.FontMapGetSerialMethodInfo
    ResolveFontMapMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFontMapMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFontMapMethod "setDefault" o = FontMapSetDefaultMethodInfo
    ResolveFontMapMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFontMapMethod "setResolution" o = FontMapSetResolutionMethodInfo
    ResolveFontMapMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method FontMap::get_font_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "fontmap"
--           , argType =
--               TInterface Name { namespace = "PangoCairo" , name = "FontMap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoCairoFontMap`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "FontType" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_cairo_font_map_get_font_type" pango_cairo_font_map_get_font_type :: 
    Ptr FontMap ->                          -- fontmap : TInterface (Name {namespace = "PangoCairo", name = "FontMap"})
    IO CUInt

-- | Gets the type of Cairo font backend that /@fontmap@/ uses.
-- 
-- /Since: 1.18/
fontMapGetFontType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontMap a) =>
    a
    -- ^ /@fontmap@/: a @PangoCairoFontMap@
    -> m Cairo.Enums.FontType
    -- ^ __Returns:__ the @cairo_font_type_t@ cairo font backend type
fontMapGetFontType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontMap a) =>
a -> m FontType
fontMapGetFontType a
fontmap = IO FontType -> m FontType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontType -> m FontType) -> IO FontType -> m FontType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMap
fontmap' <- a -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
fontmap
    CUInt
result <- Ptr FontMap -> IO CUInt
pango_cairo_font_map_get_font_type Ptr FontMap
fontmap'
    let result' :: FontType
result' = (Int -> FontType
forall a. Enum a => Int -> a
toEnum (Int -> FontType) -> (CUInt -> Int) -> CUInt -> FontType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
fontmap
    FontType -> IO FontType
forall (m :: * -> *) a. Monad m => a -> m a
return FontType
result'

#if defined(ENABLE_OVERLOADING)
data FontMapGetFontTypeMethodInfo
instance (signature ~ (m Cairo.Enums.FontType), MonadIO m, IsFontMap a) => O.OverloadedMethod FontMapGetFontTypeMethodInfo a signature where
    overloadedMethod = fontMapGetFontType

instance O.OverloadedMethodInfo FontMapGetFontTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.PangoCairo.Interfaces.FontMap.fontMapGetFontType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pangocairo-1.0.26/docs/GI-PangoCairo-Interfaces-FontMap.html#v:fontMapGetFontType"
        })


#endif

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

foreign import ccall "pango_cairo_font_map_get_resolution" pango_cairo_font_map_get_resolution :: 
    Ptr FontMap ->                          -- fontmap : TInterface (Name {namespace = "PangoCairo", name = "FontMap"})
    IO CDouble

-- | Gets the resolution for the fontmap.
-- 
-- See 'GI.PangoCairo.Interfaces.FontMap.fontMapSetResolution'.
-- 
-- /Since: 1.10/
fontMapGetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontMap a) =>
    a
    -- ^ /@fontmap@/: a @PangoCairoFontMap@
    -> m Double
    -- ^ __Returns:__ the resolution in \"dots per inch\"
fontMapGetResolution :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontMap a) =>
a -> m Double
fontMapGetResolution a
fontmap = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMap
fontmap' <- a -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
fontmap
    CDouble
result <- Ptr FontMap -> IO CDouble
pango_cairo_font_map_get_resolution Ptr FontMap
fontmap'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
fontmap
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data FontMapGetResolutionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsFontMap a) => O.OverloadedMethod FontMapGetResolutionMethodInfo a signature where
    overloadedMethod = fontMapGetResolution

instance O.OverloadedMethodInfo FontMapGetResolutionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.PangoCairo.Interfaces.FontMap.fontMapGetResolution",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pangocairo-1.0.26/docs/GI-PangoCairo-Interfaces-FontMap.html#v:fontMapGetResolution"
        })


#endif

-- method FontMap::set_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "fontmap"
--           , argType =
--               TInterface Name { namespace = "PangoCairo" , name = "FontMap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new default font map"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_cairo_font_map_set_default" pango_cairo_font_map_set_default :: 
    Ptr FontMap ->                          -- fontmap : TInterface (Name {namespace = "PangoCairo", name = "FontMap"})
    IO ()

-- | Sets a default @PangoCairoFontMap@ to use with Cairo.
-- 
-- This can be used to change the Cairo font backend that the
-- default fontmap uses for example. The old default font map
-- is unreffed and the new font map referenced.
-- 
-- Note that since Pango 1.32.6, the default fontmap is per-thread.
-- This function only changes the default fontmap for
-- the current thread. Default fontmaps of existing threads
-- are not changed. Default fontmaps of any new threads will
-- still be created using [func/@pangoCairo@/.FontMap.new].
-- 
-- A value of 'P.Nothing' for /@fontmap@/ will cause the current default
-- font map to be released and a new default font map to be created
-- on demand, using [func/@pangoCairo@/.FontMap.new].
-- 
-- /Since: 1.22/
fontMapSetDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontMap a) =>
    a
    -- ^ /@fontmap@/: The new default font map
    -> m ()
fontMapSetDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontMap a) =>
a -> m ()
fontMapSetDefault a
fontmap = 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 FontMap
fontmap' <- a -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
fontmap
    Ptr FontMap -> IO ()
pango_cairo_font_map_set_default Ptr FontMap
fontmap'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
fontmap
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontMapSetDefaultMethodInfo
instance (signature ~ (m ()), MonadIO m, IsFontMap a) => O.OverloadedMethod FontMapSetDefaultMethodInfo a signature where
    overloadedMethod = fontMapSetDefault

instance O.OverloadedMethodInfo FontMapSetDefaultMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.PangoCairo.Interfaces.FontMap.fontMapSetDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pangocairo-1.0.26/docs/GI-PangoCairo-Interfaces-FontMap.html#v:fontMapSetDefault"
        })


#endif

-- method FontMap::set_resolution
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "fontmap"
--           , argType =
--               TInterface Name { namespace = "PangoCairo" , name = "FontMap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `PangoCairoFontMap`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dpi"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the resolution in \"dots per inch\". (Physical inches aren't actually\n  involved; the terminology is conventional.)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_cairo_font_map_set_resolution" pango_cairo_font_map_set_resolution :: 
    Ptr FontMap ->                          -- fontmap : TInterface (Name {namespace = "PangoCairo", name = "FontMap"})
    CDouble ->                              -- dpi : TBasicType TDouble
    IO ()

-- | Sets the resolution for the fontmap.
-- 
-- This is a scale factor between
-- points specified in a @PangoFontDescription@ and Cairo units. The
-- default value is 96, meaning that a 10 point font will be 13
-- units high. (10 * 96. \/ 72. = 13.3).
-- 
-- /Since: 1.10/
fontMapSetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsFontMap a) =>
    a
    -- ^ /@fontmap@/: a @PangoCairoFontMap@
    -> Double
    -- ^ /@dpi@/: the resolution in \"dots per inch\". (Physical inches aren\'t actually
    --   involved; the terminology is conventional.)
    -> m ()
fontMapSetResolution :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontMap a) =>
a -> Double -> m ()
fontMapSetResolution a
fontmap Double
dpi = 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 FontMap
fontmap' <- a -> IO (Ptr FontMap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
fontmap
    let dpi' :: CDouble
dpi' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dpi
    Ptr FontMap -> CDouble -> IO ()
pango_cairo_font_map_set_resolution Ptr FontMap
fontmap' CDouble
dpi'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
fontmap
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontMapSetResolutionMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsFontMap a) => O.OverloadedMethod FontMapSetResolutionMethodInfo a signature where
    overloadedMethod = fontMapSetResolution

instance O.OverloadedMethodInfo FontMapSetResolutionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.PangoCairo.Interfaces.FontMap.fontMapSetResolution",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-pangocairo-1.0.26/docs/GI-PangoCairo-Interfaces-FontMap.html#v:fontMapSetResolution"
        })


#endif

-- method FontMap::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "PangoCairo" , name = "FontMap" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_cairo_font_map_get_default" pango_cairo_font_map_get_default :: 
    IO (Ptr FontMap)

-- | Gets a default @PangoCairoFontMap@ to use with Cairo.
-- 
-- Note that the type of the returned object will depend on the
-- particular font backend Cairo was compiled to use; you generally
-- should only use the @PangoFontMap@ and @PangoCairoFontMap@
-- interfaces on the returned object.
-- 
-- The default Cairo fontmap can be changed by using
-- 'GI.PangoCairo.Interfaces.FontMap.fontMapSetDefault'. This can be used to
-- change the Cairo font backend that the default fontmap uses
-- for example.
-- 
-- Note that since Pango 1.32.6, the default fontmap is per-thread.
-- Each thread gets its own default fontmap. In this way, PangoCairo
-- can be used safely from multiple threads.
-- 
-- /Since: 1.10/
fontMapGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FontMap
    -- ^ __Returns:__ the default PangoCairo fontmap
    --  for the current thread. This object is owned by Pango and must
    --  not be freed.
fontMapGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FontMap
fontMapGetDefault  = IO FontMap -> m FontMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMap -> m FontMap) -> IO FontMap -> m FontMap
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMap
result <- IO (Ptr FontMap)
pango_cairo_font_map_get_default
    Text -> Ptr FontMap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontMapGetDefault" Ptr FontMap
result
    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
FontMap) Ptr FontMap
result
    FontMap -> IO FontMap
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "pango_cairo_font_map_new" pango_cairo_font_map_new :: 
    IO (Ptr FontMap)

-- | Creates a new @PangoCairoFontMap@ object.
-- 
-- A fontmap is used to cache information about available fonts,
-- and holds certain global parameters such as the resolution.
-- In most cases, you can use @func\@PangoCairo.font_map_get_default]
-- instead.
-- 
-- Note that the type of the returned object will depend
-- on the particular font backend Cairo was compiled to use;
-- You generally should only use the @PangoFontMap@ and
-- @PangoCairoFontMap\` interfaces on the returned object.
-- 
-- You can override the type of backend returned by using an
-- environment variable @/PANGOCAIRO_BACKEND/@. Supported types,
-- based on your build, are fc (fontconfig), win32, and coretext.
-- If requested type is not available, NULL is returned. Ie.
-- this is only useful for testing, when at least two backends
-- are compiled in.
-- 
-- /Since: 1.10/
fontMapNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FontMap
    -- ^ __Returns:__ the newly allocated @PangoFontMap@,
    --   which should be freed with 'GI.GObject.Objects.Object.objectUnref'.
fontMapNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FontMap
fontMapNew  = IO FontMap -> m FontMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMap -> m FontMap) -> IO FontMap -> m FontMap
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMap
result <- IO (Ptr FontMap)
pango_cairo_font_map_new
    Text -> Ptr FontMap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontMapNew" Ptr FontMap
result
    FontMap
result' <- ((ManagedPtr FontMap -> FontMap) -> Ptr FontMap -> IO FontMap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FontMap -> FontMap
FontMap) Ptr FontMap
result
    FontMap -> IO FontMap
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FontMap::new_for_font_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "fonttype"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "FontType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "desired #cairo_font_type_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "PangoCairo" , name = "FontMap" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_cairo_font_map_new_for_font_type" pango_cairo_font_map_new_for_font_type :: 
    CUInt ->                                -- fonttype : TInterface (Name {namespace = "cairo", name = "FontType"})
    IO (Ptr FontMap)

-- | Creates a new @PangoCairoFontMap@ object of the type suitable
-- to be used with cairo font backend of type /@fonttype@/.
-- 
-- In most cases one should simply use [func/@pangoCairo@/.FontMap.new], or
-- in fact in most of those cases, just use [func/@pangoCairo@/.FontMap.get_default].
-- 
-- /Since: 1.18/
fontMapNewForFontType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Enums.FontType
    -- ^ /@fonttype@/: desired t'GI.Cairo.Enums.FontType'
    -> m (Maybe FontMap)
    -- ^ __Returns:__ the newly allocated
    --   @PangoFontMap@ of suitable type which should be freed with
    --   'GI.GObject.Objects.Object.objectUnref', or 'P.Nothing' if the requested cairo font backend
    --   is not supported \/ compiled in.
fontMapNewForFontType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontType -> m (Maybe FontMap)
fontMapNewForFontType FontType
fonttype = 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
    let fonttype' :: CUInt
fonttype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (FontType -> Int) -> FontType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontType -> Int
forall a. Enum a => a -> Int
fromEnum) FontType
fonttype
    Ptr FontMap
result <- CUInt -> IO (Ptr FontMap)
pango_cairo_font_map_new_for_font_type CUInt
fonttype'
    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
wrapObject ManagedPtr FontMap -> FontMap
FontMap) Ptr FontMap
result'
        FontMap -> IO FontMap
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result''
    Maybe FontMap -> IO (Maybe FontMap)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontMap
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif