{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A render node for a @GdkTexture@.
-- 
-- /Since: 4.10/

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

module GI.Gsk.Objects.TextureScaleNode
    ( 

-- * Exported types
    TextureScaleNode(..)                    ,
    IsTextureScaleNode                      ,
    toTextureScaleNode                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [draw]("GI.Gsk.Objects.RenderNode#g:method:draw"), [ref]("GI.Gsk.Objects.RenderNode#g:method:ref"), [serialize]("GI.Gsk.Objects.RenderNode#g:method:serialize"), [unref]("GI.Gsk.Objects.RenderNode#g:method:unref"), [writeToFile]("GI.Gsk.Objects.RenderNode#g:method:writeToFile").
-- 
-- ==== Getters
-- [getBounds]("GI.Gsk.Objects.RenderNode#g:method:getBounds"), [getFilter]("GI.Gsk.Objects.TextureScaleNode#g:method:getFilter"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType"), [getTexture]("GI.Gsk.Objects.TextureScaleNode#g:method:getTexture").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTextureScaleNodeMethod           ,
#endif

-- ** getFilter #method:getFilter#

#if defined(ENABLE_OVERLOADING)
    TextureScaleNodeGetFilterMethodInfo     ,
#endif
    textureScaleNodeGetFilter               ,


-- ** getTexture #method:getTexture#

#if defined(ENABLE_OVERLOADING)
    TextureScaleNodeGetTextureMethodInfo    ,
#endif
    textureScaleNodeGetTexture              ,


-- ** new #method:new#

    textureScaleNodeNew                     ,




    ) 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 GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums
import {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode

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

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

foreign import ccall "gsk_texture_scale_node_get_type"
    c_gsk_texture_scale_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject TextureScaleNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_texture_scale_node_get_type

-- | Type class for types which can be safely cast to `TextureScaleNode`, for instance with `toTextureScaleNode`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf TextureScaleNode o) => IsTextureScaleNode o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf TextureScaleNode o) => IsTextureScaleNode o

instance O.HasParentTypes TextureScaleNode
type instance O.ParentTypes TextureScaleNode = '[Gsk.RenderNode.RenderNode]

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveTextureScaleNodeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextureScaleNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveTextureScaleNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveTextureScaleNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveTextureScaleNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveTextureScaleNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveTextureScaleNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveTextureScaleNodeMethod "getFilter" o = TextureScaleNodeGetFilterMethodInfo
    ResolveTextureScaleNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveTextureScaleNodeMethod "getTexture" o = TextureScaleNodeGetTextureMethodInfo
    ResolveTextureScaleNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr TextureScaleNode where
    boxedPtrCopy :: TextureScaleNode -> IO TextureScaleNode
boxedPtrCopy = TextureScaleNode -> IO TextureScaleNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: TextureScaleNode -> IO ()
boxedPtrFree = \TextureScaleNode
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method TextureScaleNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the texture to scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bounds"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size of the texture to scale to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "ScalingFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "how to scale the texture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gsk" , name = "TextureScaleNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_texture_scale_node_new" gsk_texture_scale_node_new :: 
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    Ptr Graphene.Rect.Rect ->               -- bounds : TInterface (Name {namespace = "Graphene", name = "Rect"})
    CUInt ->                                -- filter : TInterface (Name {namespace = "Gsk", name = "ScalingFilter"})
    IO (Ptr TextureScaleNode)

-- | Creates a node that scales the texture to the size given by the
-- bounds using the filter and then places it at the bounds\' position.
-- 
-- Note that further scaling and other transformations which are
-- applied to the node will apply linear filtering to the resulting
-- texture, as usual.
-- 
-- This node is intended for tight control over scaling applied
-- to a texture, such as in image editors and requires the
-- application to be aware of the whole render tree as further
-- transforms may be applied that conflict with the desired effect
-- of this node.
-- 
-- /Since: 4.10/
textureScaleNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Texture.IsTexture a) =>
    a
    -- ^ /@texture@/: the texture to scale
    -> Graphene.Rect.Rect
    -- ^ /@bounds@/: the size of the texture to scale to
    -> Gsk.Enums.ScalingFilter
    -- ^ /@filter@/: how to scale the texture
    -> m TextureScaleNode
    -- ^ __Returns:__ A new @GskRenderNode@
textureScaleNodeNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> Rect -> ScalingFilter -> m TextureScaleNode
textureScaleNodeNew a
texture Rect
bounds ScalingFilter
filter = IO TextureScaleNode -> m TextureScaleNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextureScaleNode -> m TextureScaleNode)
-> IO TextureScaleNode -> m TextureScaleNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Ptr Rect
bounds' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
bounds
    let filter' :: CUInt
filter' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ScalingFilter -> Int) -> ScalingFilter -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalingFilter -> Int
forall a. Enum a => a -> Int
fromEnum) ScalingFilter
filter
    Ptr TextureScaleNode
