{-# 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Cairo.Structs.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

-- | 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
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: 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 (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 (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 :: *) :: * 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, *)])
#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, *)])

#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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
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.2/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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
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.2/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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
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.2/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 (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 (m :: * -> *) a. Monad m => a -> m a
return Content
result'

#if defined(ENABLE_OVERLOADING)
#endif