{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gdk.Objects.MemoryTexture
    ( 

-- * Exported types
    MemoryTexture(..)                       ,
    IsMemoryTexture                         ,
    toMemoryTexture                         ,
    noMemoryTexture                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMemoryTextureMethod              ,
#endif


-- ** new #method:new#

    memoryTextureNew                        ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture

-- | Memory-managed wrapper type.
newtype MemoryTexture = MemoryTexture (ManagedPtr MemoryTexture)
    deriving (MemoryTexture -> MemoryTexture -> Bool
(MemoryTexture -> MemoryTexture -> Bool)
-> (MemoryTexture -> MemoryTexture -> Bool) -> Eq MemoryTexture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryTexture -> MemoryTexture -> Bool
$c/= :: MemoryTexture -> MemoryTexture -> Bool
== :: MemoryTexture -> MemoryTexture -> Bool
$c== :: MemoryTexture -> MemoryTexture -> Bool
Eq)
foreign import ccall "gdk_memory_texture_get_type"
    c_gdk_memory_texture_get_type :: IO GType

instance GObject MemoryTexture where
    gobjectType :: IO GType
gobjectType = IO GType
c_gdk_memory_texture_get_type
    

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

-- | Type class for types which can be safely cast to `MemoryTexture`, for instance with `toMemoryTexture`.
class (GObject o, O.IsDescendantOf MemoryTexture o) => IsMemoryTexture o
instance (GObject o, O.IsDescendantOf MemoryTexture o) => IsMemoryTexture o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `MemoryTexture`.
noMemoryTexture :: Maybe MemoryTexture
noMemoryTexture :: Maybe MemoryTexture
noMemoryTexture = Maybe MemoryTexture
forall a. Maybe a
Nothing

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

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MemoryTexture
type instance O.AttributeList MemoryTexture = MemoryTextureAttributeList
type MemoryTextureAttributeList = ('[ '("height", Gdk.Texture.TextureHeightPropertyInfo), '("width", Gdk.Texture.TextureWidthPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method MemoryTexture::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the texture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the texture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "MemoryFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GBytes containing the pixel data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rowstride for the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "MemoryTexture" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_memory_texture_new" gdk_memory_texture_new :: 
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    CUInt ->                                -- format : TInterface (Name {namespace = "Gdk", name = "MemoryFormat"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Word64 ->                               -- stride : TBasicType TUInt64
    IO (Ptr MemoryTexture)

-- | Creates a new texture for a blob of image data.
-- The t'GI.GLib.Structs.Bytes.Bytes' must contain /@stride@/ x /@height@/ pixels
-- in the given format.
memoryTextureNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@width@/: the width of the texture
    -> Int32
    -- ^ /@height@/: the height of the texture
    -> Gdk.Enums.MemoryFormat
    -- ^ /@format@/: the format of the data
    -> GLib.Bytes.Bytes
    -- ^ /@bytes@/: the t'GI.GLib.Structs.Bytes.Bytes' containing the pixel data
    -> Word64
    -- ^ /@stride@/: rowstride for the data
    -> m MemoryTexture
    -- ^ __Returns:__ A newly-created t'GI.Gdk.Objects.Texture.Texture'
memoryTextureNew :: Int32
-> Int32 -> MemoryFormat -> Bytes -> Word64 -> m MemoryTexture
memoryTextureNew width :: Int32
width height :: Int32
height format :: MemoryFormat
format bytes :: Bytes
bytes stride :: Word64
stride = IO MemoryTexture -> m MemoryTexture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryTexture -> m MemoryTexture)
-> IO MemoryTexture -> m MemoryTexture
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (MemoryFormat -> Int) -> MemoryFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoryFormat -> Int
forall a. Enum a => a -> Int
fromEnum) MemoryFormat
format
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr MemoryTexture
result <- Int32
-> Int32 -> CUInt -> Ptr Bytes -> Word64 -> IO (Ptr MemoryTexture)
gdk_memory_texture_new Int32
width Int32
height CUInt
format' Ptr Bytes
bytes' Word64
stride
    Text -> Ptr MemoryTexture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "memoryTextureNew" Ptr MemoryTexture
result
    MemoryTexture
result' <- ((ManagedPtr MemoryTexture -> MemoryTexture)
-> Ptr MemoryTexture -> IO MemoryTexture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr MemoryTexture -> MemoryTexture
MemoryTexture) Ptr MemoryTexture
result
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
    MemoryTexture -> IO MemoryTexture
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryTexture
result'

#if defined(ENABLE_OVERLOADING)
#endif