{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A render node drawing a set of glyphs.

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

module GI.Gsk.Objects.TextNode
    ( 

-- * Exported types
    TextNode(..)                            ,
    IsTextNode                              ,
    toTextNode                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [draw]("GI.Gsk.Objects.RenderNode#g:method:draw"), [hasColorGlyphs]("GI.Gsk.Objects.TextNode#g:method:hasColorGlyphs"), [ref]("GI.Gsk.Objects.RenderNode#g:method:ref"), [serialize]("GI.Gsk.Objects.RenderNode#g:method:serialize"), [unref]("GI.Gsk.Objects.RenderNode#g:method:unref"), [writeToFile]("GI.Gsk.Objects.RenderNode#g:method:writeToFile").
-- 
-- ==== Getters
-- [getBounds]("GI.Gsk.Objects.RenderNode#g:method:getBounds"), [getColor]("GI.Gsk.Objects.TextNode#g:method:getColor"), [getFont]("GI.Gsk.Objects.TextNode#g:method:getFont"), [getGlyphs]("GI.Gsk.Objects.TextNode#g:method:getGlyphs"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType"), [getNumGlyphs]("GI.Gsk.Objects.TextNode#g:method:getNumGlyphs"), [getOffset]("GI.Gsk.Objects.TextNode#g:method:getOffset").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTextNodeMethod                   ,
#endif

-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    TextNodeGetColorMethodInfo              ,
#endif
    textNodeGetColor                        ,


-- ** getFont #method:getFont#

#if defined(ENABLE_OVERLOADING)
    TextNodeGetFontMethodInfo               ,
#endif
    textNodeGetFont                         ,


-- ** getGlyphs #method:getGlyphs#

#if defined(ENABLE_OVERLOADING)
    TextNodeGetGlyphsMethodInfo             ,
#endif
    textNodeGetGlyphs                       ,


-- ** getNumGlyphs #method:getNumGlyphs#

#if defined(ENABLE_OVERLOADING)
    TextNodeGetNumGlyphsMethodInfo          ,
#endif
    textNodeGetNumGlyphs                    ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    TextNodeGetOffsetMethodInfo             ,
#endif
    textNodeGetOffset                       ,


-- ** hasColorGlyphs #method:hasColorGlyphs#

#if defined(ENABLE_OVERLOADING)
    TextNodeHasColorGlyphsMethodInfo        ,
#endif
    textNodeHasColorGlyphs                  ,


-- ** new #method:new#

    textNodeNew                             ,




    ) 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.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Graphene.Structs.Point as Graphene.Point
import {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Pango.Objects.Font as Pango.Font
import qualified GI.Pango.Structs.GlyphInfo as Pango.GlyphInfo
import qualified GI.Pango.Structs.GlyphString as Pango.GlyphString

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

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

foreign import ccall "gsk_text_node_get_type"
    c_gsk_text_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject TextNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_text_node_get_type

-- | Type class for types which can be safely cast to `TextNode`, for instance with `toTextNode`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf TextNode o) => IsTextNode o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf TextNode o) => IsTextNode o

instance O.HasParentTypes TextNode
type instance O.ParentTypes TextNode = '[Gsk.RenderNode.RenderNode]

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveTextNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveTextNodeMethod "hasColorGlyphs" o = TextNodeHasColorGlyphsMethodInfo
    ResolveTextNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveTextNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveTextNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveTextNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveTextNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveTextNodeMethod "getColor" o = TextNodeGetColorMethodInfo
    ResolveTextNodeMethod "getFont" o = TextNodeGetFontMethodInfo
    ResolveTextNodeMethod "getGlyphs" o = TextNodeGetGlyphsMethodInfo
    ResolveTextNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveTextNodeMethod "getNumGlyphs" o = TextNodeGetNumGlyphsMethodInfo
    ResolveTextNodeMethod "getOffset" o = TextNodeGetOffsetMethodInfo
    ResolveTextNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr TextNode where
    boxedPtrCopy :: TextNode -> IO TextNode
boxedPtrCopy = TextNode -> IO TextNode
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: TextNode -> IO ()
boxedPtrFree = \TextNode
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method TextNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "font"
--           , argType = TInterface Name { namespace = "Pango" , name = "Font" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `PangoFont` containing the glyphs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "glyphs"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "GlyphString" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `PangoGlyphString` to render"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the foreground color to render with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset of the baseline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "TextNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_new" gsk_text_node_new :: 
    Ptr Pango.Font.Font ->                  -- font : TInterface (Name {namespace = "Pango", name = "Font"})
    Ptr Pango.GlyphString.GlyphString ->    -- glyphs : TInterface (Name {namespace = "Pango", name = "GlyphString"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Graphene.Point.Point ->             -- offset : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO (Ptr TextNode)

-- | Creates a render node that renders the given glyphs.
-- 
-- Note that /@color@/ may not be used if the font contains
-- color glyphs.
textNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m, Pango.Font.IsFont a) =>
    a
    -- ^ /@font@/: the @PangoFont@ containing the glyphs
    -> Pango.GlyphString.GlyphString
    -- ^ /@glyphs@/: the @PangoGlyphString@ to render
    -> Gdk.RGBA.RGBA
    -- ^ /@color@/: the foreground color to render with
    -> Graphene.Point.Point
    -- ^ /@offset@/: offset of the baseline
    -> m (Maybe TextNode)
    -- ^ __Returns:__ a new @GskRenderNode@
textNodeNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFont a) =>
a -> GlyphString -> RGBA -> Point -> m (Maybe TextNode)
textNodeNew a
font GlyphString
glyphs RGBA
color Point
offset = IO (Maybe TextNode) -> m (Maybe TextNode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TextNode) -> m (Maybe TextNode))
-> IO (Maybe TextNode) -> m (Maybe TextNode)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Font
font' <- a -> IO (Ptr Font)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
font
    Ptr GlyphString
glyphs' <- GlyphString -> IO (Ptr GlyphString)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GlyphString
glyphs
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    Ptr Point
offset' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
offset
    Ptr TextNode
result <- Ptr Font
-> Ptr GlyphString -> Ptr RGBA -> Ptr Point -> IO (Ptr TextNode)
gsk_text_node_new Ptr Font
font' Ptr GlyphString
glyphs' Ptr RGBA
color' Ptr Point
offset'
    Maybe TextNode
maybeResult <- Ptr TextNode
-> (Ptr TextNode -> IO TextNode) -> IO (Maybe TextNode)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TextNode
result ((Ptr TextNode -> IO TextNode) -> IO (Maybe TextNode))
-> (Ptr TextNode -> IO TextNode) -> IO (Maybe TextNode)
forall a b. (a -> b) -> a -> b
$ \Ptr TextNode
result' -> do
        TextNode
result'' <- ((ManagedPtr TextNode -> TextNode) -> Ptr TextNode -> IO TextNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TextNode -> TextNode
TextNode) Ptr TextNode
result'
        TextNode -> IO TextNode
forall (m :: * -> *) a. Monad m => a -> m a
return TextNode
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
font
    GlyphString -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GlyphString
glyphs
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
offset
    Maybe TextNode -> IO (Maybe TextNode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextNode
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextNode::get_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "RGBA" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_get_color" gsk_text_node_get_color :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    IO (Ptr Gdk.RGBA.RGBA)

-- | Retrieves the color used by the text /@node@/.
textNodeGetColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: a text @GskRenderNode@
    -> m Gdk.RGBA.RGBA
    -- ^ __Returns:__ the text color
textNodeGetColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m RGBA
textNodeGetColor a
node = IO RGBA -> m RGBA
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RGBA -> m RGBA) -> IO RGBA -> m RGBA
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RGBA
result <- Ptr TextNode -> IO (Ptr RGBA)
gsk_text_node_get_color Ptr TextNode
node'
    Text -> Ptr RGBA -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNodeGetColor" Ptr RGBA
result
    RGBA
result' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RGBA -> IO RGBA
forall (m :: * -> *) a. Monad m => a -> m a
return RGBA
result'

#if defined(ENABLE_OVERLOADING)
data TextNodeGetColorMethodInfo
instance (signature ~ (m Gdk.RGBA.RGBA), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeGetColorMethodInfo a signature where
    overloadedMethod = textNodeGetColor

instance O.OverloadedMethodInfo TextNodeGetColorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeGetColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeGetColor"
        })


