{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkSnapshot@ assists in creating t'GI.Gsk.Objects.RenderNode.RenderNode's for widgets.
-- 
-- It functions in a similar way to a cairo context, and maintains a stack
-- of render nodes and their associated transformations.
-- 
-- The node at the top of the stack is the one that @gtk_snapshot_append_…()@
-- functions operate on. Use the @gtk_snapshot_push_…()@ functions and
-- [method/@snapshot@/.pop] to change the current node.
-- 
-- The typical way to obtain a @GtkSnapshot@ object is as an argument to
-- the t'GI.Gtk.Objects.Widget.Widget'.@/snapshot/@() vfunc. If you need to create your own
-- @GtkSnapshot@, use 'GI.Gtk.Objects.Snapshot.snapshotNew'.

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

module GI.Gtk.Objects.Snapshot
    ( 

-- * Exported types
    Snapshot(..)                            ,
    IsSnapshot                              ,
    toSnapshot                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendBorder]("GI.Gtk.Objects.Snapshot#g:method:appendBorder"), [appendCairo]("GI.Gtk.Objects.Snapshot#g:method:appendCairo"), [appendColor]("GI.Gtk.Objects.Snapshot#g:method:appendColor"), [appendConicGradient]("GI.Gtk.Objects.Snapshot#g:method:appendConicGradient"), [appendInsetShadow]("GI.Gtk.Objects.Snapshot#g:method:appendInsetShadow"), [appendLayout]("GI.Gtk.Objects.Snapshot#g:method:appendLayout"), [appendLinearGradient]("GI.Gtk.Objects.Snapshot#g:method:appendLinearGradient"), [appendNode]("GI.Gtk.Objects.Snapshot#g:method:appendNode"), [appendOutsetShadow]("GI.Gtk.Objects.Snapshot#g:method:appendOutsetShadow"), [appendRadialGradient]("GI.Gtk.Objects.Snapshot#g:method:appendRadialGradient"), [appendRepeatingLinearGradient]("GI.Gtk.Objects.Snapshot#g:method:appendRepeatingLinearGradient"), [appendRepeatingRadialGradient]("GI.Gtk.Objects.Snapshot#g:method:appendRepeatingRadialGradient"), [appendTexture]("GI.Gtk.Objects.Snapshot#g:method:appendTexture"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [glShaderPopTexture]("GI.Gtk.Objects.Snapshot#g:method:glShaderPopTexture"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [perspective]("GI.Gtk.Objects.Snapshot#g:method:perspective"), [pop]("GI.Gtk.Objects.Snapshot#g:method:pop"), [pushBlend]("GI.Gtk.Objects.Snapshot#g:method:pushBlend"), [pushBlur]("GI.Gtk.Objects.Snapshot#g:method:pushBlur"), [pushClip]("GI.Gtk.Objects.Snapshot#g:method:pushClip"), [pushColorMatrix]("GI.Gtk.Objects.Snapshot#g:method:pushColorMatrix"), [pushCrossFade]("GI.Gtk.Objects.Snapshot#g:method:pushCrossFade"), [pushGlShader]("GI.Gtk.Objects.Snapshot#g:method:pushGlShader"), [pushOpacity]("GI.Gtk.Objects.Snapshot#g:method:pushOpacity"), [pushRepeat]("GI.Gtk.Objects.Snapshot#g:method:pushRepeat"), [pushRoundedClip]("GI.Gtk.Objects.Snapshot#g:method:pushRoundedClip"), [pushShadow]("GI.Gtk.Objects.Snapshot#g:method:pushShadow"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [renderBackground]("GI.Gtk.Objects.Snapshot#g:method:renderBackground"), [renderFocus]("GI.Gtk.Objects.Snapshot#g:method:renderFocus"), [renderFrame]("GI.Gtk.Objects.Snapshot#g:method:renderFrame"), [renderInsertionCursor]("GI.Gtk.Objects.Snapshot#g:method:renderInsertionCursor"), [renderLayout]("GI.Gtk.Objects.Snapshot#g:method:renderLayout"), [restore]("GI.Gtk.Objects.Snapshot#g:method:restore"), [rotate]("GI.Gtk.Objects.Snapshot#g:method:rotate"), [rotate3d]("GI.Gtk.Objects.Snapshot#g:method:rotate3d"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.Gtk.Objects.Snapshot#g:method:save"), [scale]("GI.Gtk.Objects.Snapshot#g:method:scale"), [scale3d]("GI.Gtk.Objects.Snapshot#g:method:scale3d"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toNode]("GI.Gtk.Objects.Snapshot#g:method:toNode"), [toPaintable]("GI.Gtk.Objects.Snapshot#g:method:toPaintable"), [transform]("GI.Gtk.Objects.Snapshot#g:method:transform"), [transformMatrix]("GI.Gtk.Objects.Snapshot#g:method:transformMatrix"), [translate]("GI.Gtk.Objects.Snapshot#g:method:translate"), [translate3d]("GI.Gtk.Objects.Snapshot#g:method:translate3d"), [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"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSnapshotMethod                   ,
#endif

-- ** appendBorder #method:appendBorder#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendBorderMethodInfo          ,
#endif
    snapshotAppendBorder                    ,


-- ** appendCairo #method:appendCairo#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendCairoMethodInfo           ,
#endif
    snapshotAppendCairo                     ,


-- ** appendColor #method:appendColor#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendColorMethodInfo           ,
#endif
    snapshotAppendColor                     ,


-- ** appendConicGradient #method:appendConicGradient#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendConicGradientMethodInfo   ,
#endif
    snapshotAppendConicGradient             ,


-- ** appendInsetShadow #method:appendInsetShadow#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendInsetShadowMethodInfo     ,
#endif
    snapshotAppendInsetShadow               ,


-- ** appendLayout #method:appendLayout#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendLayoutMethodInfo          ,
#endif
    snapshotAppendLayout                    ,


-- ** appendLinearGradient #method:appendLinearGradient#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendLinearGradientMethodInfo  ,
#endif
    snapshotAppendLinearGradient            ,


-- ** appendNode #method:appendNode#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendNodeMethodInfo            ,
#endif
    snapshotAppendNode                      ,


-- ** appendOutsetShadow #method:appendOutsetShadow#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendOutsetShadowMethodInfo    ,
#endif
    snapshotAppendOutsetShadow              ,


-- ** appendRadialGradient #method:appendRadialGradient#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendRadialGradientMethodInfo  ,
#endif
    snapshotAppendRadialGradient            ,


-- ** appendRepeatingLinearGradient #method:appendRepeatingLinearGradient#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendRepeatingLinearGradientMethodInfo,
#endif
    snapshotAppendRepeatingLinearGradient   ,


-- ** appendRepeatingRadialGradient #method:appendRepeatingRadialGradient#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendRepeatingRadialGradientMethodInfo,
#endif
    snapshotAppendRepeatingRadialGradient   ,


-- ** appendTexture #method:appendTexture#

#if defined(ENABLE_OVERLOADING)
    SnapshotAppendTextureMethodInfo         ,
#endif
    snapshotAppendTexture                   ,


-- ** glShaderPopTexture #method:glShaderPopTexture#

#if defined(ENABLE_OVERLOADING)
    SnapshotGlShaderPopTextureMethodInfo    ,
#endif
    snapshotGlShaderPopTexture              ,


-- ** new #method:new#

    snapshotNew                             ,


-- ** perspective #method:perspective#

#if defined(ENABLE_OVERLOADING)
    SnapshotPerspectiveMethodInfo           ,
#endif
    snapshotPerspective                     ,


-- ** pop #method:pop#

#if defined(ENABLE_OVERLOADING)
    SnapshotPopMethodInfo                   ,
#endif
    snapshotPop                             ,


-- ** pushBlend #method:pushBlend#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushBlendMethodInfo             ,
#endif
    snapshotPushBlend                       ,


-- ** pushBlur #method:pushBlur#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushBlurMethodInfo              ,
#endif
    snapshotPushBlur                        ,


-- ** pushClip #method:pushClip#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushClipMethodInfo              ,
#endif
    snapshotPushClip                        ,


-- ** pushColorMatrix #method:pushColorMatrix#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushColorMatrixMethodInfo       ,
#endif
    snapshotPushColorMatrix                 ,


-- ** pushCrossFade #method:pushCrossFade#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushCrossFadeMethodInfo         ,
#endif
    snapshotPushCrossFade                   ,


-- ** pushGlShader #method:pushGlShader#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushGlShaderMethodInfo          ,
#endif
    snapshotPushGlShader                    ,


-- ** pushOpacity #method:pushOpacity#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushOpacityMethodInfo           ,
#endif
    snapshotPushOpacity                     ,


-- ** pushRepeat #method:pushRepeat#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushRepeatMethodInfo            ,
#endif
    snapshotPushRepeat                      ,


-- ** pushRoundedClip #method:pushRoundedClip#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushRoundedClipMethodInfo       ,
#endif
    snapshotPushRoundedClip                 ,


-- ** pushShadow #method:pushShadow#

#if defined(ENABLE_OVERLOADING)
    SnapshotPushShadowMethodInfo            ,
#endif
    snapshotPushShadow                      ,


-- ** renderBackground #method:renderBackground#

#if defined(ENABLE_OVERLOADING)
    SnapshotRenderBackgroundMethodInfo      ,
#endif
    snapshotRenderBackground                ,


-- ** renderFocus #method:renderFocus#

#if defined(ENABLE_OVERLOADING)
    SnapshotRenderFocusMethodInfo           ,
#endif
    snapshotRenderFocus                     ,


-- ** renderFrame #method:renderFrame#

#if defined(ENABLE_OVERLOADING)
    SnapshotRenderFrameMethodInfo           ,
#endif
    snapshotRenderFrame                     ,


-- ** renderInsertionCursor #method:renderInsertionCursor#

#if defined(ENABLE_OVERLOADING)
    SnapshotRenderInsertionCursorMethodInfo ,
#endif
    snapshotRenderInsertionCursor           ,


-- ** renderLayout #method:renderLayout#

#if defined(ENABLE_OVERLOADING)
    SnapshotRenderLayoutMethodInfo          ,
#endif
    snapshotRenderLayout                    ,


-- ** restore #method:restore#

#if defined(ENABLE_OVERLOADING)
    SnapshotRestoreMethodInfo               ,
#endif
    snapshotRestore                         ,


-- ** rotate #method:rotate#

#if defined(ENABLE_OVERLOADING)
    SnapshotRotateMethodInfo                ,
#endif
    snapshotRotate                          ,


-- ** rotate3d #method:rotate3d#

#if defined(ENABLE_OVERLOADING)
    SnapshotRotate3dMethodInfo              ,
#endif
    snapshotRotate3d                        ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    SnapshotSaveMethodInfo                  ,
#endif
    snapshotSave                            ,


-- ** scale #method:scale#

#if defined(ENABLE_OVERLOADING)
    SnapshotScaleMethodInfo                 ,
#endif
    snapshotScale                           ,


-- ** scale3d #method:scale3d#

#if defined(ENABLE_OVERLOADING)
    SnapshotScale3dMethodInfo               ,
#endif
    snapshotScale3d                         ,


-- ** toNode #method:toNode#

#if defined(ENABLE_OVERLOADING)
    SnapshotToNodeMethodInfo                ,
#endif
    snapshotToNode                          ,


-- ** toPaintable #method:toPaintable#

#if defined(ENABLE_OVERLOADING)
    SnapshotToPaintableMethodInfo           ,
#endif
    snapshotToPaintable                     ,


-- ** transform #method:transform#

#if defined(ENABLE_OVERLOADING)
    SnapshotTransformMethodInfo             ,
#endif
    snapshotTransform                       ,


-- ** transformMatrix #method:transformMatrix#

#if defined(ENABLE_OVERLOADING)
    SnapshotTransformMatrixMethodInfo       ,
#endif
    snapshotTransformMatrix                 ,


-- ** translate #method:translate#

#if defined(ENABLE_OVERLOADING)
    SnapshotTranslateMethodInfo             ,
#endif
    snapshotTranslate                       ,


-- ** translate3d #method:translate3d#

#if defined(ENABLE_OVERLOADING)
    SnapshotTranslate3dMethodInfo           ,
#endif
    snapshotTranslate3d                     ,




    ) 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.GHashTable as B.GHT
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.Structs.Context as Cairo.Context
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Layout as Pango.Layout

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

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

foreign import ccall "gtk_snapshot_get_type"
    c_gtk_snapshot_get_type :: IO B.Types.GType

instance B.Types.TypedObject Snapshot where
    glibType :: IO GType
glibType = IO GType
c_gtk_snapshot_get_type

instance B.Types.GObject Snapshot

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

instance O.HasParentTypes Snapshot
type instance O.ParentTypes Snapshot = '[Gdk.Snapshot.Snapshot, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSnapshotMethod (t :: Symbol) (o :: *) :: * where
    ResolveSnapshotMethod "appendBorder" o = SnapshotAppendBorderMethodInfo
    ResolveSnapshotMethod "appendCairo" o = SnapshotAppendCairoMethodInfo
    ResolveSnapshotMethod "appendColor" o = SnapshotAppendColorMethodInfo
    ResolveSnapshotMethod "appendConicGradient" o = SnapshotAppendConicGradientMethodInfo
    ResolveSnapshotMethod "appendInsetShadow" o = SnapshotAppendInsetShadowMethodInfo
    ResolveSnapshotMethod "appendLayout" o = SnapshotAppendLayoutMethodInfo
    ResolveSnapshotMethod "appendLinearGradient" o = SnapshotAppendLinearGradientMethodInfo
    ResolveSnapshotMethod "appendNode" o = SnapshotAppendNodeMethodInfo
    ResolveSnapshotMethod "appendOutsetShadow" o = SnapshotAppendOutsetShadowMethodInfo
    ResolveSnapshotMethod "appendRadialGradient" o = SnapshotAppendRadialGradientMethodInfo
    ResolveSnapshotMethod "appendRepeatingLinearGradient" o = SnapshotAppendRepeatingLinearGradientMethodInfo
    ResolveSnapshotMethod "appendRepeatingRadialGradient" o = SnapshotAppendRepeatingRadialGradientMethodInfo
    ResolveSnapshotMethod "appendTexture" o = SnapshotAppendTextureMethodInfo
    ResolveSnapshotMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnapshotMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnapshotMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnapshotMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnapshotMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnapshotMethod "glShaderPopTexture" o = SnapshotGlShaderPopTextureMethodInfo
    ResolveSnapshotMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnapshotMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnapshotMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnapshotMethod "perspective" o = SnapshotPerspectiveMethodInfo
    ResolveSnapshotMethod "pop" o = SnapshotPopMethodInfo
    ResolveSnapshotMethod "pushBlend" o = SnapshotPushBlendMethodInfo
    ResolveSnapshotMethod "pushBlur" o = SnapshotPushBlurMethodInfo
    ResolveSnapshotMethod "pushClip" o = SnapshotPushClipMethodInfo
    ResolveSnapshotMethod "pushColorMatrix" o = SnapshotPushColorMatrixMethodInfo
    ResolveSnapshotMethod "pushCrossFade" o = SnapshotPushCrossFadeMethodInfo
    ResolveSnapshotMethod "pushGlShader" o = SnapshotPushGlShaderMethodInfo
    ResolveSnapshotMethod "pushOpacity" o = SnapshotPushOpacityMethodInfo
    ResolveSnapshotMethod "pushRepeat" o = SnapshotPushRepeatMethodInfo
    ResolveSnapshotMethod "pushRoundedClip" o = SnapshotPushRoundedClipMethodInfo
    ResolveSnapshotMethod "pushShadow" o = SnapshotPushShadowMethodInfo
    ResolveSnapshotMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnapshotMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnapshotMethod "renderBackground" o = SnapshotRenderBackgroundMethodInfo
    ResolveSnapshotMethod "renderFocus" o = SnapshotRenderFocusMethodInfo
    ResolveSnapshotMethod "renderFrame" o = SnapshotRenderFrameMethodInfo
    ResolveSnapshotMethod "renderInsertionCursor" o = SnapshotRenderInsertionCursorMethodInfo
    ResolveSnapshotMethod "renderLayout" o = SnapshotRenderLayoutMethodInfo
    ResolveSnapshotMethod "restore" o = SnapshotRestoreMethodInfo
    ResolveSnapshotMethod "rotate" o = SnapshotRotateMethodInfo
    ResolveSnapshotMethod "rotate3d" o = SnapshotRotate3dMethodInfo
    ResolveSnapshotMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnapshotMethod "save" o = SnapshotSaveMethodInfo
    ResolveSnapshotMethod "scale" o = SnapshotScaleMethodInfo
    ResolveSnapshotMethod "scale3d" o = SnapshotScale3dMethodInfo
    ResolveSnapshotMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnapshotMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnapshotMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnapshotMethod "toNode" o = SnapshotToNodeMethodInfo
    ResolveSnapshotMethod "toPaintable" o = SnapshotToPaintableMethodInfo
    ResolveSnapshotMethod "transform" o = SnapshotTransformMethodInfo
    ResolveSnapshotMethod "transformMatrix" o = SnapshotTransformMatrixMethodInfo
    ResolveSnapshotMethod "translate" o = SnapshotTranslateMethodInfo
    ResolveSnapshotMethod "translate3d" o = SnapshotTranslate3dMethodInfo
    ResolveSnapshotMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnapshotMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnapshotMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnapshotMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnapshotMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnapshotMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnapshotMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnapshotMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnapshotMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gtk_snapshot_new" gtk_snapshot_new :: 
    IO (Ptr Snapshot)

-- | Creates a new @GtkSnapshot@.
snapshotNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Snapshot
    -- ^ __Returns:__ a newly-allocated @GtkSnapshot@
snapshotNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Snapshot
snapshotNew  = IO Snapshot -> m Snapshot
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Snapshot -> m Snapshot) -> IO Snapshot -> m Snapshot
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
result <- IO (Ptr Snapshot)
gtk_snapshot_new
    Text -> Ptr Snapshot -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snapshotNew" Ptr Snapshot
result
    Snapshot
result' <- ((ManagedPtr Snapshot -> Snapshot) -> Ptr Snapshot -> IO Snapshot
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Snapshot -> Snapshot
Snapshot) Ptr Snapshot
result
    Snapshot -> IO Snapshot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Snapshot
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Snapshot::append_border
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the outline of the border"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_width"
--           , argType = TCArray False 4 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stroke width of the border on\n  the top, right, bottom and left side respectively."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_color"
--           , argType =
--               TCArray
--                 False
--                 4
--                 (-1)
--                 (TInterface Name { namespace = "Gdk" , name = "RGBA" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the color used on the top, right,\n  bottom and left side."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_border" gtk_snapshot_append_border :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr CFloat ->                           -- border_width : TCArray False 4 (-1) (TBasicType TFloat)
    Ptr Gdk.RGBA.RGBA ->                    -- border_color : TCArray False 4 (-1) (TInterface (Name {namespace = "Gdk", name = "RGBA"}))
    IO ()

-- | Appends a stroked border rectangle inside the given /@outline@/.
-- 
-- The four sides of the border can have different widths and colors.
snapshotAppendBorder ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: the outline of the border
    -> [Float]
    -- ^ /@borderWidth@/: the stroke width of the border on
    --   the top, right, bottom and left side respectively.
    -> [Gdk.RGBA.RGBA]
    -- ^ /@borderColor@/: the color used on the top, right,
    --   bottom and left side.
    -> m ()
snapshotAppendBorder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> RoundedRect -> [Float] -> [RGBA] -> m ()
snapshotAppendBorder a
snapshot RoundedRect
outline [Float]
borderWidth [RGBA]
borderColor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RoundedRect
outline' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
outline
    Ptr CFloat
borderWidth' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
borderWidth
    [Ptr RGBA]
borderColor' <- (RGBA -> IO (Ptr RGBA)) -> [RGBA] -> IO [Ptr RGBA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [RGBA]
borderColor
    Ptr RGBA
borderColor'' <- Int -> [Ptr RGBA] -> IO (Ptr RGBA)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr RGBA]
borderColor'
    Ptr Snapshot -> Ptr RoundedRect -> Ptr CFloat -> Ptr RGBA -> IO ()
gtk_snapshot_append_border Ptr Snapshot
snapshot' Ptr RoundedRect
outline' Ptr CFloat
borderWidth' Ptr RGBA
borderColor''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    (RGBA -> IO ()) -> [RGBA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RGBA]
borderColor
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
borderWidth'
    Ptr RGBA -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr RGBA
borderColor''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendBorderMethodInfo
instance (signature ~ (Gsk.RoundedRect.RoundedRect -> [Float] -> [Gdk.RGBA.RGBA] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendBorderMethodInfo a signature where
    overloadedMethod = snapshotAppendBorder

instance O.OverloadedMethodInfo SnapshotAppendBorderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendBorder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendBorder"
        })


#endif

-- method Snapshot::append_cairo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds for the new node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_cairo" gtk_snapshot_append_cairo :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO (Ptr Cairo.Context.Context)

-- | Creates a new t'GI.Gsk.Objects.CairoNode.CairoNode' and appends it to the current
-- render node of /@snapshot@/, without changing the current node.
snapshotAppendCairo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds for the new node
    -> m Cairo.Context.Context
    -- ^ __Returns:__ a @cairo_t@ suitable for drawing the contents of
    --   the newly created render node
snapshotAppendCairo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> m Context
snapshotAppendCairo a
snapshot Rect
bounds = IO Context -> m Context
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Context
result <- Ptr Snapshot -> Ptr Rect -> IO (Ptr Context)
gtk_snapshot_append_cairo Ptr Snapshot
snapshot' Ptr Rect
bounds'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snapshotAppendCairo" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Cairo.Context.Context) Ptr Context
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendCairoMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> m Cairo.Context.Context), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendCairoMethodInfo a signature where
    overloadedMethod = snapshotAppendCairo

instance O.OverloadedMethodInfo SnapshotAppendCairoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendCairo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendCairo"
        })


#endif

-- method Snapshot::append_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , 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 color to draw" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds for the new node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_color" gtk_snapshot_append_color :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Creates a new render node drawing the /@color@/ into the
-- given /@bounds@/ and appends it to the current render node
-- of /@snapshot@/.
-- 
-- You should try to avoid calling this function if
-- /@color@/ is transparent.
snapshotAppendColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gdk.RGBA.RGBA
    -- ^ /@color@/: the color to draw
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds for the new node
    -> m ()
snapshotAppendColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> RGBA -> Rect -> m ()
snapshotAppendColor a
snapshot RGBA
color Rect
bounds = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Snapshot -> Ptr RGBA -> Ptr Rect -> IO ()
gtk_snapshot_append_color Ptr Snapshot
snapshot' Ptr RGBA
color' Ptr Rect
bounds'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendColorMethodInfo
instance (signature ~ (Gdk.RGBA.RGBA -> Graphene.Rect.Rect -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendColorMethodInfo a signature where
    overloadedMethod = snapshotAppendColor

instance O.OverloadedMethodInfo SnapshotAppendColorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendColor"
        })


#endif

-- method Snapshot::append_conic_gradient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rectangle to render the gradient into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the center point of the conic gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rotation"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the clockwise rotation in degrees of the starting angle.\n  0 means the starting angle is the top."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stops"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 5
--                 (TInterface Name { namespace = "Gsk" , name = "ColorStop" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color stops defining the gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_stops"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements in @stops"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_stops"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements in @stops"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_conic_gradient" gtk_snapshot_append_conic_gradient :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Point.Point ->             -- center : TInterface (Name {namespace = "Graphene", name = "Point"})
    CFloat ->                               -- rotation : TBasicType TFloat
    Ptr Gsk.ColorStop.ColorStop ->          -- stops : TCArray False (-1) 5 (TInterface (Name {namespace = "Gsk", name = "ColorStop"}))
    Word64 ->                               -- n_stops : TBasicType TUInt64
    IO ()

-- | Appends a conic gradient node with the given stops to /@snapshot@/.
snapshotAppendConicGradient ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render the gradient into
    -> Graphene.Point.Point
    -- ^ /@center@/: the center point of the conic gradient
    -> Float
    -- ^ /@rotation@/: the clockwise rotation in degrees of the starting angle.
    --   0 means the starting angle is the top.
    -> [Gsk.ColorStop.ColorStop]
    -- ^ /@stops@/: the color stops defining the gradient
    -> m ()
snapshotAppendConicGradient :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> Point -> Float -> [ColorStop] -> m ()
snapshotAppendConicGradient a
snapshot Rect
bounds Point
center Float
rotation [ColorStop]
stops = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nStops :: Word64
nStops = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ColorStop] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ColorStop]
stops
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Point
center' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
center
    let rotation' :: CFloat
