{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gdk.Interfaces.Paintable.Paintable' is a simple interface used by GDK and GDK to represent
-- objects that can be painted anywhere at any size without requiring any
-- sort of layout. The interface is inspired by similar concepts elsewhere,
-- such as <https://developer.gnome.org/clutter/stable/ClutterContent.html ClutterContent>,
-- <https://www.w3.org/TR/css-images-4/#paint-source HTML/CSS Paint Sources>,
-- or <https://www.w3.org/TR/SVG2/pservers.html SVG Paint Servers>.
-- 
-- A t'GI.Gdk.Interfaces.Paintable.Paintable' can be snapshot at any time and size using
-- 'GI.Gdk.Interfaces.Paintable.paintableSnapshot'. How the paintable interprets that size and if it
-- scales or centers itself into the given rectangle is implementation defined,
-- though if you are implementing a t'GI.Gdk.Interfaces.Paintable.Paintable' and don\'t know what to do, it
-- is suggested that you scale your paintable ignoring any potential aspect ratio.
-- 
-- The contents that a t'GI.Gdk.Interfaces.Paintable.Paintable' produces may depend on the t'GI.Gdk.Objects.Snapshot.Snapshot' passed
-- to it. For example, paintables may decide to use more detailed images on higher
-- resolution screens or when OpenGL is available. A t'GI.Gdk.Interfaces.Paintable.Paintable' will however
-- always produce the same output for the same snapshot.
-- 
-- A t'GI.Gdk.Interfaces.Paintable.Paintable' may change its contents, meaning that it will now produce a
-- different output with the same snpashot. Once that happens, it will call
-- 'GI.Gdk.Interfaces.Paintable.paintableInvalidateContents' which will emit the
-- [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:signal:invalidateContents") signal.
-- If a paintable is known to never change its contents, it will set the
-- 'GI.Gdk.Flags.PaintableFlagsContents' flag. If a consumer cannot deal with changing
-- contents, it may call @/gdk_paintable_get_static_image()/@ which will return a
-- static paintable and use that.
-- 
-- A paintable can report an intrinsic (or preferred) size or aspect ratio it
-- wishes to be rendered at, though it doesn\'t have to. Consumers of the interface
-- can use this information to layout thepaintable appropriately.
-- Just like the contents, the size of a paintable can change. A paintable will
-- indicate this by calling 'GI.Gdk.Interfaces.Paintable.paintableInvalidateSize' which will emit the
-- [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:signal:invalidateSize") signal.
-- And just like for contents, if a paintable is known to never change its size,
-- it will set the 'GI.Gdk.Flags.PaintableFlagsSize' flag.
-- 
-- Besides API for applications, there are some functions that are only
-- useful for implementing subclasses and should not be used by applications:
-- 'GI.Gdk.Interfaces.Paintable.paintableInvalidateContents',
-- 'GI.Gdk.Interfaces.Paintable.paintableInvalidateSize',
-- 'GI.Gdk.Functions.paintableNewEmpty'.

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

module GI.Gdk.Interfaces.Paintable
    ( 

-- * Exported types
    Paintable(..)                           ,
    IsPaintable                             ,
    toPaintable                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePaintableMethod                  ,
#endif


-- ** computeConcreteSize #method:computeConcreteSize#

#if defined(ENABLE_OVERLOADING)
    PaintableComputeConcreteSizeMethodInfo  ,
#endif
    paintableComputeConcreteSize            ,


-- ** getCurrentImage #method:getCurrentImage#

#if defined(ENABLE_OVERLOADING)
    PaintableGetCurrentImageMethodInfo      ,
#endif
    paintableGetCurrentImage                ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    PaintableGetFlagsMethodInfo             ,
#endif
    paintableGetFlags                       ,


-- ** getIntrinsicAspectRatio #method:getIntrinsicAspectRatio#

#if defined(ENABLE_OVERLOADING)
    PaintableGetIntrinsicAspectRatioMethodInfo,
#endif
    paintableGetIntrinsicAspectRatio        ,


-- ** getIntrinsicHeight #method:getIntrinsicHeight#

#if defined(ENABLE_OVERLOADING)
    PaintableGetIntrinsicHeightMethodInfo   ,
#endif
    paintableGetIntrinsicHeight             ,


-- ** getIntrinsicWidth #method:getIntrinsicWidth#

#if defined(ENABLE_OVERLOADING)
    PaintableGetIntrinsicWidthMethodInfo    ,
#endif
    paintableGetIntrinsicWidth              ,


-- ** invalidateContents #method:invalidateContents#

#if defined(ENABLE_OVERLOADING)
    PaintableInvalidateContentsMethodInfo   ,
#endif
    paintableInvalidateContents             ,


-- ** invalidateSize #method:invalidateSize#

#if defined(ENABLE_OVERLOADING)
    PaintableInvalidateSizeMethodInfo       ,
#endif
    paintableInvalidateSize                 ,


-- ** newEmpty #method:newEmpty#

    paintableNewEmpty                       ,


-- ** snapshot #method:snapshot#

#if defined(ENABLE_OVERLOADING)
    PaintableSnapshotMethodInfo             ,
#endif
    paintableSnapshot                       ,




 -- * Signals
-- ** invalidateContents #signal:invalidateContents#

    C_PaintableInvalidateContentsCallback   ,
    PaintableInvalidateContentsCallback     ,
#if defined(ENABLE_OVERLOADING)
    PaintableInvalidateContentsSignalInfo   ,
#endif
    afterPaintableInvalidateContents        ,
    genClosure_PaintableInvalidateContents  ,
    mk_PaintableInvalidateContentsCallback  ,
    noPaintableInvalidateContentsCallback   ,
    onPaintableInvalidateContents           ,
    wrap_PaintableInvalidateContentsCallback,


-- ** invalidateSize #signal:invalidateSize#

    C_PaintableInvalidateSizeCallback       ,
    PaintableInvalidateSizeCallback         ,
#if defined(ENABLE_OVERLOADING)
    PaintableInvalidateSizeSignalInfo       ,
#endif
    afterPaintableInvalidateSize            ,
    genClosure_PaintableInvalidateSize      ,
    mk_PaintableInvalidateSizeCallback      ,
    noPaintableInvalidateSizeCallback       ,
    onPaintableInvalidateSize               ,
    wrap_PaintableInvalidateSizeCallback    ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot

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

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

foreign import ccall "gdk_paintable_get_type"
    c_gdk_paintable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Paintable where
    glibType :: IO GType
glibType = IO GType
c_gdk_paintable_get_type

instance B.Types.GObject Paintable

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

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

instance O.HasParentTypes Paintable
type instance O.ParentTypes Paintable = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePaintableMethod (t :: Symbol) (o :: *) :: * where
    ResolvePaintableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePaintableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePaintableMethod "computeConcreteSize" o = PaintableComputeConcreteSizeMethodInfo
    ResolvePaintableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePaintableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePaintableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePaintableMethod "invalidateContents" o = PaintableInvalidateContentsMethodInfo
    ResolvePaintableMethod "invalidateSize" o = PaintableInvalidateSizeMethodInfo
    ResolvePaintableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePaintableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePaintableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePaintableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePaintableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePaintableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePaintableMethod "snapshot" o = PaintableSnapshotMethodInfo
    ResolvePaintableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePaintableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePaintableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePaintableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePaintableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePaintableMethod "getCurrentImage" o = PaintableGetCurrentImageMethodInfo
    ResolvePaintableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePaintableMethod "getFlags" o = PaintableGetFlagsMethodInfo
    ResolvePaintableMethod "getIntrinsicAspectRatio" o = PaintableGetIntrinsicAspectRatioMethodInfo
    ResolvePaintableMethod "getIntrinsicHeight" o = PaintableGetIntrinsicHeightMethodInfo
    ResolvePaintableMethod "getIntrinsicWidth" o = PaintableGetIntrinsicWidthMethodInfo
    ResolvePaintableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePaintableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePaintableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePaintableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePaintableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePaintableMethod l o = O.MethodResolutionFailed l o

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

#endif

-- method Paintable::compute_concrete_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specified_width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the width @paintable could be drawn into or\n    0.0 if unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specified_height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the height @paintable could be drawn into or\n    0.0 if unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the width @paintable would be drawn into if\n    no other constraints were given"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the height @paintable would be drawn into if\n    no other constraints were given"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "concrete_width"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "will be set to the concrete width\n    computed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "concrete_height"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "will be set to the concrete height\n    computed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_paintable_compute_concrete_size" gdk_paintable_compute_concrete_size :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    CDouble ->                              -- specified_width : TBasicType TDouble
    CDouble ->                              -- specified_height : TBasicType TDouble
    CDouble ->                              -- default_width : TBasicType TDouble
    CDouble ->                              -- default_height : TBasicType TDouble
    Ptr CDouble ->                          -- concrete_width : TBasicType TDouble
    Ptr CDouble ->                          -- concrete_height : TBasicType TDouble
    IO ()

-- | Applies the sizing algorithm outlined in
-- https:\/\/drafts.csswg.org\/css-images-3\/@/default/@-sizing
-- to the given /@paintable@/. See that link for more details.
-- 
-- It is not necessary to call this function when both /@specifiedWidth@/
-- and /@specifiedHeight@/ are known, but it is useful to call this
-- function in GtkWidget:measure implementations to compute the
-- other dimension when only one dimension is given.
paintableComputeConcreteSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> Double
    -- ^ /@specifiedWidth@/: the width /@paintable@/ could be drawn into or
    --     0.0 if unknown
    -> Double
    -- ^ /@specifiedHeight@/: the height /@paintable@/ could be drawn into or
    --     0.0 if unknown
    -> Double
    -- ^ /@defaultWidth@/: the width /@paintable@/ would be drawn into if
    --     no other constraints were given
    -> Double
    -- ^ /@defaultHeight@/: the height /@paintable@/ would be drawn into if
    --     no other constraints were given
    -> m ((Double, Double))
paintableComputeConcreteSize :: a -> Double -> Double -> Double -> Double -> m (Double, Double)
paintableComputeConcreteSize a
paintable Double
specifiedWidth Double
specifiedHeight Double
defaultWidth Double
defaultHeight = IO (Double, Double) -> m (Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> m (Double, Double))
-> IO (Double, Double) -> m (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    let specifiedWidth' :: CDouble
specifiedWidth' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
specifiedWidth
    let specifiedHeight' :: CDouble
specifiedHeight' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
specifiedHeight
    let defaultWidth' :: CDouble
defaultWidth' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
defaultWidth
    let defaultHeight' :: CDouble
defaultHeight' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
defaultHeight
    Ptr CDouble
concreteWidth <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
concreteHeight <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Paintable
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO ()
gdk_paintable_compute_concrete_size Ptr Paintable
paintable' CDouble
specifiedWidth' CDouble
specifiedHeight' CDouble
defaultWidth' CDouble
defaultHeight' Ptr CDouble
concreteWidth Ptr CDouble
concreteHeight
    CDouble
concreteWidth' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
concreteWidth
    let concreteWidth'' :: Double
concreteWidth'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
concreteWidth'
    CDouble
concreteHeight' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
concreteHeight
    let concreteHeight'' :: Double
concreteHeight'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
concreteHeight'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
concreteWidth
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
concreteHeight
    (Double, Double) -> IO (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
concreteWidth'', Double
concreteHeight'')

#if defined(ENABLE_OVERLOADING)
data PaintableComputeConcreteSizeMethodInfo
instance (signature ~ (Double -> Double -> Double -> Double -> m ((Double, Double))), MonadIO m, IsPaintable a) => O.MethodInfo PaintableComputeConcreteSizeMethodInfo a signature where
    overloadedMethod = paintableComputeConcreteSize

#endif

-- method Paintable::get_current_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , 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 "gdk_paintable_get_current_image" gdk_paintable_get_current_image :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO (Ptr Paintable)

-- | Gets an immutable paintable for the current contents displayed by /@paintable@/.
-- 
-- This is useful when you want to retain the current state of an animation, for
-- example to take a screenshot of a running animation.
-- 
-- If the /@paintable@/ is already immutable, it will return itself.
paintableGetCurrentImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m Paintable
    -- ^ __Returns:__ An immutable paintable for the current
    --     contents of /@paintable@/.
paintableGetCurrentImage :: a -> m Paintable
paintableGetCurrentImage a
paintable = 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 Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Ptr Paintable
result <- Ptr Paintable -> IO (Ptr Paintable)
gdk_paintable_get_current_image Ptr Paintable
paintable'
    Text -> Ptr Paintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"paintableGetCurrentImage" 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
Paintable) Ptr Paintable
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    Paintable -> IO Paintable
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result'

#if defined(ENABLE_OVERLOADING)
data PaintableGetCurrentImageMethodInfo
instance (signature ~ (m Paintable), MonadIO m, IsPaintable a) => O.MethodInfo PaintableGetCurrentImageMethodInfo a signature where
    overloadedMethod = paintableGetCurrentImage

#endif

-- method Paintable::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "PaintableFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_paintable_get_flags" gdk_paintable_get_flags :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO CUInt

-- | Get flags for the paintable. This is oftentimes useful for optimizations.
-- 
-- See t'GI.Gdk.Flags.PaintableFlags' for the flags and what they mean.
paintableGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m [Gdk.Flags.PaintableFlags]
    -- ^ __Returns:__ The t'GI.Gdk.Flags.PaintableFlags' for this paintable.
paintableGetFlags :: a -> m [PaintableFlags]
paintableGetFlags a
paintable = IO [PaintableFlags] -> m [PaintableFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PaintableFlags] -> m [PaintableFlags])
-> IO [PaintableFlags] -> m [PaintableFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    CUInt
result <- Ptr Paintable -> IO CUInt
gdk_paintable_get_flags Ptr Paintable
paintable'
    let result' :: [PaintableFlags]
result' = CUInt -> [PaintableFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    [PaintableFlags] -> IO [PaintableFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [PaintableFlags]
result'

#if defined(ENABLE_OVERLOADING)
data PaintableGetFlagsMethodInfo
instance (signature ~ (m [Gdk.Flags.PaintableFlags]), MonadIO m, IsPaintable a) => O.MethodInfo PaintableGetFlagsMethodInfo a signature where
    overloadedMethod = paintableGetFlags

#endif

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

foreign import ccall "gdk_paintable_get_intrinsic_aspect_ratio" gdk_paintable_get_intrinsic_aspect_ratio :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO CDouble

-- | Gets the preferred aspect ratio the /@paintable@/ would like to be displayed at.
-- The aspect ration is the width divided by the height, so a value of 0.5 means
-- that the /@paintable@/ prefers to be displayed twice as high as it is wide.
-- Consumers of this interface can use this to preserve aspect ratio when displaying
-- this paintable.
-- 
-- This is a purely informational value and does not in any way limit the values
-- that may be passed to 'GI.Gdk.Interfaces.Paintable.paintableSnapshot'.
-- 
-- Usually when a /@paintable@/ returns non-0 values from
-- 'GI.Gdk.Interfaces.Paintable.paintableGetIntrinsicWidth' and 'GI.Gdk.Interfaces.Paintable.paintableGetIntrinsicHeight'
-- the aspect ratio should conform to those values, though that is not required.
-- 
-- If the /@paintable@/ does not have a preferred aspect ratio, it returns 0.0.
-- Negative values are never returned.
paintableGetIntrinsicAspectRatio ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m Double
    -- ^ __Returns:__ the intrinsic aspect ratio of /@paintable@/ or 0.0 if none.
paintableGetIntrinsicAspectRatio :: a -> m Double
paintableGetIntrinsicAspectRatio a
paintable = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    CDouble
result <- Ptr Paintable -> IO CDouble
gdk_paintable_get_intrinsic_aspect_ratio Ptr Paintable
paintable'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data PaintableGetIntrinsicAspectRatioMethodInfo
instance (signature ~ (m Double), MonadIO m, IsPaintable a) => O.MethodInfo PaintableGetIntrinsicAspectRatioMethodInfo a signature where
    overloadedMethod = paintableGetIntrinsicAspectRatio

#endif

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

foreign import ccall "gdk_paintable_get_intrinsic_height" gdk_paintable_get_intrinsic_height :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO Int32

-- | Gets the preferred height the /@paintable@/ would like to be displayed at.
-- Consumers of this interface can use this to reserve enough space to draw
-- the paintable.
-- 
-- This is a purely informational value and does not in any way limit the values
-- that may be passed to 'GI.Gdk.Interfaces.Paintable.paintableSnapshot'.
-- 
-- If the /@paintable@/ does not have a preferred height, it returns 0. Negative
-- values are never returned.
paintableGetIntrinsicHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m Int32
    -- ^ __Returns:__ the intrinsic height of /@paintable@/ or 0 if none.
paintableGetIntrinsicHeight :: a -> m Int32
paintableGetIntrinsicHeight a
paintable = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Int32
result <- Ptr Paintable -> IO Int32
gdk_paintable_get_intrinsic_height Ptr Paintable
paintable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PaintableGetIntrinsicHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPaintable a) => O.MethodInfo PaintableGetIntrinsicHeightMethodInfo a signature where
    overloadedMethod = paintableGetIntrinsicHeight

#endif

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

foreign import ccall "gdk_paintable_get_intrinsic_width" gdk_paintable_get_intrinsic_width :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO Int32

-- | Gets the preferred width the /@paintable@/ would like to be displayed at.
-- Consumers of this interface can use this to reserve enough space to draw
-- the paintable.
-- 
-- This is a purely informational value and does not in any way limit the values
-- that may be passed to 'GI.Gdk.Interfaces.Paintable.paintableSnapshot'.
-- 
-- If the /@paintable@/ does not have a preferred width, it returns 0. Negative
-- values are never returned.
paintableGetIntrinsicWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m Int32
    -- ^ __Returns:__ the intrinsic width of /@paintable@/ or 0 if none.
paintableGetIntrinsicWidth :: a -> m Int32
paintableGetIntrinsicWidth a
paintable = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Int32
result <- Ptr Paintable -> IO Int32
gdk_paintable_get_intrinsic_width Ptr Paintable
paintable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PaintableGetIntrinsicWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPaintable a) => O.MethodInfo PaintableGetIntrinsicWidthMethodInfo a signature where
    overloadedMethod = paintableGetIntrinsicWidth

#endif

-- method Paintable::invalidate_contents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_paintable_invalidate_contents" gdk_paintable_invalidate_contents :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO ()

-- | Called by implementations of t'GI.Gdk.Interfaces.Paintable.Paintable' to invalidate their contents.
-- Unless the contents are invalidated, implementations must guarantee that
-- multiple calls to GdkPaintable[snapshot](#g:signal:snapshot) produce the same output.
-- 
-- This function will emit the [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:signal:invalidateContents") signal.
-- 
-- If a /@paintable@/ reports the 'GI.Gdk.Flags.PaintableFlagsContents' flag,
-- it must not call this function.
paintableInvalidateContents ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m ()
paintableInvalidateContents :: a -> m ()
paintableInvalidateContents a
paintable = 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 Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Ptr Paintable -> IO ()
gdk_paintable_invalidate_contents Ptr Paintable
paintable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintableInvalidateContentsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPaintable a) => O.MethodInfo PaintableInvalidateContentsMethodInfo a signature where
    overloadedMethod = paintableInvalidateContents

#endif

-- method Paintable::invalidate_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_paintable_invalidate_size" gdk_paintable_invalidate_size :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO ()

-- | Called by implementations of t'GI.Gdk.Interfaces.Paintable.Paintable' to invalidate their size.
-- As long as the size is not invalidated, /@paintable@/ must return the same values
-- for its width, height and intrinsic height.
-- 
-- This function will emit the [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:signal:invalidateSize") signal.
-- 
-- If a /@paintable@/ reports the 'GI.Gdk.Flags.PaintableFlagsSize' flag,
-- it must not call this function.
paintableInvalidateSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> m ()
paintableInvalidateSize :: a -> m ()
paintableInvalidateSize a
paintable = 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 Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Ptr Paintable -> IO ()
gdk_paintable_invalidate_size Ptr Paintable
paintable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintableInvalidateSizeMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPaintable a) => O.MethodInfo PaintableInvalidateSizeMethodInfo a signature where
    overloadedMethod = paintableInvalidateSize

#endif

-- method Paintable::snapshot
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "snapshot"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Snapshot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkSnapshot to snapshot to"
--                 , 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 "width to snapshot in"
--                 , 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 "height to snapshot in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_paintable_snapshot" gdk_paintable_snapshot :: 
    Ptr Paintable ->                        -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    Ptr Gdk.Snapshot.Snapshot ->            -- snapshot : TInterface (Name {namespace = "Gdk", name = "Snapshot"})
    CDouble ->                              -- width : TBasicType TDouble
    CDouble ->                              -- height : TBasicType TDouble
    IO ()

-- | Snapshots the given paintable with the given /@width@/ and /@height@/ at the
-- current (0,0) offset of the /@snapshot@/. If /@width@/ and /@height@/ are not larger
-- than zero, this function will do nothing.
paintableSnapshot ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaintable a, Gdk.Snapshot.IsSnapshot b) =>
    a
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable'
    -> b
    -- ^ /@snapshot@/: a t'GI.Gdk.Objects.Snapshot.Snapshot' to snapshot to
    -> Double
    -- ^ /@width@/: width to snapshot in
    -> Double
    -- ^ /@height@/: height to snapshot in
    -> m ()
paintableSnapshot :: a -> b -> Double -> Double -> m ()
paintableSnapshot a
paintable b
snapshot Double
width 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 Paintable
paintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paintable
    Ptr Snapshot
snapshot' <- b -> IO (Ptr Snapshot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
snapshot
    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 Paintable -> Ptr Snapshot -> CDouble -> CDouble -> IO ()
gdk_paintable_snapshot Ptr Paintable
paintable' Ptr Snapshot
snapshot' CDouble
width' CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
snapshot
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintableSnapshotMethodInfo
instance (signature ~ (b -> Double -> Double -> m ()), MonadIO m, IsPaintable a, Gdk.Snapshot.IsSnapshot b) => O.MethodInfo PaintableSnapshotMethodInfo a signature where
    overloadedMethod = paintableSnapshot

#endif

-- method Paintable::new_empty
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "intrinsic_width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The intrinsic width to report. Can be 0 for no width."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "intrinsic_height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The intrinsic height to report. Can be 0 for no height."
--                 , 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 "gdk_paintable_new_empty" gdk_paintable_new_empty :: 
    Int32 ->                                -- intrinsic_width : TBasicType TInt
    Int32 ->                                -- intrinsic_height : TBasicType TInt
    IO (Ptr Paintable)

-- | Returns a paintable that has the given intrinsic size and draws nothing.
-- This is often useful for implementing the t'GI.Gdk.Structs.PaintableInterface.PaintableInterface'.@/get_current_image/@()
-- virtual function when the paintable is in an incomplete state (like a
-- @/GtkMediaStream/@ before receiving the first frame).
paintableNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@intrinsicWidth@/: The intrinsic width to report. Can be 0 for no width.
    -> Int32
    -- ^ /@intrinsicHeight@/: The intrinsic height to report. Can be 0 for no height.
    -> m Paintable
    -- ^ __Returns:__ a t'GI.Gdk.Interfaces.Paintable.Paintable'
paintableNewEmpty :: Int32 -> Int32 -> m Paintable
paintableNewEmpty Int32
intrinsicWidth Int32
intrinsicHeight = 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 Paintable
result <- Int32 -> Int32 -> IO (Ptr Paintable)
gdk_paintable_new_empty Int32
intrinsicWidth Int32
intrinsicHeight
    Text -> Ptr Paintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"paintableNewEmpty" 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
Paintable) Ptr Paintable
result
    Paintable -> IO Paintable
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- signal Paintable::invalidate-contents
-- | Emitted when the contents of the /@paintable@/ change.
-- 
-- Examples for such an event would be videos changing to the next frame or
-- the icon theme for an icon changing.
type PaintableInvalidateContentsCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PaintableInvalidateContentsCallback`@.
noPaintableInvalidateContentsCallback :: Maybe PaintableInvalidateContentsCallback
noPaintableInvalidateContentsCallback :: Maybe (IO ())
noPaintableInvalidateContentsCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_PaintableInvalidateContentsCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_PaintableInvalidateContentsCallback`.
foreign import ccall "wrapper"
    mk_PaintableInvalidateContentsCallback :: C_PaintableInvalidateContentsCallback -> IO (FunPtr C_PaintableInvalidateContentsCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_PaintableInvalidateContents :: MonadIO m => PaintableInvalidateContentsCallback -> m (GClosure C_PaintableInvalidateContentsCallback)
genClosure_PaintableInvalidateContents :: IO () -> m (GClosure C_PaintableInvalidateContentsCallback)
genClosure_PaintableInvalidateContents IO ()
cb = IO (GClosure C_PaintableInvalidateContentsCallback)
-> m (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PaintableInvalidateContentsCallback)
 -> m (GClosure C_PaintableInvalidateContentsCallback))
-> IO (GClosure C_PaintableInvalidateContentsCallback)
-> m (GClosure C_PaintableInvalidateContentsCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateContentsCallback IO ()
cb
    C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateContentsCallback C_PaintableInvalidateContentsCallback
cb' IO (FunPtr C_PaintableInvalidateContentsCallback)
-> (FunPtr C_PaintableInvalidateContentsCallback
    -> IO (GClosure C_PaintableInvalidateContentsCallback))
-> IO (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PaintableInvalidateContentsCallback
-> IO (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PaintableInvalidateContentsCallback` into a `C_PaintableInvalidateContentsCallback`.
wrap_PaintableInvalidateContentsCallback ::
    PaintableInvalidateContentsCallback ->
    C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateContentsCallback :: IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateContentsCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [invalidateContents](#signal:invalidateContents) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paintable #invalidateContents callback
-- @
-- 
-- 
onPaintableInvalidateContents :: (IsPaintable a, MonadIO m) => a -> PaintableInvalidateContentsCallback -> m SignalHandlerId
onPaintableInvalidateContents :: a -> IO () -> m SignalHandlerId
onPaintableInvalidateContents a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateContentsCallback IO ()
cb
    FunPtr C_PaintableInvalidateContentsCallback
cb'' <- C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateContentsCallback C_PaintableInvalidateContentsCallback
cb'
    a
-> Text
-> FunPtr C_PaintableInvalidateContentsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate-contents" FunPtr C_PaintableInvalidateContentsCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [invalidateContents](#signal:invalidateContents) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paintable #invalidateContents callback
-- @
-- 
-- 
afterPaintableInvalidateContents :: (IsPaintable a, MonadIO m) => a -> PaintableInvalidateContentsCallback -> m SignalHandlerId
afterPaintableInvalidateContents :: a -> IO () -> m SignalHandlerId
afterPaintableInvalidateContents a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateContentsCallback IO ()
cb
    FunPtr C_PaintableInvalidateContentsCallback
cb'' <- C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateContentsCallback C_PaintableInvalidateContentsCallback
cb'
    a
-> Text
-> FunPtr C_PaintableInvalidateContentsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate-contents" FunPtr C_PaintableInvalidateContentsCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PaintableInvalidateContentsSignalInfo
instance SignalInfo PaintableInvalidateContentsSignalInfo where
    type HaskellCallbackType PaintableInvalidateContentsSignalInfo = PaintableInvalidateContentsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PaintableInvalidateContentsCallback cb
        cb'' <- mk_PaintableInvalidateContentsCallback cb'
        connectSignalFunPtr obj "invalidate-contents" cb'' connectMode detail

#endif

-- signal Paintable::invalidate-size
-- | Emitted when the intrinsic size of the /@paintable@/ changes. This means the values
-- reported by at least one of 'GI.Gdk.Interfaces.Paintable.paintableGetIntrinsicWidth',
-- 'GI.Gdk.Interfaces.Paintable.paintableGetIntrinsicHeight' or 'GI.Gdk.Interfaces.Paintable.paintableGetIntrinsicAspectRatio'
-- has changed.
-- 
-- Examples for such an event would be a paintable displaying the contents of a toplevel
-- surface being resized.
type PaintableInvalidateSizeCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PaintableInvalidateSizeCallback`@.
noPaintableInvalidateSizeCallback :: Maybe PaintableInvalidateSizeCallback
noPaintableInvalidateSizeCallback :: Maybe (IO ())
noPaintableInvalidateSizeCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_PaintableInvalidateSizeCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_PaintableInvalidateSizeCallback`.
foreign import ccall "wrapper"
    mk_PaintableInvalidateSizeCallback :: C_PaintableInvalidateSizeCallback -> IO (FunPtr C_PaintableInvalidateSizeCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_PaintableInvalidateSize :: MonadIO m => PaintableInvalidateSizeCallback -> m (GClosure C_PaintableInvalidateSizeCallback)
genClosure_PaintableInvalidateSize :: IO () -> m (GClosure C_PaintableInvalidateContentsCallback)
genClosure_PaintableInvalidateSize IO ()
cb = IO (GClosure C_PaintableInvalidateContentsCallback)
-> m (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PaintableInvalidateContentsCallback)
 -> m (GClosure C_PaintableInvalidateContentsCallback))
-> IO (GClosure C_PaintableInvalidateContentsCallback)
-> m (GClosure C_PaintableInvalidateContentsCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateSizeCallback IO ()
cb
    C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateSizeCallback C_PaintableInvalidateContentsCallback
cb' IO (FunPtr C_PaintableInvalidateContentsCallback)
-> (FunPtr C_PaintableInvalidateContentsCallback
    -> IO (GClosure C_PaintableInvalidateContentsCallback))
-> IO (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PaintableInvalidateContentsCallback
-> IO (GClosure C_PaintableInvalidateContentsCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PaintableInvalidateSizeCallback` into a `C_PaintableInvalidateSizeCallback`.
wrap_PaintableInvalidateSizeCallback ::
    PaintableInvalidateSizeCallback ->
    C_PaintableInvalidateSizeCallback
wrap_PaintableInvalidateSizeCallback :: IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateSizeCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [invalidateSize](#signal:invalidateSize) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paintable #invalidateSize callback
-- @
-- 
-- 
onPaintableInvalidateSize :: (IsPaintable a, MonadIO m) => a -> PaintableInvalidateSizeCallback -> m SignalHandlerId
onPaintableInvalidateSize :: a -> IO () -> m SignalHandlerId
onPaintableInvalidateSize a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateSizeCallback IO ()
cb
    FunPtr C_PaintableInvalidateContentsCallback
cb'' <- C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateSizeCallback C_PaintableInvalidateContentsCallback
cb'
    a
-> Text
-> FunPtr C_PaintableInvalidateContentsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate-size" FunPtr C_PaintableInvalidateContentsCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [invalidateSize](#signal:invalidateSize) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paintable #invalidateSize callback
-- @
-- 
-- 
afterPaintableInvalidateSize :: (IsPaintable a, MonadIO m) => a -> PaintableInvalidateSizeCallback -> m SignalHandlerId
afterPaintableInvalidateSize :: a -> IO () -> m SignalHandlerId
afterPaintableInvalidateSize a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PaintableInvalidateContentsCallback
cb' = IO () -> C_PaintableInvalidateContentsCallback
wrap_PaintableInvalidateSizeCallback IO ()
cb
    FunPtr C_PaintableInvalidateContentsCallback
cb'' <- C_PaintableInvalidateContentsCallback
-> IO (FunPtr C_PaintableInvalidateContentsCallback)
mk_PaintableInvalidateSizeCallback C_PaintableInvalidateContentsCallback
cb'
    a
-> Text
-> FunPtr C_PaintableInvalidateContentsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate-size" FunPtr C_PaintableInvalidateContentsCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PaintableInvalidateSizeSignalInfo
instance SignalInfo PaintableInvalidateSizeSignalInfo where
    type HaskellCallbackType PaintableInvalidateSizeSignalInfo = PaintableInvalidateSizeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PaintableInvalidateSizeCallback cb
        cb'' <- mk_PaintableInvalidateSizeCallback cb'
        connectSignalFunPtr obj "invalidate-size" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Paintable = PaintableSignalList
type PaintableSignalList = ('[ '("invalidateContents", PaintableInvalidateContentsSignalInfo), '("invalidateSize", PaintableInvalidateSizeSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif