{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkSymbolicPaintable@ is an interface that support symbolic colors in
-- paintables.
-- 
-- @GdkPaintable@s implementing the interface will have the
-- t'GI.Gtk.Interfaces.SymbolicPaintable.SymbolicPaintable'.@/snapshot_symbolic/@() function called and
-- have the colors for drawing symbolic icons passed. At least 4 colors are guaranteed
-- to be passed every time.
-- 
-- These 4 colors are the foreground color, and the colors to use for errors, warnings
-- and success information in that order.
-- 
-- More colors may be added in the future.
-- 
-- /Since: 4.6/

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

module GI.Gtk.Interfaces.SymbolicPaintable
    ( 

-- * Exported types
    SymbolicPaintable(..)                   ,
    IsSymbolicPaintable                     ,
    toSymbolicPaintable                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [computeConcreteSize]("GI.Gdk.Interfaces.Paintable#g:method:computeConcreteSize"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:method:invalidateContents"), [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:method:invalidateSize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [snapshot]("GI.Gdk.Interfaces.Paintable#g:method:snapshot"), [snapshotSymbolic]("GI.Gtk.Interfaces.SymbolicPaintable#g:method:snapshotSymbolic"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCurrentImage]("GI.Gdk.Interfaces.Paintable#g:method:getCurrentImage"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gdk.Interfaces.Paintable#g:method:getFlags"), [getIntrinsicAspectRatio]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicAspectRatio"), [getIntrinsicHeight]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicHeight"), [getIntrinsicWidth]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicWidth"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSymbolicPaintableMethod          ,
#endif

-- ** snapshotSymbolic #method:snapshotSymbolic#

#if defined(ENABLE_OVERLOADING)
    SymbolicPaintableSnapshotSymbolicMethodInfo,
#endif
    symbolicPaintableSnapshotSymbolic       ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.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.Structs.RGBA as Gdk.RGBA

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

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

foreign import ccall "gtk_symbolic_paintable_get_type"
    c_gtk_symbolic_paintable_get_type :: IO B.Types.GType

instance B.Types.TypedObject SymbolicPaintable where
    glibType :: IO GType
glibType = IO GType
c_gtk_symbolic_paintable_get_type

instance B.Types.GObject SymbolicPaintable

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

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

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

-- | Convert 'SymbolicPaintable' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SymbolicPaintable) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_symbolic_paintable_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SymbolicPaintable -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SymbolicPaintable
P.Nothing = Ptr GValue -> Ptr SymbolicPaintable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SymbolicPaintable
forall a. Ptr a
FP.nullPtr :: FP.Ptr SymbolicPaintable)
    gvalueSet_ Ptr GValue
gv (P.Just SymbolicPaintable
obj) = SymbolicPaintable -> (Ptr SymbolicPaintable -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SymbolicPaintable
obj (Ptr GValue -> Ptr SymbolicPaintable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SymbolicPaintable)
gvalueGet_ Ptr GValue
gv = do
        Ptr SymbolicPaintable
ptr <- Ptr GValue -> IO (Ptr SymbolicPaintable)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SymbolicPaintable)
        if Ptr SymbolicPaintable
ptr Ptr SymbolicPaintable -> Ptr SymbolicPaintable -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SymbolicPaintable
forall a. Ptr a
FP.nullPtr
        then SymbolicPaintable -> Maybe SymbolicPaintable
forall a. a -> Maybe a
P.Just (SymbolicPaintable -> Maybe SymbolicPaintable)
-> IO SymbolicPaintable -> IO (Maybe SymbolicPaintable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SymbolicPaintable -> SymbolicPaintable)
-> Ptr SymbolicPaintable -> IO SymbolicPaintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SymbolicPaintable -> SymbolicPaintable
SymbolicPaintable Ptr SymbolicPaintable
ptr
        else Maybe SymbolicPaintable -> IO (Maybe SymbolicPaintable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SymbolicPaintable
forall a. Maybe a
P.Nothing
        
    

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveSymbolicPaintableMethod t SymbolicPaintable, O.OverloadedMethod info SymbolicPaintable p, R.HasField t SymbolicPaintable p) => R.HasField t SymbolicPaintable p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- method SymbolicPaintable::snapshot_symbolic
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SymbolicPaintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkSymbolicPaintable`"
--                 , 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
--           }
--       , Arg
--           { argCName = "colors"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 5
--                 (TInterface Name { namespace = "Gdk" , name = "RGBA" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an array of colors"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_colors"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of colors"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_colors"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of colors"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_symbolic_paintable_snapshot_symbolic" gtk_symbolic_paintable_snapshot_symbolic :: 
    Ptr SymbolicPaintable ->                -- paintable : TInterface (Name {namespace = "Gtk", name = "SymbolicPaintable"})
    Ptr Gdk.Snapshot.Snapshot ->            -- snapshot : TInterface (Name {namespace = "Gdk", name = "Snapshot"})
    CDouble ->                              -- width : TBasicType TDouble
    CDouble ->                              -- height : TBasicType TDouble
    Ptr Gdk.RGBA.RGBA ->                    -- colors : TCArray False (-1) 5 (TInterface (Name {namespace = "Gdk", name = "RGBA"}))
    Word64 ->                               -- n_colors : TBasicType TUInt64
    IO ()

-- | Snapshots the paintable with the given colors.
-- 
-- If less than 4 colors are provided, GTK will pad the array with default
-- colors.
-- 
-- /Since: 4.6/
symbolicPaintableSnapshotSymbolic ::
    (B.CallStack.HasCallStack, MonadIO m, IsSymbolicPaintable a, Gdk.Snapshot.IsSnapshot b) =>
    a
    -- ^ /@paintable@/: a @GtkSymbolicPaintable@
    -> b
    -- ^ /@snapshot@/: a @GdkSnapshot@ to snapshot to
    -> Double
    -- ^ /@width@/: width to snapshot in
    -> Double
    -- ^ /@height@/: height to snapshot in
    -> [Gdk.RGBA.RGBA]
    -- ^ /@colors@/: a pointer to an array of colors
    -> m ()
symbolicPaintableSnapshotSymbolic :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSymbolicPaintable a, IsSnapshot b) =>
a -> b -> Double -> Double -> [RGBA] -> m ()
symbolicPaintableSnapshotSymbolic a
paintable b
snapshot Double
width Double
height [RGBA]
colors = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nColors :: Word64
nColors = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [RGBA] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [RGBA]
colors
    Ptr SymbolicPaintable
paintable' <- a -> IO (Ptr SymbolicPaintable)
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 RGBA]
colors' <- (RGBA -> IO (Ptr RGBA)) -> [RGBA] -> IO [Ptr RGBA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [RGBA]
colors
    Ptr RGBA
colors'' <- Int -> [Ptr RGBA] -> IO (Ptr RGBA)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr RGBA]
colors'
    Ptr SymbolicPaintable
-> Ptr Snapshot
-> CDouble
-> CDouble
-> Ptr RGBA
-> Word64
-> IO ()
gtk_symbolic_paintable_snapshot_symbolic Ptr SymbolicPaintable
paintable' Ptr Snapshot
snapshot' CDouble
width' CDouble
height' Ptr RGBA
colors'' Word64
nColors
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paintable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
snapshot
    (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]
colors
    Ptr RGBA -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr RGBA
colors''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SymbolicPaintableSnapshotSymbolicMethodInfo
instance (signature ~ (b -> Double -> Double -> [Gdk.RGBA.RGBA] -> m ()), MonadIO m, IsSymbolicPaintable a, Gdk.Snapshot.IsSnapshot b) => O.OverloadedMethod SymbolicPaintableSnapshotSymbolicMethodInfo a signature where
    overloadedMethod = symbolicPaintableSnapshotSymbolic

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


#endif

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

#endif