rotation' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation
    [Ptr ColorStop]
stops' <- (ColorStop -> IO (Ptr ColorStop))
-> [ColorStop] -> IO [Ptr ColorStop]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ColorStop -> IO (Ptr ColorStop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ColorStop]
stops
    Ptr ColorStop
stops'' <- Int -> [Ptr ColorStop] -> IO (Ptr ColorStop)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
20 [Ptr ColorStop]
stops'
    Ptr Snapshot
-> Ptr Rect
-> Ptr Point
-> CFloat
-> Ptr ColorStop
-> Word64
-> IO ()
gtk_snapshot_append_conic_gradient Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Point
center' CFloat
rotation' Ptr ColorStop
stops'' Word64
nStops
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
center
    (ColorStop -> IO ()) -> [ColorStop] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColorStop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ColorStop]
stops
    Ptr ColorStop -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ColorStop
stops''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendConicGradientMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Point.Point -> Float -> [Gsk.ColorStop.ColorStop] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendConicGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendConicGradient

instance O.OverloadedMethodInfo SnapshotAppendConicGradientMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendConicGradient",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendConicGradient"
        })


#endif

-- method Snapshot::append_inset_shadow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "outline of the region surrounded by shadow"
--                 , 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 "color of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spread"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how far the shadow spreads towards the inside"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blur_radius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how much blur to apply to the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_inset_shadow" gtk_snapshot_append_inset_shadow :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    CFloat ->                               -- dx : TBasicType TFloat
    CFloat ->                               -- dy : TBasicType TFloat
    CFloat ->                               -- spread : TBasicType TFloat
    CFloat ->                               -- blur_radius : TBasicType TFloat
    IO ()

-- | Appends an inset shadow into the box given by /@outline@/.
snapshotAppendInsetShadow ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: outline of the region surrounded by shadow
    -> Gdk.RGBA.RGBA
    -- ^ /@color@/: color of the shadow
    -> Float
    -- ^ /@dx@/: horizontal offset of shadow
    -> Float
    -- ^ /@dy@/: vertical offset of shadow
    -> Float
    -- ^ /@spread@/: how far the shadow spreads towards the inside
    -> Float
    -- ^ /@blurRadius@/: how much blur to apply to the shadow
    -> m ()
snapshotAppendInsetShadow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a
-> RoundedRect -> RGBA -> Float -> Float -> Float -> Float -> m ()
snapshotAppendInsetShadow a
snapshot RoundedRect
outline RGBA
color Float
dx Float
dy Float
spread Float
blurRadius = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RoundedRect
outline' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
outline
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    let dx' :: CFloat
dx' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dx
    let dy' :: CFloat
dy' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dy
    let spread' :: CFloat
spread' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spread
    let blurRadius' :: CFloat
blurRadius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blurRadius
    Ptr Snapshot
-> Ptr RoundedRect
-> Ptr RGBA
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
gtk_snapshot_append_inset_shadow Ptr Snapshot
snapshot' Ptr RoundedRect
outline' Ptr RGBA
color' CFloat
dx' CFloat
dy' CFloat
spread' CFloat
blurRadius'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendInsetShadowMethodInfo
instance (signature ~ (Gsk.RoundedRect.RoundedRect -> Gdk.RGBA.RGBA -> Float -> Float -> Float -> Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendInsetShadowMethodInfo a signature where
    overloadedMethod = snapshotAppendInsetShadow

instance O.OverloadedMethodInfo SnapshotAppendInsetShadowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendInsetShadow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendInsetShadow"
        })


#endif

-- method Snapshot::append_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Layout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_layout" gtk_snapshot_append_layout :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Pango.Layout.Layout ->              -- layout : TInterface (Name {namespace = "Pango", name = "Layout"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO ()

-- | /No description available in the introspection data./
snapshotAppendLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Pango.Layout.IsLayout b) =>
    a
    -> b
    -> Gdk.RGBA.RGBA
    -> m ()
snapshotAppendLayout :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsLayout b) =>
a -> b -> RGBA -> m ()
snapshotAppendLayout a
snapshot b
layout RGBA
color = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Layout
layout' <- b -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
layout
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    Ptr Snapshot -> Ptr Layout -> Ptr RGBA -> IO ()
gtk_snapshot_append_layout Ptr Snapshot
snapshot' Ptr Layout
layout' Ptr RGBA
color'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
layout
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendLayoutMethodInfo
instance (signature ~ (b -> Gdk.RGBA.RGBA -> m ()), MonadIO m, IsSnapshot a, Pango.Layout.IsLayout b) => O.OverloadedMethod SnapshotAppendLayoutMethodInfo a signature where
    overloadedMethod = snapshotAppendLayout

instance O.OverloadedMethodInfo SnapshotAppendLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendLayout"
        })


#endif

-- method Snapshot::append_linear_gradient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the rectangle to render the linear gradient into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point at which the linear gradient will begin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point at which the linear gradient will finish"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stops"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 5
--                 (TInterface Name { namespace = "Gsk" , name = "ColorStop" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color stops defining the gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_stops"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements in @stops"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_stops"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements in @stops"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_linear_gradient" gtk_snapshot_append_linear_gradient :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Point.Point ->             -- start_point : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Graphene.Point.Point ->             -- end_point : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Gsk.ColorStop.ColorStop ->          -- stops : TCArray False (-1) 5 (TInterface (Name {namespace = "Gsk", name = "ColorStop"}))
    Word64 ->                               -- n_stops : TBasicType TUInt64
    IO ()

-- | Appends a linear gradient node with the given stops to /@snapshot@/.
snapshotAppendLinearGradient ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render the linear gradient into
    -> Graphene.Point.Point
    -- ^ /@startPoint@/: the point at which the linear gradient will begin
    -> Graphene.Point.Point
    -- ^ /@endPoint@/: the point at which the linear gradient will finish
    -> [Gsk.ColorStop.ColorStop]
    -- ^ /@stops@/: the color stops defining the gradient
    -> m ()
snapshotAppendLinearGradient :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> Point -> Point -> [ColorStop] -> m ()
snapshotAppendLinearGradient a
snapshot Rect
bounds Point
startPoint Point
endPoint [ColorStop]
stops = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nStops :: Word64
nStops = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ColorStop] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ColorStop]
stops
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Point
startPoint' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
startPoint
    Ptr Point
endPoint' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
endPoint
    [Ptr ColorStop]
stops' <- (ColorStop -> IO (Ptr ColorStop))
-> [ColorStop] -> IO [Ptr ColorStop]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ColorStop -> IO (Ptr ColorStop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ColorStop]
stops
    Ptr ColorStop
stops'' <- Int -> [Ptr ColorStop] -> IO (Ptr ColorStop)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
20 [Ptr ColorStop]
stops'
    Ptr Snapshot
-> Ptr Rect
-> Ptr Point
-> Ptr Point
-> Ptr ColorStop
-> Word64
-> IO ()
gtk_snapshot_append_linear_gradient Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Point
startPoint' Ptr Point
endPoint' Ptr ColorStop
stops'' Word64
nStops
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
startPoint
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
endPoint
    (ColorStop -> IO ()) -> [ColorStop] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColorStop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ColorStop]
stops
    Ptr ColorStop -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ColorStop
stops''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendLinearGradientMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Point.Point -> Graphene.Point.Point -> [Gsk.ColorStop.ColorStop] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendLinearGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendLinearGradient

instance O.OverloadedMethodInfo SnapshotAppendLinearGradientMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendLinearGradient",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendLinearGradient"
        })


#endif