#endif

-- method TextNode::get_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Font" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_get_font" gsk_text_node_get_font :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    IO (Ptr Pango.Font.Font)

-- | Returns the font used by the text /@node@/.
textNodeGetFont ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: The @GskRenderNode@
    -> m Pango.Font.Font
    -- ^ __Returns:__ the font
textNodeGetFont :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m Font
textNodeGetFont a
node = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Font -> m Font) -> IO Font -> m Font
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr Font
result <- Ptr TextNode -> IO (Ptr Font)
gsk_text_node_get_font Ptr TextNode
node'
    Text -> Ptr Font -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNodeGetFont" Ptr Font
result
    Font
result' <- ((ManagedPtr Font -> Font) -> Ptr Font -> IO Font
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Font -> Font
Pango.Font.Font) Ptr Font
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Font -> IO Font
forall (m :: * -> *) a. Monad m => a -> m a
return Font
result'

#if defined(ENABLE_OVERLOADING)
data TextNodeGetFontMethodInfo
instance (signature ~ (m Pango.Font.Font), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeGetFontMethodInfo a signature where
    overloadedMethod = textNodeGetFont

instance O.OverloadedMethodInfo TextNodeGetFontMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeGetFont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeGetFont"
        })


#endif

-- method TextNode::get_glyphs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_glyphs"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of glyphs returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_glyphs"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of glyphs returned"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TCArray
--                  False
--                  (-1)
--                  1
--                  (TInterface Name { namespace = "Pango" , name = "GlyphInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_get_glyphs" gsk_text_node_get_glyphs :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    Ptr Word32 ->                           -- n_glyphs : TBasicType TUInt
    IO (Ptr Pango.GlyphInfo.GlyphInfo)

-- | Retrieves the glyph information in the /@node@/.
textNodeGetGlyphs ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: a text @GskRenderNode@
    -> m [Pango.GlyphInfo.GlyphInfo]
    -- ^ __Returns:__ the glyph information
textNodeGetGlyphs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m [GlyphInfo]
textNodeGetGlyphs a
node = IO [GlyphInfo] -> m [GlyphInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GlyphInfo] -> m [GlyphInfo])
-> IO [GlyphInfo] -> m [GlyphInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr Word32
nGlyphs <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr GlyphInfo
result <- Ptr TextNode -> Ptr Word32 -> IO (Ptr GlyphInfo)
gsk_text_node_get_glyphs Ptr TextNode
node' Ptr Word32
nGlyphs
    Word32
nGlyphs' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nGlyphs
    Text -> Ptr GlyphInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNodeGetGlyphs" Ptr GlyphInfo
result
    [Ptr GlyphInfo]
result' <- (Int -> Word32 -> Ptr GlyphInfo -> IO [Ptr GlyphInfo]
forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
24 Word32
nGlyphs') Ptr GlyphInfo
result
    [GlyphInfo]
result'' <- (Ptr GlyphInfo -> IO GlyphInfo)
-> [Ptr GlyphInfo] -> IO [GlyphInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr GlyphInfo -> GlyphInfo)
-> Ptr GlyphInfo -> IO GlyphInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr GlyphInfo -> GlyphInfo
Pango.GlyphInfo.GlyphInfo) [Ptr GlyphInfo]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nGlyphs
    [GlyphInfo] -> IO [GlyphInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [GlyphInfo]
result''

#if defined(ENABLE_OVERLOADING)
data TextNodeGetGlyphsMethodInfo
instance (signature ~ (m [Pango.GlyphInfo.GlyphInfo]), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeGetGlyphsMethodInfo a signature where
    overloadedMethod = textNodeGetGlyphs

instance O.OverloadedMethodInfo TextNodeGetGlyphsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeGetGlyphs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeGetGlyphs"
        })


#endif

-- method TextNode::get_num_glyphs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_get_num_glyphs" gsk_text_node_get_num_glyphs :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    IO Word32

-- | Retrieves the number of glyphs in the text node.
textNodeGetNumGlyphs ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: a text @GskRenderNode@
    -> m Word32
    -- ^ __Returns:__ the number of glyphs
textNodeGetNumGlyphs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m Word32
textNodeGetNumGlyphs a
node = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Word32
result <- Ptr TextNode -> IO Word32
gsk_text_node_get_num_glyphs Ptr TextNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextNodeGetNumGlyphsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeGetNumGlyphsMethodInfo a signature where
    overloadedMethod = textNodeGetNumGlyphs

instance O.OverloadedMethodInfo TextNodeGetNumGlyphsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeGetNumGlyphs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeGetNumGlyphs"
        })