result <- Ptr Texture -> Ptr Rect -> CUInt -> IO (Ptr TextureScaleNode)
gsk_texture_scale_node_new Ptr Texture
texture' Ptr Rect
bounds' CUInt
filter'
    Text -> Ptr TextureScaleNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textureScaleNodeNew" Ptr TextureScaleNode
result
    TextureScaleNode
result' <- ((ManagedPtr TextureScaleNode -> TextureScaleNode)
-> Ptr TextureScaleNode -> IO TextureScaleNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TextureScaleNode -> TextureScaleNode
TextureScaleNode) Ptr TextureScaleNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
bounds
    TextureScaleNode -> IO TextureScaleNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextureScaleNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TextureScaleNode::get_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextureScaleNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a `GskRenderNode` of type %GSK_TEXTURE_SCALE_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gsk" , name = "ScalingFilter" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_texture_scale_node_get_filter" gsk_texture_scale_node_get_filter :: 
    Ptr TextureScaleNode ->                 -- node : TInterface (Name {namespace = "Gsk", name = "TextureScaleNode"})
    IO CUInt

-- | Retrieves the @GskScalingFilter@ used when creating this @GskRenderNode@.
-- 
-- /Since: 4.10/
textureScaleNodeGetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextureScaleNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ of type 'GI.Gsk.Enums.RenderNodeTypeTextureScaleNode'
    -> m Gsk.Enums.ScalingFilter
    -- ^ __Returns:__ the @GskScalingFilter@
textureScaleNodeGetFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextureScaleNode a) =>
a -> m ScalingFilter
textureScaleNodeGetFilter a
node = IO ScalingFilter -> m ScalingFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScalingFilter -> m ScalingFilter)
-> IO ScalingFilter -> m ScalingFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextureScaleNode
node' <- a -> IO (Ptr TextureScaleNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CUInt
result <- Ptr TextureScaleNode -> IO CUInt
gsk_texture_scale_node_get_filter Ptr TextureScaleNode
node'
    let result' :: ScalingFilter
result' = (Int -> ScalingFilter
forall a. Enum a => Int -> a
toEnum (Int -> ScalingFilter) -> (CUInt -> Int) -> CUInt -> ScalingFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    ScalingFilter -> IO ScalingFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalingFilter
result'

#if defined(ENABLE_OVERLOADING)
data TextureScaleNodeGetFilterMethodInfo
instance (signature ~ (m Gsk.Enums.ScalingFilter), MonadIO m, IsTextureScaleNode a) => O.OverloadedMethod TextureScaleNodeGetFilterMethodInfo a signature where
    overloadedMethod = textureScaleNodeGetFilter

instance O.OverloadedMethodInfo TextureScaleNodeGetFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextureScaleNode.textureScaleNodeGetFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.7/docs/GI-Gsk-Objects-TextureScaleNode.html#v:textureScaleNodeGetFilter"
        })


#endif

-- method TextureScaleNode::get_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "TextureScaleNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a `GskRenderNode` of type %GSK_TEXTURE_SCALE_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_texture_scale_node_get_texture" gsk_texture_scale_node_get_texture :: 
    Ptr TextureScaleNode ->                 -- node : TInterface (Name {namespace = "Gsk", name = "TextureScaleNode"})
    IO (Ptr Gdk.Texture.Texture)

-- | Retrieves the @GdkTexture@ used when creating this @GskRenderNode@.
-- 
-- /Since: 4.10/
textureScaleNodeGetTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsTextureScaleNode a) =>
    a
    -- ^ /@node@/: a @GskRenderNode@ of type 'GI.Gsk.Enums.RenderNodeTypeTextureScaleNode'
    -> m Gdk.Texture.Texture
    -- ^ __Returns:__ the @GdkTexture@
textureScaleNodeGetTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextureScaleNode a) =>
a -> m Texture
textureScaleNodeGetTexture a
node = IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextureScaleNode
node' <- a -> IO (Ptr TextureScaleNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr Texture
result <- Ptr TextureScaleNode -> IO (Ptr Texture)
gsk_texture_scale_node_get_texture Ptr TextureScaleNode
node'
    Text -> Ptr Texture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textureScaleNodeGetTexture" Ptr Texture
result
    Texture
result' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Texture -> Texture
Gdk.Texture.Texture) Ptr Texture
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Texture -> IO Texture
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result'

#if defined(ENABLE_OVERLOADING)
data TextureScaleNodeGetTextureMethodInfo
instance (signature ~ (m Gdk.Texture.Texture), MonadIO m, IsTextureScaleNode a) => O.OverloadedMethod TextureScaleNodeGetTextureMethodInfo a signature where
    overloadedMethod = textureScaleNodeGetTexture

instance O.OverloadedMethodInfo TextureScaleNodeGetTextureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.TextureScaleNode.textureScaleNodeGetTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.7/docs/GI-Gsk-Objects-TextureScaleNode.html#v:textureScaleNodeGetTexture"
        })


#endif