-- method Snapshot::append_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskRenderNode`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_node" gtk_snapshot_append_node :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    IO ()

-- | Appends /@node@/ to the current render node of /@snapshot@/,
-- without changing the current node.
-- 
-- If /@snapshot@/ does not have a current node yet, /@node@/
-- will become the initial node.
snapshotAppendNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gsk.RenderNode.IsRenderNode b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@node@/: a @GskRenderNode@
    -> m ()
snapshotAppendNode :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsRenderNode b) =>
a -> b -> m ()
snapshotAppendNode a
snapshot b
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RenderNode
node' <- b -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
node
    Ptr Snapshot -> Ptr RenderNode -> IO ()
gtk_snapshot_append_node Ptr Snapshot
snapshot' Ptr RenderNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendNodeMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSnapshot a, Gsk.RenderNode.IsRenderNode b) => O.OverloadedMethod SnapshotAppendNodeMethodInfo a signature where
    overloadedMethod = snapshotAppendNode

instance O.OverloadedMethodInfo SnapshotAppendNodeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendNode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendNode"
        })


#endif

-- method Snapshot::append_outset_shadow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "outline of the region surrounded by shadow"
--                 , 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 "color of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical offset of shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spread"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "how far the shadow spreads towards the outside"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blur_radius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how much blur to apply to the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_outset_shadow" gtk_snapshot_append_outset_shadow :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr Gdk.RGBA.RGBA ->                    -- color : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    CFloat ->                               -- dx : TBasicType TFloat
    CFloat ->                               -- dy : TBasicType TFloat
    CFloat ->                               -- spread : TBasicType TFloat
    CFloat ->                               -- blur_radius : TBasicType TFloat
    IO ()

-- | Appends an outset shadow node around the box given by /@outline@/.
snapshotAppendOutsetShadow ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: outline of the region surrounded by shadow
    -> Gdk.RGBA.RGBA
    -- ^ /@color@/: color of the shadow
    -> Float
    -- ^ /@dx@/: horizontal offset of shadow
    -> Float
    -- ^ /@dy@/: vertical offset of shadow
    -> Float
    -- ^ /@spread@/: how far the shadow spreads towards the outside
    -> Float
    -- ^ /@blurRadius@/: how much blur to apply to the shadow
    -> m ()
snapshotAppendOutsetShadow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a
-> RoundedRect -> RGBA -> Float -> Float -> Float -> Float -> m ()
snapshotAppendOutsetShadow a
snapshot RoundedRect
outline RGBA
color Float
dx Float
dy Float
spread Float
blurRadius = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RoundedRect
outline' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
outline
    Ptr RGBA
color' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
color
    let dx' :: CFloat
dx' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dx
    let dy' :: CFloat
dy' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dy
    let spread' :: CFloat
spread' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spread
    let blurRadius' :: CFloat
blurRadius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blurRadius
    Ptr Snapshot
-> Ptr RoundedRect
-> Ptr RGBA
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
gtk_snapshot_append_outset_shadow Ptr Snapshot
snapshot' Ptr RoundedRect
outline' Ptr RGBA
color' CFloat
dx' CFloat
dy' CFloat
spread' CFloat
blurRadius'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendOutsetShadowMethodInfo
instance (signature ~ (Gsk.RoundedRect.RoundedRect -> Gdk.RGBA.RGBA -> Float -> Float -> Float -> Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendOutsetShadowMethodInfo a signature where
    overloadedMethod = snapshotAppendOutsetShadow

instance O.OverloadedMethodInfo SnapshotAppendOutsetShadowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendOutsetShadow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendOutsetShadow"
        })


#endif

-- method Snapshot::append_radial_gradient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the rectangle to render the readial gradient into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the center point for the radial gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hradius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal radius"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vradius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical radius"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start position (on the horizontal axis)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end position (on the horizontal axis)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stops"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 8
--                 (TInterface Name { namespace = "Gsk" , name = "ColorStop" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color stops defining the gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_stops"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements in @stops"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_stops"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements in @stops"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_radial_gradient" gtk_snapshot_append_radial_gradient :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Point.Point ->             -- center : TInterface (Name {namespace = "Graphene", name = "Point"})
    CFloat ->                               -- hradius : TBasicType TFloat
    CFloat ->                               -- vradius : TBasicType TFloat
    CFloat ->                               -- start : TBasicType TFloat
    CFloat ->                               -- end : TBasicType TFloat
    Ptr Gsk.ColorStop.ColorStop ->          -- stops : TCArray False (-1) 8 (TInterface (Name {namespace = "Gsk", name = "ColorStop"}))
    Word64 ->                               -- n_stops : TBasicType TUInt64
    IO ()

-- | Appends a radial gradient node with the given stops to /@snapshot@/.
snapshotAppendRadialGradient ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render the readial gradient into
    -> Graphene.Point.Point
    -- ^ /@center@/: the center point for the radial gradient
    -> Float
    -- ^ /@hradius@/: the horizontal radius
    -> Float
    -- ^ /@vradius@/: the vertical radius
    -> Float
    -- ^ /@start@/: the start position (on the horizontal axis)
    -> Float
    -- ^ /@end@/: the end position (on the horizontal axis)
    -> [Gsk.ColorStop.ColorStop]
    -- ^ /@stops@/: the color stops defining the gradient
    -> m ()
snapshotAppendRadialGradient :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a
-> Rect
-> Point
-> Float
-> Float
-> Float
-> Float
-> [ColorStop]
-> m ()
snapshotAppendRadialGradient a
snapshot Rect
bounds Point
center Float
hradius Float
vradius Float
start Float
end [ColorStop]
stops = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nStops :: Word64
nStops = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ColorStop] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ColorStop]
stops
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Point
center' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
center
    let hradius' :: CFloat
hradius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hradius
    let vradius' :: CFloat
vradius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
vradius
    let start' :: CFloat
start' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
start
    let end' :: CFloat
end' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
end
    [Ptr ColorStop]
stops' <- (ColorStop -> IO (Ptr ColorStop))
-> [ColorStop] -> IO [Ptr ColorStop]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ColorStop -> IO (Ptr ColorStop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ColorStop]
stops
    Ptr ColorStop
stops'' <- Int -> [Ptr ColorStop] -> IO (Ptr ColorStop)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
20 [Ptr ColorStop]
stops'
    Ptr Snapshot
-> Ptr Rect
-> Ptr Point
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> Ptr ColorStop
-> Word64
-> IO ()
gtk_snapshot_append_radial_gradient Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Point
center' CFloat
hradius' CFloat
vradius' CFloat
start' CFloat
end' Ptr ColorStop
stops'' Word64
nStops
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
center
    (ColorStop -> IO ()) -> [ColorStop] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColorStop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ColorStop]
stops
    Ptr ColorStop -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ColorStop
stops''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendRadialGradientMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Point.Point -> Float -> Float -> Float -> Float -> [Gsk.ColorStop.ColorStop] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendRadialGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendRadialGradient

instance O.OverloadedMethodInfo SnapshotAppendRadialGradientMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendRadialGradient",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendRadialGradient"
        })


#endif

-- method Snapshot::append_repeating_linear_gradient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the rectangle to render the linear gradient into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point at which the linear gradient will begin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point at which the linear gradient will finish"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stops"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 5
--                 (TInterface Name { namespace = "Gsk" , name = "ColorStop" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color stops defining the gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_stops"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements in @stops"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_stops"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements in @stops"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_repeating_linear_gradient" gtk_snapshot_append_repeating_linear_gradient :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Point.Point ->             -- start_point : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Graphene.Point.Point ->             -- end_point : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Gsk.ColorStop.ColorStop ->          -- stops : TCArray False (-1) 5 (TInterface (Name {namespace = "Gsk", name = "ColorStop"}))
    Word64 ->                               -- n_stops : TBasicType TUInt64
    IO ()

-- | Appends a repeating linear gradient node with the given stops to /@snapshot@/.
snapshotAppendRepeatingLinearGradient ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render the linear gradient into
    -> Graphene.Point.Point
    -- ^ /@startPoint@/: the point at which the linear gradient will begin
    -> Graphene.Point.Point
    -- ^ /@endPoint@/: the point at which the linear gradient will finish
    -> [Gsk.ColorStop.ColorStop]
    -- ^ /@stops@/: the color stops defining the gradient
    -> m ()
snapshotAppendRepeatingLinearGradient :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> Point -> Point -> [ColorStop] -> m ()
snapshotAppendRepeatingLinearGradient a
snapshot Rect
bounds Point
startPoint Point
endPoint [ColorStop]
stops = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nStops :: Word64
nStops = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ColorStop] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ColorStop]
stops
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Point
startPoint' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
startPoint
    Ptr Point
endPoint' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
endPoint
    [Ptr ColorStop]
stops' <- (ColorStop -> IO (Ptr ColorStop))
-> [ColorStop] -> IO [Ptr ColorStop]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ColorStop -> IO (Ptr ColorStop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ColorStop]
stops
    Ptr ColorStop
stops'' <- Int -> [Ptr ColorStop] -> IO (Ptr ColorStop)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
20 [Ptr ColorStop]
stops'
    Ptr Snapshot
-> Ptr Rect
-> Ptr Point
-> Ptr Point
-> Ptr ColorStop
-> Word64
-> IO ()
gtk_snapshot_append_repeating_linear_gradient Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Point
startPoint' Ptr Point
endPoint' Ptr ColorStop
stops'' Word64
nStops
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
startPoint
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
endPoint
    (ColorStop -> IO ()) -> [ColorStop] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColorStop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ColorStop]
stops
    Ptr ColorStop -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ColorStop
stops''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendRepeatingLinearGradientMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Point.Point -> Graphene.Point.Point -> [Gsk.ColorStop.ColorStop] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendRepeatingLinearGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendRepeatingLinearGradient

instance O.OverloadedMethodInfo SnapshotAppendRepeatingLinearGradientMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendRepeatingLinearGradient",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendRepeatingLinearGradient"
        })


#endif

-- method Snapshot::append_repeating_radial_gradient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the rectangle to render the readial gradient into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the center point for the radial gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hradius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal radius"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vradius"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical radius"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start position (on the horizontal axis)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the end position (on the horizontal axis)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stops"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 8
--                 (TInterface Name { namespace = "Gsk" , name = "ColorStop" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color stops defining the gradient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_stops"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements in @stops"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_stops"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements in @stops"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_repeating_radial_gradient" gtk_snapshot_append_repeating_radial_gradient :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Point.Point ->             -- center : TInterface (Name {namespace = "Graphene", name = "Point"})
    CFloat ->                               -- hradius : TBasicType TFloat
    CFloat ->                               -- vradius : TBasicType TFloat
    CFloat ->                               -- start : TBasicType TFloat
    CFloat ->                               -- end : TBasicType TFloat
    Ptr Gsk.ColorStop.ColorStop ->          -- stops : TCArray False (-1) 8 (TInterface (Name {namespace = "Gsk", name = "ColorStop"}))
    Word64 ->                               -- n_stops : TBasicType TUInt64
    IO ()

-- | Appends a repeating radial gradient node with the given stops to /@snapshot@/.
snapshotAppendRepeatingRadialGradient ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render the readial gradient into
    -> Graphene.Point.Point
    -- ^ /@center@/: the center point for the radial gradient
    -> Float
    -- ^ /@hradius@/: the horizontal radius
    -> Float
    -- ^ /@vradius@/: the vertical radius
    -> Float
    -- ^ /@start@/: the start position (on the horizontal axis)
    -> Float
    -- ^ /@end@/: the end position (on the horizontal axis)
    -> [Gsk.ColorStop.ColorStop]
    -- ^ /@stops@/: the color stops defining the gradient
    -> m ()
snapshotAppendRepeatingRadialGradient :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a
-> Rect
-> Point
-> Float
-> Float
-> Float
-> Float
-> [ColorStop]
-> m ()
snapshotAppendRepeatingRadialGradient a
snapshot Rect
bounds Point
center Float
hradius Float
vradius Float
start Float
end [ColorStop]
stops = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nStops :: Word64
nStops = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ColorStop] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ColorStop]
stops
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Point
center' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
center
    let hradius' :: CFloat
hradius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hradius
    let vradius' :: CFloat
vradius' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
vradius
    let start' :: CFloat
start' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
start
    let end' :: CFloat
end' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
end
    [Ptr ColorStop]
stops' <- (ColorStop -> IO (Ptr ColorStop))
-> [ColorStop] -> IO [Ptr ColorStop]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ColorStop -> IO (Ptr ColorStop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ColorStop]
stops
    Ptr ColorStop
stops'' <- Int -> [Ptr ColorStop] -> IO (Ptr ColorStop)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
20 [Ptr ColorStop]
stops'
    Ptr Snapshot
-> Ptr Rect
-> Ptr Point
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> Ptr ColorStop
-> Word64
-> IO ()
gtk_snapshot_append_repeating_radial_gradient Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Point
center' CFloat
hradius' CFloat
vradius' CFloat
start' CFloat
end' Ptr ColorStop
stops'' Word64
nStops
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
center
    (ColorStop -> IO ()) -> [ColorStop] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColorStop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ColorStop]
stops
    Ptr ColorStop -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ColorStop
stops''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendRepeatingRadialGradientMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Point.Point -> Float -> Float -> Float -> Float -> [Gsk.ColorStop.ColorStop] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotAppendRepeatingRadialGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendRepeatingRadialGradient

instance O.OverloadedMethodInfo SnapshotAppendRepeatingRadialGradientMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendRepeatingRadialGradient",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendRepeatingRadialGradient"
        })


#endif

-- method Snapshot::append_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the texture to render"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds for the new node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_append_texture" gtk_snapshot_append_texture :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Creates a new render node drawing the /@texture@/
-- into the given /@bounds@/ and appends it to the
-- current render node of /@snapshot@/.
snapshotAppendTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gdk.Texture.IsTexture b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@texture@/: the texture to render
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds for the new node
    -> m ()
snapshotAppendTexture :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsTexture b) =>
a -> b -> Rect -> m ()
snapshotAppendTexture a
snapshot b
texture Rect
bounds = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Texture
texture' <- b -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
texture
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Snapshot -> Ptr Texture -> Ptr Rect -> IO ()
gtk_snapshot_append_texture Ptr Snapshot
snapshot' Ptr Texture
texture' Ptr Rect
bounds'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
texture
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendTextureMethodInfo
instance (signature ~ (b -> Graphene.Rect.Rect -> m ()), MonadIO m, IsSnapshot a, Gdk.Texture.IsTexture b) => O.OverloadedMethod SnapshotAppendTextureMethodInfo a signature where
    overloadedMethod = snapshotAppendTexture

instance O.OverloadedMethodInfo SnapshotAppendTextureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotAppendTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotAppendTexture"
        })


#endif

-- method Snapshot::gl_shader_pop_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_gl_shader_pop_texture" gtk_snapshot_gl_shader_pop_texture :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    IO ()

-- | Removes the top element from the stack of render nodes and
-- adds it to the nearest t'GI.Gsk.Objects.GLShaderNode.GLShaderNode' below it.
-- 
-- This must be called the same number of times as the number
-- of textures is needed for the shader in
-- 'GI.Gtk.Objects.Snapshot.snapshotPushGlShader'.
snapshotGlShaderPopTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> m ()
snapshotGlShaderPopTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> m ()
snapshotGlShaderPopTexture a
snapshot = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Snapshot -> IO ()
gtk_snapshot_gl_shader_pop_texture Ptr Snapshot
snapshot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotGlShaderPopTextureMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotGlShaderPopTextureMethodInfo a signature where
    overloadedMethod = snapshotGlShaderPopTexture

instance O.OverloadedMethodInfo SnapshotGlShaderPopTextureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotGlShaderPopTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotGlShaderPopTexture"
        })


#endif

-- method Snapshot::perspective
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "distance of the z=0 plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_perspective" gtk_snapshot_perspective :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CFloat ->                               -- depth : TBasicType TFloat
    IO ()

-- | Applies a perspective projection transform.
-- 
-- See 'GI.Gsk.Structs.Transform.transformPerspective' for a discussion on the details.
snapshotPerspective ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Float
    -- ^ /@depth@/: distance of the z=0 plane
    -> m ()
snapshotPerspective :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Float -> m ()
snapshotPerspective a
snapshot Float
depth = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let depth' :: CFloat
depth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
depth
    Ptr Snapshot -> CFloat -> IO ()
gtk_snapshot_perspective Ptr Snapshot
snapshot' CFloat
depth'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPerspectiveMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPerspectiveMethodInfo a signature where
    overloadedMethod = snapshotPerspective

instance O.OverloadedMethodInfo SnapshotPerspectiveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPerspective",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPerspective"
        })


#endif

-- method Snapshot::pop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_pop" gtk_snapshot_pop :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    IO ()

-- | Removes the top element from the stack of render nodes,
-- and appends it to the node underneath it.
snapshotPop ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> m ()
snapshotPop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> m ()
snapshotPop a
snapshot = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Snapshot -> IO ()
gtk_snapshot_pop Ptr Snapshot
snapshot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPopMethodInfo a signature where
    overloadedMethod = snapshotPop

instance O.OverloadedMethodInfo SnapshotPopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPop"
        })


#endif

-- method Snapshot::push_blend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blend_mode"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BlendMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "blend mode to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_blend" gtk_snapshot_push_blend :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CUInt ->                                -- blend_mode : TInterface (Name {namespace = "Gsk", name = "BlendMode"})
    IO ()

-- | Blends together two images with the given blend mode.
-- 
-- Until the first call to 'GI.Gtk.Objects.Snapshot.snapshotPop', the
-- bottom image for the blend operation will be recorded.
-- After that call, the top image to be blended will be
-- recorded until the second call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
-- 
-- Calling this function requires two subsequent calls
-- to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushBlend ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gsk.Enums.BlendMode
    -- ^ /@blendMode@/: blend mode to use
    -> m ()
snapshotPushBlend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> BlendMode -> m ()
snapshotPushBlend a
snapshot BlendMode
blendMode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let blendMode' :: CUInt
blendMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BlendMode -> Int) -> BlendMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlendMode -> Int
forall a. Enum a => a -> Int
fromEnum) BlendMode
blendMode
    Ptr Snapshot -> CUInt -> IO ()
gtk_snapshot_push_blend Ptr Snapshot
snapshot' CUInt
blendMode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushBlendMethodInfo
instance (signature ~ (Gsk.Enums.BlendMode -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushBlendMethodInfo a signature where
    overloadedMethod = snapshotPushBlend

instance O.OverloadedMethodInfo SnapshotPushBlendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushBlend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushBlend"
        })


#endif

-- method Snapshot::push_blur
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "radius"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the blur radius to use. Must be positive"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_blur" gtk_snapshot_push_blur :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CDouble ->                              -- radius : TBasicType TDouble
    IO ()

-- | Blurs an image.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushBlur ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Double
    -- ^ /@radius@/: the blur radius to use. Must be positive
    -> m ()
snapshotPushBlur :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Double -> m ()
snapshotPushBlur a
snapshot Double
radius = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let radius' :: CDouble
radius' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
radius
    Ptr Snapshot -> CDouble -> IO ()
gtk_snapshot_push_blur Ptr Snapshot
snapshot' CDouble
radius'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushBlurMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushBlurMethodInfo a signature where
    overloadedMethod = snapshotPushBlur

instance O.OverloadedMethodInfo SnapshotPushBlurMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushBlur",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushBlur"
        })


#endif

-- method Snapshot::push_clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rectangle to clip to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_clip" gtk_snapshot_push_clip :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Clips an image to a rectangle.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushClip ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to clip to
    -> m ()
snapshotPushClip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> m ()
snapshotPushClip a
snapshot Rect
bounds = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Snapshot -> Ptr Rect -> IO ()
gtk_snapshot_push_clip Ptr Snapshot
snapshot' Ptr Rect
bounds'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushClipMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushClipMethodInfo a signature where
    overloadedMethod = snapshotPushClip

instance O.OverloadedMethodInfo SnapshotPushClipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushClip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushClip"
        })


#endif

-- method Snapshot::push_color_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color_matrix"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color matrix to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color_offset"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color offset to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_color_matrix" gtk_snapshot_push_color_matrix :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Matrix.Matrix ->           -- color_matrix : TInterface (Name {namespace = "Graphene", name = "Matrix"})
    Ptr Graphene.Vec4.Vec4 ->               -- color_offset : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO ()

-- | Modifies the colors of an image by applying an affine transformation
-- in RGB space.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushColorMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Matrix.Matrix
    -- ^ /@colorMatrix@/: the color matrix to use
    -> Graphene.Vec4.Vec4
    -- ^ /@colorOffset@/: the color offset to use
    -> m ()
snapshotPushColorMatrix :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Matrix -> Vec4 -> m ()
snapshotPushColorMatrix a
snapshot Matrix
colorMatrix Vec4
colorOffset = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Matrix
colorMatrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
colorMatrix
    Ptr Vec4
colorOffset' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
colorOffset
    Ptr Snapshot -> Ptr Matrix -> Ptr Vec4 -> IO ()
gtk_snapshot_push_color_matrix Ptr Snapshot
snapshot' Ptr Matrix
colorMatrix' Ptr Vec4
colorOffset'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
colorMatrix
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
colorOffset
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushColorMatrixMethodInfo
instance (signature ~ (Graphene.Matrix.Matrix -> Graphene.Vec4.Vec4 -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushColorMatrixMethodInfo a signature where
    overloadedMethod = snapshotPushColorMatrix

instance O.OverloadedMethodInfo SnapshotPushColorMatrixMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushColorMatrix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushColorMatrix"
        })


#endif

-- method Snapshot::push_cross_fade
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "progress between 0.0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_cross_fade" gtk_snapshot_push_cross_fade :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CDouble ->                              -- progress : TBasicType TDouble
    IO ()

-- | Snapshots a cross-fade operation between two images with the
-- given /@progress@/.
-- 
-- Until the first call to 'GI.Gtk.Objects.Snapshot.snapshotPop', the start image
-- will be snapshot. After that call, the end image will be recorded
-- until the second call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
-- 
-- Calling this function requires two subsequent calls
-- to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushCrossFade ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Double
    -- ^ /@progress@/: progress between 0.0 and 1.0
    -> m ()
snapshotPushCrossFade :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Double -> m ()
snapshotPushCrossFade a
snapshot Double
progress = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr Snapshot -> CDouble -> IO ()
gtk_snapshot_push_cross_fade Ptr Snapshot
snapshot' CDouble
progress'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushCrossFadeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushCrossFadeMethodInfo a signature where
    overloadedMethod = snapshotPushCrossFade

instance O.OverloadedMethodInfo SnapshotPushCrossFadeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushCrossFade",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushCrossFade"
        })


#endif

-- method Snapshot::push_gl_shader
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shader"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "GLShader" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The code to run" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rectangle to render into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "take_args"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data block with arguments for the shader."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_gl_shader" gtk_snapshot_push_gl_shader :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.GLShader.GLShader ->            -- shader : TInterface (Name {namespace = "Gsk", name = "GLShader"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr GLib.Bytes.Bytes ->                 -- take_args : TInterface (Name {namespace = "GLib", name = "Bytes"})
    IO ()

-- | Push a t'GI.Gsk.Objects.GLShaderNode.GLShaderNode'.
-- 
-- The node uses the given t'GI.Gsk.Objects.GLShader.GLShader' and uniform values
-- Additionally this takes a list of /@nChildren@/ other nodes
-- which will be passed to the t'GI.Gsk.Objects.GLShaderNode.GLShaderNode'.
-- 
-- The /@takeArgs@/ argument is a block of data to use for uniform
-- arguments, as per types and offsets defined by the /@shader@/.
-- Normally this is generated by t'GI.Gsk.Objects.GLShader.GLShader'.@/format_args/@()
-- or [struct/@gsk@/.ShaderArgsBuilder].
-- 
-- The snapshotter takes ownership of /@takeArgs@/, so the caller should
-- not free it after this.
-- 
-- If the renderer doesn\'t support GL shaders, or if there is any
-- problem when compiling the shader, then the node will draw pink.
-- You should use 'GI.Gsk.Objects.GLShader.gLShaderCompile' to ensure the /@shader@/
-- will work for the renderer before using it.
-- 
-- If the shader requires textures (see 'GI.Gsk.Objects.GLShader.gLShaderGetNTextures'),
-- then it is expected that you call 'GI.Gtk.Objects.Snapshot.snapshotGlShaderPopTexture'
-- the number of times that are required. Each of these calls will generate
-- a node that is added as a child to the @GskGLShaderNode@, which in turn
-- will render these offscreen and pass as a texture to the shader.
-- 
-- Once all textures (if any) are pop:ed, you must call the regular
-- 'GI.Gtk.Objects.Snapshot.snapshotPop'.
-- 
-- If you want to use pre-existing textures as input to the shader rather
-- than rendering new ones, use 'GI.Gtk.Objects.Snapshot.snapshotAppendTexture' to
-- push a texture node. These will be used directly rather than being
-- re-rendered.
-- 
-- For details on how to write shaders, see t'GI.Gsk.Objects.GLShader.GLShader'.
snapshotPushGlShader ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gsk.GLShader.IsGLShader b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@shader@/: The code to run
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the rectangle to render into
    -> GLib.Bytes.Bytes
    -- ^ /@takeArgs@/: Data block with arguments for the shader.
    -> m ()
snapshotPushGlShader :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsGLShader b) =>
a -> b -> Rect -> Bytes -> m ()
snapshotPushGlShader a
snapshot b
shader Rect
bounds Bytes
takeArgs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr GLShader
shader' <- b -> IO (Ptr GLShader)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
shader
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Bytes
takeArgs' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Bytes
takeArgs
    Ptr Snapshot -> Ptr GLShader -> Ptr Rect -> Ptr Bytes -> IO ()
gtk_snapshot_push_gl_shader Ptr Snapshot
snapshot' Ptr GLShader
shader' Ptr Rect
bounds' Ptr Bytes
takeArgs'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
shader
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
takeArgs
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushGlShaderMethodInfo
instance (signature ~ (b -> Graphene.Rect.Rect -> GLib.Bytes.Bytes -> m ()), MonadIO m, IsSnapshot a, Gsk.GLShader.IsGLShader b) => O.OverloadedMethod SnapshotPushGlShaderMethodInfo a signature where
    overloadedMethod = snapshotPushGlShader

instance O.OverloadedMethodInfo SnapshotPushGlShaderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushGlShader",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushGlShader"
        })


#endif

-- method Snapshot::push_opacity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opacity"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the opacity to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_opacity" gtk_snapshot_push_opacity :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CDouble ->                              -- opacity : TBasicType TDouble
    IO ()

-- | Modifies the opacity of an image.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushOpacity ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Double
    -- ^ /@opacity@/: the opacity to use
    -> m ()
snapshotPushOpacity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Double -> m ()
snapshotPushOpacity a
snapshot Double
opacity = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let opacity' :: CDouble
opacity' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
opacity
    Ptr Snapshot -> CDouble -> IO ()
gtk_snapshot_push_opacity Ptr Snapshot
snapshot' CDouble
opacity'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushOpacityMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushOpacityMethodInfo a signature where
    overloadedMethod = snapshotPushOpacity

instance O.OverloadedMethodInfo SnapshotPushOpacityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushOpacity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushOpacity"
        })


#endif

-- method Snapshot::push_repeat
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds within which to repeat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the bounds of the child or %NULL\n  to use the full size of the collected child node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_repeat" gtk_snapshot_push_repeat :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    Ptr Graphene.Rect.Rect ->               -- child_bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Creates a node that repeats the child node.
-- 
-- The child is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushRepeat ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds within which to repeat
    -> Maybe (Graphene.Rect.Rect)
    -- ^ /@childBounds@/: the bounds of the child or 'P.Nothing'
    --   to use the full size of the collected child node
    -> m ()
snapshotPushRepeat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Rect -> Maybe Rect -> m ()
snapshotPushRepeat a
snapshot Rect
bounds Maybe Rect
childBounds = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    Ptr Rect
maybeChildBounds <- case Maybe Rect
childBounds of
        Maybe Rect
Nothing -> Ptr Rect -> IO (Ptr Rect)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rect
forall a. Ptr a
nullPtr
        Just Rect
jChildBounds -> do
            Ptr Rect
jChildBounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
jChildBounds
            Ptr Rect -> IO (Ptr Rect)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rect
jChildBounds'
    Ptr Snapshot -> Ptr Rect -> Ptr Rect -> IO ()
gtk_snapshot_push_repeat Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Rect
maybeChildBounds
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Maybe Rect -> (Rect -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Rect
childBounds Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushRepeatMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Maybe (Graphene.Rect.Rect) -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushRepeatMethodInfo a signature where
    overloadedMethod = snapshotPushRepeat

instance O.OverloadedMethodInfo SnapshotPushRepeatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushRepeat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushRepeat"
        })


#endif

-- method Snapshot::push_rounded_clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rounded rectangle to clip to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_rounded_clip" gtk_snapshot_push_rounded_clip :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.RoundedRect.RoundedRect ->      -- bounds : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    IO ()

-- | Clips an image to a rounded rectangle.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushRoundedClip ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Gsk.RoundedRect.RoundedRect
    -- ^ /@bounds@/: the rounded rectangle to clip to
    -> m ()
snapshotPushRoundedClip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> RoundedRect -> m ()
snapshotPushRoundedClip a
snapshot RoundedRect
bounds = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RoundedRect
bounds' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
bounds
    Ptr Snapshot -> Ptr RoundedRect -> IO ()
gtk_snapshot_push_rounded_clip Ptr Snapshot
snapshot' Ptr RoundedRect
bounds'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
bounds
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushRoundedClipMethodInfo
instance (signature ~ (Gsk.RoundedRect.RoundedRect -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushRoundedClipMethodInfo a signature where
    overloadedMethod = snapshotPushRoundedClip

instance O.OverloadedMethodInfo SnapshotPushRoundedClipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushRoundedClip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushRoundedClip"
        })


#endif

-- method Snapshot::push_shadow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shadow"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gsk" , name = "Shadow" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first shadow specification"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_shadows"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of shadow specifications"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_shadows"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of shadow specifications"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_push_shadow" gtk_snapshot_push_shadow :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.Shadow.Shadow ->                -- shadow : TCArray False (-1) 2 (TInterface (Name {namespace = "Gsk", name = "Shadow"}))
    Word64 ->                               -- n_shadows : TBasicType TUInt64
    IO ()

-- | Applies a shadow to an image.
-- 
-- The image is recorded until the next call to 'GI.Gtk.Objects.Snapshot.snapshotPop'.
snapshotPushShadow ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> [Gsk.Shadow.Shadow]
    -- ^ /@shadow@/: the first shadow specification
    -> m ()
snapshotPushShadow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> [Shadow] -> m ()
snapshotPushShadow a
snapshot [Shadow]
shadow = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nShadows :: Word64
nShadows = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [Shadow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Shadow]
shadow
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    [Ptr Shadow]
shadow' <- (Shadow -> IO (Ptr Shadow)) -> [Shadow] -> IO [Ptr Shadow]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Shadow -> IO (Ptr Shadow)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Shadow]
shadow
    Ptr Shadow
shadow'' <- Int -> [Ptr Shadow] -> IO (Ptr Shadow)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
28 [Ptr Shadow]
shadow'
    Ptr Snapshot -> Ptr Shadow -> Word64 -> IO ()
gtk_snapshot_push_shadow Ptr Snapshot
snapshot' Ptr Shadow
shadow'' Word64
nShadows
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    (Shadow -> IO ()) -> [Shadow] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Shadow -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Shadow]
shadow
    Ptr Shadow -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Shadow
shadow''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushShadowMethodInfo
instance (signature ~ ([Gsk.Shadow.Shadow] -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotPushShadowMethodInfo a signature where
    overloadedMethod = snapshotPushShadow

instance O.OverloadedMethodInfo SnapshotPushShadowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotPushShadow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotPushShadow"
        })


#endif

-- method Snapshot::render_background
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the style context that defines the background"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_render_background" gtk_snapshot_render_background :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    CDouble ->                              -- width : TBasicType TDouble
    CDouble ->                              -- height : TBasicType TDouble
    IO ()

-- | Creates a render node for the CSS background according to /@context@/,
-- and appends it to the current node of /@snapshot@/, without changing
-- the current node.
snapshotRenderBackground ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@context@/: the style context that defines the background
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderBackground :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsStyleContext b) =>
a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderBackground a
snapshot b
context Double
x Double
y Double
width Double
height = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    let width' :: CDouble
width' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
width
    let height' :: CDouble
height' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
height
    Ptr Snapshot
-> Ptr StyleContext
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO ()
gtk_snapshot_render_background Ptr Snapshot
snapshot' Ptr StyleContext
context' CDouble
x' CDouble
y' CDouble
width' CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRenderBackgroundMethodInfo
instance (signature ~ (b -> Double -> Double -> Double -> Double -> m ()), MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) => O.OverloadedMethod SnapshotRenderBackgroundMethodInfo a signature where
    overloadedMethod = snapshotRenderBackground

instance O.OverloadedMethodInfo SnapshotRenderBackgroundMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRenderBackground",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRenderBackground"
        })


#endif

-- method Snapshot::render_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the style context that defines the focus ring"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_render_focus" gtk_snapshot_render_focus :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    CDouble ->                              -- width : TBasicType TDouble
    CDouble ->                              -- height : TBasicType TDouble
    IO ()

-- | Creates a render node for the focus outline according to /@context@/,
-- and appends it to the current node of /@snapshot@/, without changing
-- the current node.
snapshotRenderFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@context@/: the style context that defines the focus ring
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderFocus :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsStyleContext b) =>
a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderFocus a
snapshot b
context Double
x Double
y Double
width Double
height = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    let width' :: CDouble
width' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
width
    let height' :: CDouble
height' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
height
    Ptr Snapshot
-> Ptr StyleContext
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO ()
gtk_snapshot_render_focus Ptr Snapshot
snapshot' Ptr StyleContext
context' CDouble
x' CDouble
y' CDouble
width' CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRenderFocusMethodInfo
instance (signature ~ (b -> Double -> Double -> Double -> Double -> m ()), MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) => O.OverloadedMethod SnapshotRenderFocusMethodInfo a signature where
    overloadedMethod = snapshotRenderFocus

instance O.OverloadedMethodInfo SnapshotRenderFocusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRenderFocus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRenderFocus"
        })


#endif

-- method Snapshot::render_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the style context that defines the frame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rectangle height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_render_frame" gtk_snapshot_render_frame :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    CDouble ->                              -- width : TBasicType TDouble
    CDouble ->                              -- height : TBasicType TDouble
    IO ()

-- | Creates a render node for the CSS border according to /@context@/,
-- and appends it to the current node of /@snapshot@/, without changing
-- the current node.
snapshotRenderFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@context@/: the style context that defines the frame
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderFrame :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapshot a, IsStyleContext b) =>
a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderFrame a
snapshot b
context Double
x Double
y Double
width Double
height = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    let width' :: CDouble
width' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
width
    let height' :: CDouble
height' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
height
    Ptr Snapshot
-> Ptr StyleContext
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO ()
gtk_snapshot_render_frame Ptr Snapshot
snapshot' Ptr StyleContext
context' CDouble
x' CDouble
y' CDouble
width' CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRenderFrameMethodInfo
instance (signature ~ (b -> Double -> Double -> Double -> Double -> m ()), MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b) => O.OverloadedMethod SnapshotRenderFrameMethodInfo a signature where
    overloadedMethod = snapshotRenderFrame

instance O.OverloadedMethodInfo SnapshotRenderFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRenderFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRenderFrame"
        })


#endif

-- method Snapshot::render_insertion_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "snapshot to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStyleContext`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X origin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y origin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Layout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `PangoLayout` of the text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index in the `PangoLayout`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Direction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `PangoDirection` of the text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_render_insertion_cursor" gtk_snapshot_render_insertion_cursor :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    Ptr Pango.Layout.Layout ->              -- layout : TInterface (Name {namespace = "Pango", name = "Layout"})
    Int32 ->                                -- index : TBasicType TInt
    CUInt ->                                -- direction : TInterface (Name {namespace = "Pango", name = "Direction"})
    IO ()