#endif

-- method TextNode::get_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Point" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_text_node_get_offset" gsk_text_node_get_offset :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    IO (Ptr Graphene.Point.Point)

-- | Retrieves the offset applied to the text.
textNodeGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: a text @GskRenderNode@
    -> m Graphene.Point.Point
    -- ^ __Returns:__ a point with the horizontal and vertical offsets
textNodeGetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m Point
textNodeGetOffset a
node = IO Point -> m Point
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr Point
result <- Ptr TextNode -> IO (Ptr Point)
gsk_text_node_get_offset Ptr TextNode
node'
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNodeGetOffset" Ptr Point
result
    Point
result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point -> Point
Graphene.Point.Point) Ptr Point
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
data TextNodeGetOffsetMethodInfo
instance (signature ~ (m Graphene.Point.Point), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeGetOffsetMethodInfo a signature where
    overloadedMethod = textNodeGetOffset

instance O.OverloadedMethodInfo TextNodeGetOffsetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeGetOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeGetOffset"
        })


#endif

-- method TextNode::has_color_glyphs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text `GskRenderNode`"
--                 , 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 "gsk_text_node_has_color_glyphs" gsk_text_node_has_color_glyphs :: 
    Ptr TextNode ->                         -- node : TInterface (Name {namespace = "Gsk", name = "TextNode"})
    IO CInt

-- | Checks whether the text /@node@/ has color glyphs.
textNodeHasColorGlyphs ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextNode a) =>
    a
    -- ^ /@node@/: a text @GskRenderNode@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the text node has color glyphs
textNodeHasColorGlyphs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextNode a) =>
a -> m Bool
textNodeHasColorGlyphs a
node = 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 TextNode
node' <- a -> IO (Ptr TextNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CInt
result <- Ptr TextNode -> IO CInt
gsk_text_node_has_color_glyphs Ptr TextNode
node'
    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
node
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextNodeHasColorGlyphsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTextNode a) => O.OverloadedMethod TextNodeHasColorGlyphsMethodInfo a signature where
    overloadedMethod = textNodeHasColorGlyphs

instance O.OverloadedMethodInfo TextNodeHasColorGlyphsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextNode.textNodeHasColorGlyphs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.4/docs/GI-Gsk-Objects-TextNode.html#v:textNodeHasColorGlyphs"
        })


#endif