{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkSnapshot is an auxiliary object that assists in creating @/GskRenderNodes/@
-- in the t'GI.Gtk.Objects.Widget.Widget'::@/snapshot/@ vfunc. 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 the one that gtk_snapshot_append_…
-- functions operate on. Use the gtk_snapshot_push_… functions and 'GI.Gtk.Objects.Snapshot.snapshotPop'
-- 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                              ,
    noSnapshot                              ,


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

#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                     ,


-- ** 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              ,


-- ** appendRepeatingLinearGradient #method:appendRepeatingLinearGradient#

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


-- ** appendTexture #method:appendTexture#

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


-- ** 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                   ,


-- ** 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Cairo.Structs.Context as Cairo.Context
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.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.RenderNode as Gsk.RenderNode
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 (ManagedPtr Snapshot)
    deriving (Snapshot -> Snapshot -> Bool
(Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool) -> Eq Snapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snapshot -> Snapshot -> Bool
$c/= :: Snapshot -> Snapshot -> Bool
== :: Snapshot -> Snapshot -> Bool
$c== :: Snapshot -> Snapshot -> Bool
Eq)
foreign import ccall "gtk_snapshot_get_type"
    c_gtk_snapshot_get_type :: IO GType

instance GObject Snapshot where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_snapshot_get_type
    

-- | Convert 'Snapshot' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Snapshot where
    toGValue :: Snapshot -> IO GValue
toGValue o :: Snapshot
o = do
        GType
gtype <- IO GType
c_gtk_snapshot_get_type
        Snapshot -> (Ptr Snapshot -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Snapshot
o (GType
-> (GValue -> Ptr Snapshot -> IO ()) -> Ptr Snapshot -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Snapshot -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Snapshot
fromGValue gv :: GValue
gv = do
        Ptr Snapshot
ptr <- GValue -> IO (Ptr Snapshot)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Snapshot)
        (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
        
    

-- | Type class for types which can be safely cast to `Snapshot`, for instance with `toSnapshot`.
class (GObject o, O.IsDescendantOf Snapshot o) => IsSnapshot o
instance (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 :: (MonadIO m, IsSnapshot o) => o -> m Snapshot
toSnapshot :: o -> m Snapshot
toSnapshot = IO Snapshot -> m Snapshot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Snapshot -> Snapshot
Snapshot

-- | A convenience alias for `Nothing` :: `Maybe` `Snapshot`.
noSnapshot :: Maybe Snapshot
noSnapshot :: Maybe Snapshot
noSnapshot = Maybe Snapshot
forall a. Maybe a
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 "appendInsetShadow" o = SnapshotAppendInsetShadowMethodInfo
    ResolveSnapshotMethod "appendLayout" o = SnapshotAppendLayoutMethodInfo
    ResolveSnapshotMethod "appendLinearGradient" o = SnapshotAppendLinearGradientMethodInfo
    ResolveSnapshotMethod "appendNode" o = SnapshotAppendNodeMethodInfo
    ResolveSnapshotMethod "appendOutsetShadow" o = SnapshotAppendOutsetShadowMethodInfo
    ResolveSnapshotMethod "appendRepeatingLinearGradient" o = SnapshotAppendRepeatingLinearGradientMethodInfo
    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 "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 "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.MethodInfo 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

#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 :: m Snapshot
snapshotNew  = IO Snapshot -> m Snapshot
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 "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 (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 "a #GskRoundedRect describing 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
-- 4 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@/: a t'GI.Gsk.Structs.RoundedRect.RoundedRect' describing 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 :: a -> RoundedRect -> [Float] -> [RGBA] -> m ()
snapshotAppendBorder snapshot :: a
snapshot outline :: RoundedRect
outline borderWidth :: [Float]
borderWidth borderColor :: [RGBA]
borderColor = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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)
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 32 [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 (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.MethodInfo SnapshotAppendBorderMethodInfo a signature where
    overloadedMethod = 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 render node 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 :: a -> Rect -> m Context
snapshotAppendCairo snapshot :: a
snapshot bounds :: Rect
bounds = IO Context -> m Context
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 "snapshotAppendCairo" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, BoxedObject 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 (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.MethodInfo SnapshotAppendCairoMethodInfo a signature where
    overloadedMethod = 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 #GdkRGBA 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 t'GI.Gdk.Structs.RGBA.RGBA' to draw
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds for the new node
    -> m ()
snapshotAppendColor :: a -> RGBA -> Rect -> m ()
snapshotAppendColor snapshot :: a
snapshot color :: RGBA
color bounds :: Rect
bounds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotAppendColorMethodInfo a signature where
    overloadedMethod = snapshotAppendColor

#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 :: a
-> RoundedRect -> RGBA -> Float -> Float -> Float -> Float -> m ()
snapshotAppendInsetShadow snapshot :: a
snapshot outline :: RoundedRect
outline color :: RGBA
color dx :: Float
dx dy :: Float
dy spread :: Float
spread blurRadius :: Float
blurRadius = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotAppendInsetShadowMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> RGBA -> m ()
snapshotAppendLayout snapshot :: a
snapshot layout :: b
layout color :: RGBA
color = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotAppendLayoutMethodInfo a signature where
    overloadedMethod = 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 "a pointer to an array of #GskColorStop 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@/: a pointer to an array of t'GI.Gsk.Structs.ColorStop.ColorStop' defining the gradient
    -> m ()
snapshotAppendLinearGradient :: a -> Rect -> Point -> Point -> [ColorStop] -> m ()
snapshotAppendLinearGradient snapshot :: a
snapshot bounds :: Rect
bounds startPoint :: Point
startPoint endPoint :: Point
endPoint stops :: [ColorStop]
stops = IO () -> m ()
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 (t :: * -> *) a. Foldable t => t a -> Int
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)
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 40 [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 (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.MethodInfo SnapshotAppendLinearGradientMethodInfo a signature where
    overloadedMethod = 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) =>
    a
    -- ^ /@snapshot@/: a @/GtkSnapshot/@
    -> Gsk.RenderNode.RenderNode
    -- ^ /@node@/: a t'GI.Gsk.Structs.RenderNode.RenderNode'
    -> m ()
snapshotAppendNode :: a -> RenderNode -> m ()
snapshotAppendNode snapshot :: a
snapshot node :: RenderNode
node = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snapshot
snapshot' <- a -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snapshot
    Ptr RenderNode
node' <- RenderNode -> IO (Ptr RenderNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RenderNode
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
    RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RenderNode
node
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotAppendNodeMethodInfo
instance (signature ~ (Gsk.RenderNode.RenderNode -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotAppendNodeMethodInfo a signature where
    overloadedMethod = 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 :: a
-> RoundedRect -> RGBA -> Float -> Float -> Float -> Float -> m ()
snapshotAppendOutsetShadow snapshot :: a
snapshot outline :: RoundedRect
outline color :: RGBA
color dx :: Float
dx dy :: Float
dy spread :: Float
spread blurRadius :: Float
blurRadius = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotAppendOutsetShadowMethodInfo a signature where
    overloadedMethod = snapshotAppendOutsetShadow

#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 "a pointer to an array of #GskColorStop 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@/: a pointer to an array of t'GI.Gsk.Structs.ColorStop.ColorStop' defining the gradient
    -> m ()
snapshotAppendRepeatingLinearGradient :: a -> Rect -> Point -> Point -> [ColorStop] -> m ()
snapshotAppendRepeatingLinearGradient snapshot :: a
snapshot bounds :: Rect
bounds startPoint :: Point
startPoint endPoint :: Point
endPoint stops :: [ColorStop]
stops = IO () -> m ()
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 (t :: * -> *) a. Foldable t => t a -> Int
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)
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 40 [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 (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.MethodInfo SnapshotAppendRepeatingLinearGradientMethodInfo a signature where
    overloadedMethod = snapshotAppendRepeatingLinearGradient

#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 #GdkTexture 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 t'GI.Gdk.Objects.Texture.Texture' to render
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the bounds for the new node
    -> m ()
snapshotAppendTexture :: a -> b -> Rect -> m ()
snapshotAppendTexture snapshot :: a
snapshot texture :: b
texture bounds :: Rect
bounds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotAppendTextureMethodInfo a signature where
    overloadedMethod = snapshotAppendTexture

#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 :: a -> Float -> m ()
snapshotPerspective snapshot :: a
snapshot depth :: Float
depth = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPerspectiveMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPerspectiveMethodInfo a signature where
    overloadedMethod = 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 :: a -> m ()
snapshotPop snapshot :: a
snapshot = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPopMethodInfo a signature where
    overloadedMethod = 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 2 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 2 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 :: a -> BlendMode -> m ()
snapshotPushBlend snapshot :: a
snapshot blendMode :: BlendMode
blendMode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotPushBlendMethodInfo a signature where
    overloadedMethod = 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"
--                 , 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
    -> m ()
snapshotPushBlur :: a -> Double -> m ()
snapshotPushBlur snapshot :: a
snapshot radius :: Double
radius = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushBlurMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPushBlurMethodInfo a signature where
    overloadedMethod = 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 :: a -> Rect -> m ()
snapshotPushClip snapshot :: a
snapshot bounds :: Rect
bounds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotPushClipMethodInfo a signature where
    overloadedMethod = 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 :: a -> Matrix -> Vec4 -> m ()
snapshotPushColorMatrix snapshot :: a
snapshot colorMatrix :: Matrix
colorMatrix colorOffset :: Vec4
colorOffset = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotPushColorMatrixMethodInfo a signature where
    overloadedMethod = 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 2 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 :: a -> Double -> m ()
snapshotPushCrossFade snapshot :: a
snapshot progress :: Double
progress = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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 :: a -> Double -> m ()
snapshotPushOpacity snapshot :: a
snapshot opacity :: Double
opacity = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushOpacityMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPushOpacityMethodInfo a signature where
    overloadedMethod = 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the bounds of the child"
--                 , 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
    -> Graphene.Rect.Rect
    -- ^ /@childBounds@/: the bounds of the child
    -> m ()
snapshotPushRepeat :: a -> Rect -> Rect -> m ()
snapshotPushRepeat snapshot :: a
snapshot bounds :: Rect
bounds childBounds :: Rect
childBounds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
childBounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
childBounds
    Ptr Snapshot -> Ptr Rect -> Ptr Rect -> IO ()
gtk_snapshot_push_repeat Ptr Snapshot
snapshot' Ptr Rect
bounds' Ptr Rect
childBounds'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
childBounds
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushRepeatMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Graphene.Rect.Rect -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPushRepeatMethodInfo a signature where
    overloadedMethod = 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 :: a -> RoundedRect -> m ()
snapshotPushRoundedClip snapshot :: a
snapshot bounds :: RoundedRect
bounds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotPushRoundedClipMethodInfo a signature where
    overloadedMethod = 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 = 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: []
-- 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 : 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
    -> Word64
    -- ^ /@nShadows@/: number of shadow specifications
    -> m ()
snapshotPushShadow :: a -> Shadow -> Word64 -> m ()
snapshotPushShadow snapshot :: a
snapshot shadow :: Shadow
shadow nShadows :: Word64
nShadows = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr 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 ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Shadow
shadow
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotPushShadowMethodInfo
instance (signature ~ (Gsk.Shadow.Shadow -> Word64 -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotPushShadowMethodInfo a signature where
    overloadedMethod = 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 #GtkStyleContext to use"
--                 , 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 t'GI.Gtk.Objects.StyleContext.StyleContext' to use
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderBackground :: a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderBackground snapshot :: a
snapshot context :: b
context x :: Double
x y :: Double
y width :: Double
width height :: Double
height = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRenderBackgroundMethodInfo a signature where
    overloadedMethod = 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 #GtkStyleContext to use"
--                 , 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 t'GI.Gtk.Objects.StyleContext.StyleContext' to use
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderFocus :: a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderFocus snapshot :: a
snapshot context :: b
context x :: Double
x y :: Double
y width :: Double
width height :: Double
height = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRenderFocusMethodInfo a signature where
    overloadedMethod = 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 #GtkStyleContext to use"
--                 , 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 t'GI.Gtk.Objects.StyleContext.StyleContext' to use
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> Double
    -- ^ /@width@/: rectangle width
    -> Double
    -- ^ /@height@/: rectangle height
    -> m ()
snapshotRenderFrame :: a -> b -> Double -> Double -> Double -> Double -> m ()
snapshotRenderFrame snapshot :: a
snapshot context :: b
context x :: Double
x y :: Double
y width :: Double
width height :: Double
height = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRenderFrameMethodInfo a signature where
    overloadedMethod = 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 t'GI.Gtk.Objects.StyleContext.StyleContext'
    -> Double
    -- ^ /@x@/: X origin
    -> Double
    -- ^ /@y@/: Y origin
    -> c
    -- ^ /@layout@/: the t'GI.Pango.Objects.Layout.Layout' of the text
    -> Int32
    -- ^ /@index@/: the index in the t'GI.Pango.Objects.Layout.Layout'
    -> Pango.Enums.Direction
    -- ^ /@direction@/: the t'GI.Pango.Enums.Direction' of the text
    -> m ()
snapshotRenderInsertionCursor :: a -> b -> Double -> Double -> c -> Int32 -> Direction -> m ()
snapshotRenderInsertionCursor snapshot :: a
snapshot context :: b
context x :: Double
x y :: Double
y layout :: c
layout index :: Int32
index direction :: Direction
direction = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRenderInsertionCursorMethodInfo a signature where
    overloadedMethod = 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 #GtkStyleContext to use"
--                 , 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 t'GI.Gtk.Objects.StyleContext.StyleContext' to use
    -> Double
    -- ^ /@x@/: X origin of the rectangle
    -> Double
    -- ^ /@y@/: Y origin of the rectangle
    -> c
    -- ^ /@layout@/: the t'GI.Pango.Objects.Layout.Layout' to render
    -> m ()
snapshotRenderLayout :: a -> b -> Double -> Double -> c -> m ()
snapshotRenderLayout snapshot :: a
snapshot context :: b
context x :: Double
x y :: Double
y layout :: c
layout = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRenderLayoutMethodInfo a signature where
    overloadedMethod = 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
-- 'GI.Gtk.Objects.Snapshot.snapshotSave' and removes that state from the stack of
-- saved states.
snapshotRestore ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @/GtkSnapshot/@
    -> m ()
snapshotRestore :: a -> m ()
snapshotRestore snapshot :: a
snapshot = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRestoreMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotRestoreMethodInfo a signature where
    overloadedMethod = 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.
snapshotRotate ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @/GtkSnapshot/@
    -> Float
    -- ^ /@angle@/: the rotation angle, in degrees (clockwise)
    -> m ()
snapshotRotate :: a -> Float -> m ()
snapshotRotate snapshot :: a
snapshot angle :: Float
angle = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotRotateMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotRotateMethodInfo a signature where
    overloadedMethod = 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 :: a -> Float -> Vec3 -> m ()
snapshotRotate3d snapshot :: a
snapshot angle :: Float
angle axis :: Vec3
axis = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotRotate3dMethodInfo a signature where
    overloadedMethod = 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 of saved states for /@snapshot@/. When
-- 'GI.Gtk.Objects.Snapshot.snapshotRestore' is called, /@snapshot@/ will be restored to
-- the saved state. Multiple calls to 'GI.Gtk.Objects.Snapshot.snapshotSave' and
-- 'GI.Gtk.Objects.Snapshot.snapshotRestore' can be nested; each call to
-- 'GI.Gtk.Objects.Snapshot.snapshotRestore' restores the state from the matching paired
-- 'GI.Gtk.Objects.Snapshot.snapshotSave'.
-- 
-- It is necessary to clear all saved states with corresponding calls
-- to 'GI.Gtk.Objects.Snapshot.snapshotRestore'.
snapshotSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @/GtkSnapshot/@
    -> m ()
snapshotSave :: a -> m ()
snapshotSave snapshot :: a
snapshot = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotSaveMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotSaveMethodInfo a signature where
    overloadedMethod = 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 :: a -> Float -> Float -> m ()
snapshotScale snapshot :: a
snapshot factorX :: Float
factorX factorY :: Float
factorY = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapshotScaleMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotScaleMethodInfo a signature where
    overloadedMethod = 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 :: a -> Float -> Float -> Float -> m ()
snapshotScale3d snapshot :: a
snapshot factorX :: Float
factorX factorY :: Float
factorY factorZ :: Float
factorZ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotScale3dMethodInfo a signature where
    overloadedMethod = 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 @/gtk_snapshot_unref()/@.
snapshotToNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapshot a) =>
    a
    -- ^ /@snapshot@/: a @/GtkSnapshot/@
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ the constructed t'GI.Gsk.Structs.RenderNode.RenderNode'
snapshotToNode :: a -> m RenderNode
snapshotToNode snapshot :: a
snapshot = IO RenderNode -> m RenderNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderNode -> m RenderNode) -> IO RenderNode -> m 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'
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "snapshotToNode" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snapshot
    RenderNode -> IO RenderNode
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
data SnapshotToNodeMethodInfo
instance (signature ~ (m Gsk.RenderNode.RenderNode), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotToNodeMethodInfo a signature where
    overloadedMethod = 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 @/gtk_snapshot_unref()/@.
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 Gdk.Paintable.Paintable
    -- ^ __Returns:__ a new t'GI.Gdk.Interfaces.Paintable.Paintable'
snapshotToPaintable :: a -> Maybe Size -> m Paintable
snapshotToPaintable snapshot :: a
snapshot size :: Maybe Size
size = IO Paintable -> m Paintable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Paintable -> m Paintable) -> IO Paintable -> m 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
        Nothing -> Ptr Size -> IO (Ptr Size)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Size
forall a. Ptr a
nullPtr
        Just jSize :: 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 (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
    Text -> Ptr Paintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "snapshotToPaintable" Ptr Paintable
result
    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
    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
    Paintable -> IO Paintable
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result'

#if defined(ENABLE_OVERLOADING)
data SnapshotToPaintableMethodInfo
instance (signature ~ (Maybe (Graphene.Size.Size) -> m Gdk.Paintable.Paintable), MonadIO m, IsSnapshot a) => O.MethodInfo SnapshotToPaintableMethodInfo a signature where
    overloadedMethod = 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 :: a -> Maybe Transform -> m ()
snapshotTransform snapshot :: a
snapshot transform :: Maybe Transform
transform = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr Transform -> IO (Ptr Transform)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Transform
forall a. Ptr a
nullPtr
        Just jTransform :: 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 (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 (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.MethodInfo SnapshotTransformMethodInfo a signature where
    overloadedMethod = 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 :: a -> Matrix -> m ()
snapshotTransformMatrix snapshot :: a
snapshot matrix :: Matrix
matrix = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotTransformMatrixMethodInfo a signature where
    overloadedMethod = 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 :: a -> Point -> m ()
snapshotTranslate snapshot :: a
snapshot point :: Point
point = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotTranslateMethodInfo a signature where
    overloadedMethod = 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 :: a -> Point3D -> m ()
snapshotTranslate3d snapshot :: a
snapshot point :: Point3D
point = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (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.MethodInfo SnapshotTranslate3dMethodInfo a signature where
    overloadedMethod = snapshotTranslate3d

#endif