-- | Draws a text caret using /@snapshot@/ at the specified index of /@layout@/.
snapshotRenderInsertionCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b, Pango.Layout.IsLayout c) =>
    a
    -- ^ /@snapshot@/: snapshot to render to
    -> b
    -- ^ /@context@/: a @GtkStyleContext@
    -> Double
    -- ^ /@x@/: X origin
    -> Double
    -- ^ /@y@/: Y origin
    -> c
    -- ^ /@layout@/: the @PangoLayout@ of the text
    -> Int32
    -- ^ /@index@/: the index in the @PangoLayout@
    -> Pango.Enums.Direction
    -- ^ /@direction@/: the @PangoDirection@ of the text
    -> m ()
snapshotRenderInsertionCursor :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSnapshot a, IsStyleContext b,
 IsLayout c) =>
a -> b -> Double -> Double -> c -> Int32 -> Direction -> m ()
snapshotRenderInsertionCursor a
snapshot b
context Double
x Double
y c
layout Int32
index Direction
direction = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Layout
layout' <- c -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
layout
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Direction -> Int) -> Direction -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Int
forall a. Enum a => a -> Int
fromEnum) Direction
direction
    Ptr Snapshot
-> Ptr StyleContext
-> CDouble
-> CDouble
-> Ptr Layout
-> Int32
-> CUInt
-> IO ()
gtk_snapshot_render_insertion_cursor Ptr Snapshot
snapshot' Ptr StyleContext
context' CDouble
x' CDouble
y' Ptr Layout
layout' Int32
index CUInt
direction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRenderInsertionCursorMethodInfo
instance (signature ~ (b -> Double -> Double -> c -> Int32 -> Pango.Enums.Direction -> m ()), MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b, Pango.Layout.IsLayout c) => O.OverloadedMethod SnapshotRenderInsertionCursorMethodInfo a signature where
    overloadedMethod = snapshotRenderInsertionCursor

instance O.OverloadedMethodInfo SnapshotRenderInsertionCursorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRenderInsertionCursor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRenderInsertionCursor"
        })


#endif

-- method Snapshot::render_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StyleContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the style context that defines the text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y origin of the rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Layout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `PangoLayout` to render"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_render_layout" gtk_snapshot_render_layout :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gtk.StyleContext.StyleContext ->    -- context : TInterface (Name {namespace = "Gtk", name = "StyleContext"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    Ptr Pango.Layout.Layout ->              -- layout : TInterface (Name {namespace = "Pango", name = "Layout"})
    IO ()

-- | Creates a render node for rendering /@layout@/ according to the style
-- information in /@context@/, and appends it to the current node of /@snapshot@/,
-- without changing the current node.
snapshotRenderLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b, Pango.Layout.IsLayout c) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> b
    -- ^ /@context@/: the style context that defines the text
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> c
    -- ^ /@layout@/: the @PangoLayout@ to render
    -> m ()
snapshotRenderLayout :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSnapshot a, IsStyleContext b,
 IsLayout c) =>
a -> b -> Double -> Double -> c -> m ()
snapshotRenderLayout a
snapshot b
context Double
x Double
y c
layout = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr StyleContext
context' <- b -> IO (Ptr StyleContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Layout
layout' <- c -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
layout
    Ptr Snapshot
