{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.Image.Image' structure contains
-- private data and should only be accessed using the provided
-- API.
-- 
-- /Since: 1.10/

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

module GI.Clutter.Objects.Image
    ( 

-- * Exported types
    Image(..)                               ,
    IsImage                                 ,
    toImage                                 ,


 -- * 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"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidate]("GI.Clutter.Interfaces.Content#g:method:invalidate"), [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"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPreferredSize]("GI.Clutter.Interfaces.Content#g:method:getPreferredSize"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setArea]("GI.Clutter.Objects.Image#g:method:setArea"), [setBytes]("GI.Clutter.Objects.Image#g:method:setBytes"), [setData]("GI.Clutter.Objects.Image#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveImageMethod                      ,
#endif

-- ** new #method:new#

    imageNew                                ,


-- ** setArea #method:setArea#

#if defined(ENABLE_OVERLOADING)
    ImageSetAreaMethodInfo                  ,
#endif
    imageSetArea                            ,


-- ** setBytes #method:setBytes#

#if defined(ENABLE_OVERLOADING)
    ImageSetBytesMethodInfo                 ,
#endif
    imageSetBytes                           ,


-- ** setData #method:setData#

#if defined(ENABLE_OVERLOADING)
    ImageSetDataMethodInfo                  ,
#endif
    imageSetData                            ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.Cairo.Structs.RectangleInt as Cairo.RectangleInt
import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Animatable as Clutter.Animatable
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Container as Clutter.Container
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Content as Clutter.Content
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animation as Clutter.Animation
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animator as Clutter.Animator
import {-# SOURCE #-} qualified GI.Clutter.Objects.Backend as Clutter.Backend
import {-# SOURCE #-} qualified GI.Clutter.Objects.ChildMeta as Clutter.ChildMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Constraint as Clutter.Constraint
import {-# SOURCE #-} qualified GI.Clutter.Objects.DeviceManager as Clutter.DeviceManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.Effect as Clutter.Effect
import {-# SOURCE #-} qualified GI.Clutter.Objects.Group as Clutter.Group
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Objects.Interval as Clutter.Interval
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutManager as Clutter.LayoutManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutMeta as Clutter.LayoutMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Script as Clutter.Script
import {-# SOURCE #-} qualified GI.Clutter.Objects.Shader as Clutter.Shader
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage
import {-# SOURCE #-} qualified GI.Clutter.Objects.State as Clutter.State
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import {-# SOURCE #-} qualified GI.Clutter.Objects.Transition as Clutter.Transition
import {-# SOURCE #-} qualified GI.Clutter.Structs.ActorBox as Clutter.ActorBox
import {-# SOURCE #-} qualified GI.Clutter.Structs.AnimatorKey as Clutter.AnimatorKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.ButtonEvent as Clutter.ButtonEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Color as Clutter.Color
import {-# SOURCE #-} qualified GI.Clutter.Structs.CrossingEvent as Clutter.CrossingEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.EventSequence as Clutter.EventSequence
import {-# SOURCE #-} qualified GI.Clutter.Structs.Fog as Clutter.Fog
import {-# SOURCE #-} qualified GI.Clutter.Structs.Geometry as Clutter.Geometry
import {-# SOURCE #-} qualified GI.Clutter.Structs.KeyEvent as Clutter.KeyEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Margin as Clutter.Margin
import {-# SOURCE #-} qualified GI.Clutter.Structs.Matrix as Clutter.Matrix
import {-# SOURCE #-} qualified GI.Clutter.Structs.MotionEvent as Clutter.MotionEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.PaintVolume as Clutter.PaintVolume
import {-# SOURCE #-} qualified GI.Clutter.Structs.Perspective as Clutter.Perspective
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Structs.Rect as Clutter.Rect
import {-# SOURCE #-} qualified GI.Clutter.Structs.ScrollEvent as Clutter.ScrollEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Size as Clutter.Size
import {-# SOURCE #-} qualified GI.Clutter.Structs.StateKey as Clutter.StateKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.Vertex as Clutter.Vertex
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.Cogl.Enums as Cogl.Enums
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Json.Structs.Node as Json.Node
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.Layout as Pango.Layout

#else
import qualified GI.Cairo.Structs.RectangleInt as Cairo.RectangleInt
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Content as Clutter.Content
import qualified GI.Cogl.Enums as Cogl.Enums
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object

#endif

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

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

foreign import ccall "clutter_image_get_type"
    c_clutter_image_get_type :: IO B.Types.GType

instance B.Types.TypedObject Image where
    glibType :: IO GType
glibType = IO GType
c_clutter_image_get_type

instance B.Types.GObject Image

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

instance O.HasParentTypes Image
type instance O.ParentTypes Image = '[GObject.Object.Object, Clutter.Content.Content]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveImageMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveImageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveImageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveImageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveImageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveImageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveImageMethod "invalidate" o = Clutter.Content.ContentInvalidateMethodInfo
    ResolveImageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveImageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveImageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveImageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveImageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveImageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveImageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveImageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveImageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveImageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveImageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveImageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveImageMethod "getPreferredSize" o = Clutter.Content.ContentGetPreferredSizeMethodInfo
    ResolveImageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveImageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveImageMethod "setArea" o = ImageSetAreaMethodInfo
    ResolveImageMethod "setBytes" o = ImageSetBytesMethodInfo
    ResolveImageMethod "setData" o = ImageSetDataMethodInfo
    ResolveImageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveImageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveImageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Image
type instance O.AttributeList Image = ImageAttributeList
type ImageAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Image = ImageSignalList
type ImageSignalList = ('[ '("attached", Clutter.Content.ContentAttachedSignalInfo), '("detached", Clutter.Content.ContentDetachedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Image::set_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterImage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image data, as an array of bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixel_format"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "PixelFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Cogl pixel format of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "RectangleInt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a rectangle indicating the area that should be set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row_stride"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of each row inside @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_image_set_area" clutter_image_set_area :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Clutter", name = "Image"})
    Ptr Word8 ->                            -- data : TCArray False (-1) (-1) (TBasicType TUInt8)
    CUInt ->                                -- pixel_format : TInterface (Name {namespace = "Cogl", name = "PixelFormat"})
    Ptr Cairo.RectangleInt.RectangleInt ->  -- rect : TInterface (Name {namespace = "cairo", name = "RectangleInt"})
    Word32 ->                               -- row_stride : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the image data to be display by /@image@/, using /@rect@/ to indicate
-- the position and size of the image data to be set.
-- 
-- If the /@image@/ does not have any image data set when this function is
-- called, a new texture will be created with the size of the width and
-- height of the rectangle, i.e. calling this function on a newly created
-- t'GI.Clutter.Objects.Image.Image' will be the equivalent of calling 'GI.Clutter.Objects.Image.imageSetData'.
-- 
-- If the image data was successfully loaded, the /@image@/ will be invalidated.
-- 
-- In case of error, the /@error@/ value will be set, and this function will
-- return 'P.False'.
-- 
-- The image data is copied in texture memory.
-- 
-- /Since: 1.10/
imageSetArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: a t'GI.Clutter.Objects.Image.Image'
    -> Ptr Word8
    -- ^ /@data@/: the image data, as an array of bytes
    -> Cogl.Enums.PixelFormat
    -- ^ /@pixelFormat@/: the Cogl pixel format of the image data
    -> Cairo.RectangleInt.RectangleInt
    -- ^ /@rect@/: a rectangle indicating the area that should be set
    -> Word32
    -- ^ /@rowStride@/: the length of each row inside /@data@/
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
imageSetArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Ptr Word8 -> PixelFormat -> RectangleInt -> Word32 -> m ()
imageSetArea a
image Ptr Word8
data_ PixelFormat
pixelFormat RectangleInt
rect Word32
rowStride = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let pixelFormat' :: CUInt
pixelFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PixelFormat -> Int) -> PixelFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum) PixelFormat
pixelFormat
    Ptr RectangleInt
rect' <- RectangleInt -> IO (Ptr RectangleInt)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RectangleInt
rect
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Image
-> Ptr Word8
-> CUInt
-> Ptr RectangleInt
-> Word32
-> Ptr (Ptr GError)
-> IO CInt
clutter_image_set_area Ptr Image
image' Ptr Word8
data_ CUInt
pixelFormat' Ptr RectangleInt
rect' Word32
rowStride
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
        RectangleInt -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RectangleInt
rect
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ImageSetAreaMethodInfo
instance (signature ~ (Ptr Word8 -> Cogl.Enums.PixelFormat -> Cairo.RectangleInt.RectangleInt -> Word32 -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetAreaMethodInfo a signature where
    overloadedMethod = imageSetArea

instance O.OverloadedMethodInfo ImageSetAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Image.imageSetArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-Image.html#v:imageSetArea"
        })


#endif

-- method Image::set_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterImage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image data, as a #GBytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixel_format"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "PixelFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Cogl pixel format of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row_stride"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of each row inside @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_image_set_bytes" clutter_image_set_bytes :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Clutter", name = "Image"})
    Ptr GLib.Bytes.Bytes ->                 -- data : TInterface (Name {namespace = "GLib", name = "Bytes"})
    CUInt ->                                -- pixel_format : TInterface (Name {namespace = "Cogl", name = "PixelFormat"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    Word32 ->                               -- row_stride : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the image data stored inside a t'GI.GLib.Structs.Bytes.Bytes' to be displayed by /@image@/.
-- 
-- If the image data was successfully loaded, the /@image@/ will be invalidated.
-- 
-- In case of error, the /@error@/ value will be set, and this function will
-- return 'P.False'.
-- 
-- The image data contained inside the t'GI.GLib.Structs.Bytes.Bytes' is copied in texture memory,
-- and no additional reference is acquired on the /@data@/.
-- 
-- /Since: 1.12/
imageSetBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: a t'GI.Clutter.Objects.Image.Image'
    -> GLib.Bytes.Bytes
    -- ^ /@data@/: the image data, as a t'GI.GLib.Structs.Bytes.Bytes'
    -> Cogl.Enums.PixelFormat
    -- ^ /@pixelFormat@/: the Cogl pixel format of the image data
    -> Word32
    -- ^ /@width@/: the width of the image data
    -> Word32
    -- ^ /@height@/: the height of the image data
    -> Word32
    -- ^ /@rowStride@/: the length of each row inside /@data@/
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
imageSetBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Bytes -> PixelFormat -> Word32 -> Word32 -> Word32 -> m ()
imageSetBytes a
image Bytes
data_ PixelFormat
pixelFormat Word32
width Word32
height Word32
rowStride = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Bytes
data_' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
data_
    let pixelFormat' :: CUInt
pixelFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PixelFormat -> Int) -> PixelFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum) PixelFormat
pixelFormat
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Image
-> Ptr Bytes
-> CUInt
-> Word32
-> Word32
-> Word32
-> Ptr (Ptr GError)
-> IO CInt
clutter_image_set_bytes Ptr Image
image' Ptr Bytes
data_' CUInt
pixelFormat' Word32
width Word32
height Word32
rowStride
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
data_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ImageSetBytesMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> Cogl.Enums.PixelFormat -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetBytesMethodInfo a signature where
    overloadedMethod = imageSetBytes

instance O.OverloadedMethodInfo ImageSetBytesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Image.imageSetBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-Image.html#v:imageSetBytes"
        })


#endif

-- method Image::set_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterImage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image data, as an array of bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixel_format"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "PixelFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Cogl pixel format of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the image data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row_stride"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of each row inside @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_image_set_data" clutter_image_set_data :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Clutter", name = "Image"})
    Ptr Word8 ->                            -- data : TCArray False (-1) (-1) (TBasicType TUInt8)
    CUInt ->                                -- pixel_format : TInterface (Name {namespace = "Cogl", name = "PixelFormat"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    Word32 ->                               -- row_stride : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the image data to be displayed by /@image@/.
-- 
-- If the image data was successfully loaded, the /@image@/ will be invalidated.
-- 
-- In case of error, the /@error@/ value will be set, and this function will
-- return 'P.False'.
-- 
-- The image data is copied in texture memory.
-- 
-- The image data is expected to be a linear array of RGBA or RGB pixel data;
-- how to retrieve that data is left to platform specific image loaders. For
-- instance, if you use the GdkPixbuf library:
-- 
-- 
-- === /C code/
-- >
-- >  ClutterContent *image = clutter_image_new ();
-- >
-- >  GdkPixbuf *pixbuf = gdk_pixbuf_new_from_file (filename, NULL);
-- >
-- >  clutter_image_set_data (CLUTTER_IMAGE (image),
-- >                          gdk_pixbuf_get_pixels (pixbuf),
-- >                          gdk_pixbuf_get_has_alpha (pixbuf)
-- >                            ? COGL_PIXEL_FORMAT_RGBA_8888
-- >                            : COGL_PIXEL_FORMAT_RGB_888,
-- >                          gdk_pixbuf_get_width (pixbuf),
-- >                          gdk_pixbuf_get_height (pixbuf),
-- >                          gdk_pixbuf_get_rowstride (pixbuf),
-- >                          &error);
-- >
-- >  g_object_unref (pixbuf);
-- 
-- 
-- /Since: 1.10/
imageSetData ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: a t'GI.Clutter.Objects.Image.Image'
    -> Ptr Word8
    -- ^ /@data@/: the image data, as an array of bytes
    -> Cogl.Enums.PixelFormat
    -- ^ /@pixelFormat@/: the Cogl pixel format of the image data
    -> Word32
    -- ^ /@width@/: the width of the image data
    -> Word32
    -- ^ /@height@/: the height of the image data
    -> Word32
    -- ^ /@rowStride@/: the length of each row inside /@data@/
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
imageSetData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Ptr Word8 -> PixelFormat -> Word32 -> Word32 -> Word32 -> m ()
imageSetData a
image Ptr Word8
data_ PixelFormat
pixelFormat Word32
width Word32
height Word32
rowStride = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let pixelFormat' :: CUInt
pixelFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PixelFormat -> Int) -> PixelFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum) PixelFormat
pixelFormat
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Image
-> Ptr Word8
-> CUInt
-> Word32
-> Word32
-> Word32
-> Ptr (Ptr GError)
-> IO CInt
clutter_image_set_data Ptr Image
image' Ptr Word8
data_ CUInt
pixelFormat' Word32
width Word32
height Word32
rowStride
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ImageSetDataMethodInfo
instance (signature ~ (Ptr Word8 -> Cogl.Enums.PixelFormat -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetDataMethodInfo a signature where
    overloadedMethod = imageSetData

instance O.OverloadedMethodInfo ImageSetDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Image.imageSetData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Objects-Image.html#v:imageSetData"
        })


#endif

-- method Image::new
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Content" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_image_new" clutter_image_new :: 
    IO (Ptr Clutter.Content.Content)

-- | Creates a new t'GI.Clutter.Objects.Image.Image' instance.
-- 
-- /Since: 1.10/
imageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Content.Content
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Image.Image' instance.
    --   Use 'GI.GObject.Objects.Object.objectUnref' when done.
imageNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Content
imageNew  = IO Content -> m Content
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Content -> m Content) -> IO Content -> m Content
forall a b. (a -> b) -> a -> b
$ do
    Ptr Content
result <- IO (Ptr Content)
clutter_image_new
    Text -> Ptr Content -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNew" Ptr Content
result
    Content
result' <- ((ManagedPtr Content -> Content) -> Ptr Content -> IO Content
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Content -> Content
Clutter.Content.Content) Ptr Content
result
    Content -> IO Content
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Content
result'

#if defined(ENABLE_OVERLOADING)
#endif