-> Ptr StyleContext -> CDouble -> CDouble -> Ptr Layout -> IO ()
gtk_snapshot_render_layout Ptr Snapshot
snapshot' Ptr StyleContext
context' CDouble
x' CDouble
y' Ptr Layout
layout'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
layout
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRenderLayoutMethodInfo
instance (signature ~ (b -> Double -> Double -> c -> m ()), MonadIO m, IsSnapshot a, Gtk.StyleContext.IsStyleContext b, Pango.Layout.IsLayout c) => O.OverloadedMethod SnapshotRenderLayoutMethodInfo a signature where
    overloadedMethod = snapshotRenderLayout

instance O.OverloadedMethodInfo SnapshotRenderLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRenderLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRenderLayout"
        })


#endif

-- method Snapshot::restore
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_restore" gtk_snapshot_restore :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    IO ()

-- | Restores /@snapshot@/ to the state saved by a preceding call to
-- [method/@snapshot@/.save] and removes that state from the stack of
-- saved states.
snapshotRestore ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> m ()
snapshotRestore :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> m ()
snapshotRestore a
snapshot = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Snapshot -> IO ()
gtk_snapshot_restore Ptr Snapshot
snapshot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRestoreMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotRestoreMethodInfo a signature where
    overloadedMethod = snapshotRestore

instance O.OverloadedMethodInfo SnapshotRestoreMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRestore",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRestore"
        })


#endif

-- method Snapshot::rotate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "angle"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rotation angle, in degrees (clockwise)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_rotate" gtk_snapshot_rotate :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CFloat ->                               -- angle : TBasicType TFloat
    IO ()

-- | Rotates \@/@snapshot@/\'s coordinate system by /@angle@/ degrees in 2D space -
-- or in 3D speak, rotates around the Z axis.
-- 
-- To rotate around other axes, use 'GI.Gsk.Structs.Transform.transformRotate3d'.
snapshotRotate ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Float
    -- ^ /@angle@/: the rotation angle, in degrees (clockwise)
    -> m ()
snapshotRotate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Float -> m ()
snapshotRotate a
snapshot Float
angle = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let angle' :: CFloat
angle' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
angle
    Ptr Snapshot -> CFloat -> IO ()
gtk_snapshot_rotate Ptr Snapshot
snapshot' CFloat
angle'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRotateMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotRotateMethodInfo a signature where
    overloadedMethod = snapshotRotate

instance O.OverloadedMethodInfo SnapshotRotateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRotate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRotate"
        })


#endif

-- method Snapshot::rotate_3d
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "angle"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rotation angle, in degrees (clockwise)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axis"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec3" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The rotation axis" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_rotate_3d" gtk_snapshot_rotate_3d :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CFloat ->                               -- angle : TBasicType TFloat
    Ptr Graphene.Vec3.Vec3 ->               -- axis : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    IO ()

-- | Rotates /@snapshot@/\'s coordinate system by /@angle@/ degrees around /@axis@/.
-- 
-- For a rotation in 2D space, use 'GI.Gsk.Structs.Transform.transformRotate'.
snapshotRotate3d ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Float
    -- ^ /@angle@/: the rotation angle, in degrees (clockwise)
    -> Graphene.Vec3.Vec3
    -- ^ /@axis@/: The rotation axis
    -> m ()
snapshotRotate3d :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Float -> Vec3 -> m ()
snapshotRotate3d a
snapshot Float
angle Vec3
axis = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let angle' :: CFloat
angle' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
angle
    Ptr Vec3
axis' <- Vec3 -> IO (Ptr Vec3)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec3
axis
    Ptr Snapshot -> CFloat -> Ptr Vec3 -> IO ()
gtk_snapshot_rotate_3d Ptr Snapshot
snapshot' CFloat
angle' Ptr Vec3
axis'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Vec3 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec3
axis
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRotate3dMethodInfo
instance (signature ~ (Float -> Graphene.Vec3.Vec3 -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotRotate3dMethodInfo a signature where
    overloadedMethod = snapshotRotate3d

instance O.OverloadedMethodInfo SnapshotRotate3dMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotRotate3d",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotRotate3d"
        })


#endif

-- method Snapshot::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_save" gtk_snapshot_save :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    IO ()

-- | Makes a copy of the current state of /@snapshot@/ and saves it
-- on an internal stack.
-- 
-- When 'GI.Gtk.Objects.Snapshot.snapshotRestore' is called, /@snapshot@/ will
-- be restored to the saved state. Multiple calls to
-- [method/@snapshot@/.save] and @/Snapshot.restore/@ can be nested;
-- each call to @gtk_snapshot_restore()@ restores the state from
-- the matching paired @gtk_snapshot_save()@.
-- 
-- It is necessary to clear all saved states with corresponding
-- calls to @gtk_snapshot_restore()@.
snapshotSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> m ()
snapshotSave :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> m ()
snapshotSave a
snapshot = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Snapshot -> IO ()
gtk_snapshot_save Ptr Snapshot
snapshot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotSaveMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotSaveMethodInfo a signature where
    overloadedMethod = snapshotSave

instance O.OverloadedMethodInfo SnapshotSaveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotSave",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotSave"
        })


#endif

-- method Snapshot::scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scaling factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scaling factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_scale" gtk_snapshot_scale :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CFloat ->                               -- factor_x : TBasicType TFloat
    CFloat ->                               -- factor_y : TBasicType TFloat
    IO ()

-- | Scales /@snapshot@/\'s coordinate system in 2-dimensional space by
-- the given factors.
-- 
-- Use 'GI.Gtk.Objects.Snapshot.snapshotScale3d' to scale in all 3 dimensions.
snapshotScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Float
    -- ^ /@factorX@/: scaling factor on the X axis
    -> Float
    -- ^ /@factorY@/: scaling factor on the Y axis
    -> m ()
snapshotScale :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Float -> Float -> m ()
snapshotScale a
snapshot Float
factorX Float
factorY = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let factorX' :: CFloat
factorX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factorX
    let factorY' :: CFloat
factorY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factorY
    Ptr Snapshot -> CFloat -> CFloat -> IO ()
gtk_snapshot_scale Ptr Snapshot
snapshot' CFloat
factorX' CFloat
factorY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotScaleMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotScaleMethodInfo a signature where
    overloadedMethod = snapshotScale

instance O.OverloadedMethodInfo SnapshotScaleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotScale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotScale"
        })


#endif

-- method Snapshot::scale_3d
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scaling factor on the X axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scaling factor on the Y axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor_z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scaling factor on the Z axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_scale_3d" gtk_snapshot_scale_3d :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    CFloat ->                               -- factor_x : TBasicType TFloat
    CFloat ->                               -- factor_y : TBasicType TFloat
    CFloat ->                               -- factor_z : TBasicType TFloat
    IO ()

-- | Scales /@snapshot@/\'s coordinate system by the given factors.
snapshotScale3d ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Float
    -- ^ /@factorX@/: scaling factor on the X axis
    -> Float
    -- ^ /@factorY@/: scaling factor on the Y axis
    -> Float
    -- ^ /@factorZ@/: scaling factor on the Z axis
    -> m ()
snapshotScale3d :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Float -> Float -> Float -> m ()
snapshotScale3d a
snapshot Float
factorX Float
factorY Float
factorZ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    let factorX' :: CFloat
factorX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factorX
    let factorY' :: CFloat
factorY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factorY
    let factorZ' :: CFloat
factorZ' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factorZ
    Ptr Snapshot -> CFloat -> CFloat -> CFloat -> IO ()
gtk_snapshot_scale_3d Ptr Snapshot
snapshot' CFloat
factorX' CFloat
factorY' CFloat
factorZ'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotScale3dMethodInfo
instance (signature ~ (Float -> Float -> Float -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotScale3dMethodInfo a signature where
    overloadedMethod = snapshotScale3d

instance O.OverloadedMethodInfo SnapshotScale3dMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotScale3d",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotScale3d"
        })


#endif

-- method Snapshot::to_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_to_node" gtk_snapshot_to_node :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Returns the render node that was constructed
-- by /@snapshot@/.
-- 
-- After calling this function, it is no longer possible to
-- add more nodes to /@snapshot@/. The only function that should
-- be called after this is 'GI.GObject.Objects.Object.objectUnref'.
snapshotToNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> m (Maybe Gsk.RenderNode.RenderNode)
    -- ^ __Returns:__ the constructed @GskRenderNode@
snapshotToNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> m (Maybe RenderNode)
snapshotToNode a
snapshot = IO (Maybe RenderNode) -> m (Maybe RenderNode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RenderNode) -> m (Maybe RenderNode))
-> IO (Maybe RenderNode) -> m (Maybe RenderNode)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RenderNode
result <- Ptr Snapshot -> IO (Ptr RenderNode)
gtk_snapshot_to_node Ptr Snapshot
snapshot'
    Maybe RenderNode
maybeResult <- Ptr RenderNode
-> (Ptr RenderNode -> IO RenderNode) -> IO (Maybe RenderNode)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RenderNode
result ((Ptr RenderNode -> IO RenderNode) -> IO (Maybe RenderNode))
-> (Ptr RenderNode -> IO RenderNode) -> IO (Maybe RenderNode)
forall a b. (a -> b) -> a -> b
$ \Ptr RenderNode
result' -> do
        RenderNode
result'' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result'
        RenderNode -> IO RenderNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Maybe RenderNode -> IO (Maybe RenderNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RenderNode
maybeResult

#if defined(ENABLE_OVERLOADING)
data SnapshotToNodeMethodInfo
instance (signature ~ (m (Maybe Gsk.RenderNode.RenderNode)), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotToNodeMethodInfo a signature where
    overloadedMethod = snapshotToNode

instance O.OverloadedMethodInfo SnapshotToNodeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotToNode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotToNode"
        })


#endif

-- method Snapshot::to_paintable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Size" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The size of the resulting paintable\n  or %NULL to use the bounds of the snapshot"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Paintable" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_to_paintable" gtk_snapshot_to_paintable :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Size.Size ->               -- size : TInterface (Name {namespace = "Graphene", name = "Size"})
    IO (Ptr Gdk.Paintable.Paintable)

-- | Returns a paintable encapsulating the render node
-- that was constructed by /@snapshot@/.
-- 
-- After calling this function, it is no longer possible to
-- add more nodes to /@snapshot@/. The only function that should
-- be called after this is 'GI.GObject.Objects.Object.objectUnref'.
snapshotToPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Maybe (Graphene.Size.Size)
    -- ^ /@size@/: The size of the resulting paintable
    --   or 'P.Nothing' to use the bounds of the snapshot
    -> m (Maybe Gdk.Paintable.Paintable)
    -- ^ __Returns:__ a new @GdkPaintable@
snapshotToPaintable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Maybe Size -> m (Maybe Paintable)
snapshotToPaintable a
snapshot Maybe Size
size = IO (Maybe Paintable) -> m (Maybe Paintable)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Paintable) -> m (Maybe Paintable))
-> IO (Maybe Paintable) -> m (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Size
maybeSize <- case Maybe Size
size of
        Maybe Size
Nothing -> Ptr Size -> IO (Ptr Size)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Size
forall a. Ptr a
nullPtr
        Just Size
jSize -> do
            Ptr Size
jSize' <- Size -> IO (Ptr Size)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Size
jSize
            Ptr Size -> IO (Ptr Size)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Size
jSize'
    Ptr Paintable
result <- Ptr Snapshot -> Ptr Size -> IO (Ptr Paintable)
gtk_snapshot_to_paintable Ptr Snapshot
snapshot' Ptr Size
maybeSize
    Maybe Paintable
maybeResult <- Ptr Paintable
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Paintable
result ((Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable))
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ \Ptr Paintable
result' -> do
        Paintable
result'' <- ((ManagedPtr Paintable -> Paintable)
-> Ptr Paintable -> IO Paintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Paintable -> Paintable
Gdk.Paintable.Paintable) Ptr Paintable
result'
        Paintable -> IO Paintable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Maybe Size -> (Size -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Size
size Size -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Paintable -> IO (Maybe Paintable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Paintable
maybeResult

#if defined(ENABLE_OVERLOADING)
data SnapshotToPaintableMethodInfo
instance (signature ~ (Maybe (Graphene.Size.Size) -> m (Maybe Gdk.Paintable.Paintable)), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotToPaintableMethodInfo a signature where
    overloadedMethod = snapshotToPaintable

instance O.OverloadedMethodInfo SnapshotToPaintableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotToPaintable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotToPaintable"
        })


#endif

-- method Snapshot::transform
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transform"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "Transform" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the transform to apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_transform" gtk_snapshot_transform :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Gsk.Transform.Transform ->          -- transform : TInterface (Name {namespace = "Gsk", name = "Transform"})
    IO ()

-- | Transforms /@snapshot@/\'s coordinate system with the given /@transform@/.
snapshotTransform ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Maybe (Gsk.Transform.Transform)
    -- ^ /@transform@/: the transform to apply
    -> m ()
snapshotTransform :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Maybe Transform -> m ()
snapshotTransform a
snapshot Maybe Transform
transform = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Transform
maybeTransform <- case Maybe Transform
transform of
        Maybe Transform
Nothing -> Ptr Transform -> IO (Ptr Transform)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Transform
forall a. Ptr a
nullPtr
        Just Transform
jTransform -> do
            Ptr Transform
jTransform' <- Transform -> IO (Ptr Transform)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Transform
jTransform
            Ptr Transform -> IO (Ptr Transform)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Transform
jTransform'
    Ptr Snapshot -> Ptr Transform -> IO ()
gtk_snapshot_transform Ptr Snapshot
snapshot' Ptr Transform
maybeTransform
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Maybe Transform -> (Transform -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Transform
transform Transform -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotTransformMethodInfo
instance (signature ~ (Maybe (Gsk.Transform.Transform) -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotTransformMethodInfo a signature where
    overloadedMethod = snapshotTransform

instance O.OverloadedMethodInfo SnapshotTransformMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotTransform",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotTransform"
        })


#endif

-- method Snapshot::transform_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the matrix to multiply the transform with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_transform_matrix" gtk_snapshot_transform_matrix :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Matrix.Matrix ->           -- matrix : TInterface (Name {namespace = "Graphene", name = "Matrix"})
    IO ()

-- | Transforms /@snapshot@/\'s coordinate system with the given /@matrix@/.
snapshotTransformMatrix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Matrix.Matrix
    -- ^ /@matrix@/: the matrix to multiply the transform with
    -> m ()
snapshotTransformMatrix :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Matrix -> m ()
snapshotTransformMatrix a
snapshot Matrix
matrix = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Snapshot -> Ptr Matrix -> IO ()
gtk_snapshot_transform_matrix Ptr Snapshot
snapshot' Ptr Matrix
matrix'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotTransformMatrixMethodInfo
instance (signature ~ (Graphene.Matrix.Matrix -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotTransformMatrixMethodInfo a signature where
    overloadedMethod = snapshotTransformMatrix

instance O.OverloadedMethodInfo SnapshotTransformMatrixMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotTransformMatrix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotTransformMatrix"
        })


#endif

-- method Snapshot::translate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the point to translate the snapshot by"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_translate" gtk_snapshot_translate :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Point.Point ->             -- point : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO ()

-- | Translates /@snapshot@/\'s coordinate system by /@point@/ in 2-dimensional space.
snapshotTranslate ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Point.Point
    -- ^ /@point@/: the point to translate the snapshot by
    -> m ()
snapshotTranslate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Point -> m ()
snapshotTranslate a
snapshot Point
point = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Snapshot -> Ptr Point -> IO ()
gtk_snapshot_translate Ptr Snapshot
snapshot' Ptr Point
point'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotTranslateMethodInfo
instance (signature ~ (Graphene.Point.Point -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotTranslateMethodInfo a signature where
    overloadedMethod = snapshotTranslate

instance O.OverloadedMethodInfo SnapshotTranslateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotTranslate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotTranslate"
        })


#endif

-- method Snapshot::translate_3d
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSnapshot`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the point to translate the snapshot by"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_snapshot_translate_3d" gtk_snapshot_translate_3d :: 
    Ptr Snapshot ->                         -- snapshot : TInterface (Name {namespace = "Gtk", name = "Snapshot"})
    Ptr Graphene.Point3D.Point3D ->         -- point : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Translates /@snapshot@/\'s coordinate system by /@point@/.
snapshotTranslate3d ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @GtkSnapshot@
    -> Graphene.Point3D.Point3D
    -- ^ /@point@/: the point to translate the snapshot by
    -> m ()
snapshotTranslate3d :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapshot a) =>
a -> Point3D -> m ()
snapshotTranslate3d a
snapshot Point3D
point = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr Point3D
point' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
point
    Ptr Snapshot -> Ptr Point3D -> IO ()
gtk_snapshot_translate_3d Ptr Snapshot
snapshot' Ptr Point3D
point'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
point
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotTranslate3dMethodInfo
instance (signature ~ (Graphene.Point3D.Point3D -> m ()), MonadIO m, IsSnapshot a) => O.OverloadedMethod SnapshotTranslate3dMethodInfo a signature where
    overloadedMethod = snapshotTranslate3d

instance O.OverloadedMethodInfo SnapshotTranslate3dMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Snapshot.snapshotTranslate3d",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-Snapshot.html#v:snapshotTranslate3d"
        })


#endif