{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Structs.PaintVolume.PaintVolume' is an opaque structure
-- whose members cannot be directly accessed.
-- 
-- A t'GI.Clutter.Structs.PaintVolume.PaintVolume' represents an
-- a bounding volume whose internal representation isn\'t defined but
-- can be set and queried in terms of an axis aligned bounding box.
-- 
-- A t'GI.Clutter.Structs.PaintVolume.PaintVolume' for a t'GI.Clutter.Objects.Actor.Actor'
-- is defined to be relative from the current actor modelview matrix.
-- 
-- Other internal representation and methods for describing the
-- bounding volume may be added in the future.
-- 
-- /Since: 1.4/

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

module GI.Clutter.Structs.PaintVolume
    ( 

-- * Exported types
    PaintVolume(..)                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Clutter.Structs.PaintVolume#g:method:copy"), [free]("GI.Clutter.Structs.PaintVolume#g:method:free"), [union]("GI.Clutter.Structs.PaintVolume#g:method:union"), [unionBox]("GI.Clutter.Structs.PaintVolume#g:method:unionBox").
-- 
-- ==== Getters
-- [getDepth]("GI.Clutter.Structs.PaintVolume#g:method:getDepth"), [getHeight]("GI.Clutter.Structs.PaintVolume#g:method:getHeight"), [getOrigin]("GI.Clutter.Structs.PaintVolume#g:method:getOrigin"), [getWidth]("GI.Clutter.Structs.PaintVolume#g:method:getWidth").
-- 
-- ==== Setters
-- [setDepth]("GI.Clutter.Structs.PaintVolume#g:method:setDepth"), [setFromAllocation]("GI.Clutter.Structs.PaintVolume#g:method:setFromAllocation"), [setHeight]("GI.Clutter.Structs.PaintVolume#g:method:setHeight"), [setOrigin]("GI.Clutter.Structs.PaintVolume#g:method:setOrigin"), [setWidth]("GI.Clutter.Structs.PaintVolume#g:method:setWidth").

#if defined(ENABLE_OVERLOADING)
    ResolvePaintVolumeMethod                ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeCopyMethodInfo               ,
#endif
    paintVolumeCopy                         ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeFreeMethodInfo               ,
#endif
    paintVolumeFree                         ,


-- ** getDepth #method:getDepth#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeGetDepthMethodInfo           ,
#endif
    paintVolumeGetDepth                     ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeGetHeightMethodInfo          ,
#endif
    paintVolumeGetHeight                    ,


-- ** getOrigin #method:getOrigin#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeGetOriginMethodInfo          ,
#endif
    paintVolumeGetOrigin                    ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeGetWidthMethodInfo           ,
#endif
    paintVolumeGetWidth                     ,


-- ** setDepth #method:setDepth#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeSetDepthMethodInfo           ,
#endif
    paintVolumeSetDepth                     ,


-- ** setFromAllocation #method:setFromAllocation#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeSetFromAllocationMethodInfo  ,
#endif
    paintVolumeSetFromAllocation            ,


-- ** setHeight #method:setHeight#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeSetHeightMethodInfo          ,
#endif
    paintVolumeSetHeight                    ,


-- ** setOrigin #method:setOrigin#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeSetOriginMethodInfo          ,
#endif
    paintVolumeSetOrigin                    ,


-- ** setWidth #method:setWidth#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeSetWidthMethodInfo           ,
#endif
    paintVolumeSetWidth                     ,


-- ** union #method:union#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeUnionMethodInfo              ,
#endif
    paintVolumeUnion                        ,


-- ** unionBox #method:unionBox#

#if defined(ENABLE_OVERLOADING)
    PaintVolumeUnionBoxMethodInfo           ,
#endif
    paintVolumeUnionBox                     ,




    ) 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 {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Structs.ActorBox as Clutter.ActorBox
import {-# SOURCE #-} qualified GI.Clutter.Structs.Vertex as Clutter.Vertex

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

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

foreign import ccall "clutter_paint_volume_get_type" c_clutter_paint_volume_get_type :: 
    IO GType

type instance O.ParentTypes PaintVolume = '[]
instance O.HasParentTypes PaintVolume

instance B.Types.TypedObject PaintVolume where
    glibType :: IO GType
glibType = IO GType
c_clutter_paint_volume_get_type

instance B.Types.GBoxed PaintVolume

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


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

-- method PaintVolume::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "PaintVolume" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_copy" clutter_paint_volume_copy :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO (Ptr PaintVolume)

-- | Copies /@pv@/ into a new t'GI.Clutter.Structs.PaintVolume.PaintVolume'
-- 
-- /Since: 1.6/
paintVolumeCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m PaintVolume
    -- ^ __Returns:__ a newly allocated copy of a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
paintVolumeCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m PaintVolume
paintVolumeCopy PaintVolume
pv = IO PaintVolume -> m PaintVolume
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PaintVolume -> m PaintVolume)
-> IO PaintVolume -> m PaintVolume
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr PaintVolume
result <- Ptr PaintVolume -> IO (Ptr PaintVolume)
clutter_paint_volume_copy Ptr PaintVolume
pv'
    Text -> Ptr PaintVolume -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"paintVolumeCopy" Ptr PaintVolume
result
    PaintVolume
result' <- ((ManagedPtr PaintVolume -> PaintVolume)
-> Ptr PaintVolume -> IO PaintVolume
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PaintVolume -> PaintVolume
PaintVolume) Ptr PaintVolume
result
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    PaintVolume -> IO PaintVolume
forall (m :: * -> *) a. Monad m => a -> m a
return PaintVolume
result'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeCopyMethodInfo
instance (signature ~ (m PaintVolume), MonadIO m) => O.OverloadedMethod PaintVolumeCopyMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeCopy

instance O.OverloadedMethodInfo PaintVolumeCopyMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeCopy"
        })


#endif

-- method PaintVolume::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_free" clutter_paint_volume_free :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO ()

-- | Frees the resources allocated by /@pv@/
-- 
-- /Since: 1.6/
paintVolumeFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m ()
paintVolumeFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m ()
paintVolumeFree PaintVolume
pv = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr PaintVolume -> IO ()
clutter_paint_volume_free Ptr PaintVolume
pv'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PaintVolumeFreeMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeFree

instance O.OverloadedMethodInfo PaintVolumeFreeMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeFree"
        })


#endif

-- method PaintVolume::get_depth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_get_depth" clutter_paint_volume_get_depth :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO CFloat

-- | Retrieves the depth of the volume\'s, axis aligned, bounding box.
-- 
-- In other words; this takes into account what actor\'s coordinate
-- space /@pv@/ belongs too and conceptually fits an axis aligned box
-- around the volume. It returns the size of that bounding box as
-- measured along the z-axis.
-- 
-- If, for example, 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume'
-- is used to transform a 2D child actor that is 100px wide, 100px
-- high and 0px deep into container coordinates then the depth might
-- not simply be 0px if the child actor has a 3D rotation applied to
-- it.
-- 
-- Remember: if 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume' is
-- used then the transformed volume will be defined relative to the
-- container actor and in container coordinates a 2D child actor
-- can have a 3D bounding volume.
-- 
-- There are no accuracy guarantees for the reported depth,
-- except that it must always be greater than, or equal to, the actor\'s
-- depth. This is because actors may report simple, loose fitting paint
-- volumes for efficiency.
-- 
-- /Since: 1.6/
paintVolumeGetDepth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m Float
    -- ^ __Returns:__ the depth, in units of /@pv@/\'s local coordinate system.
paintVolumeGetDepth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m Float
paintVolumeGetDepth PaintVolume
pv = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    CFloat
result <- Ptr PaintVolume -> IO CFloat
clutter_paint_volume_get_depth Ptr PaintVolume
pv'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeGetDepthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod PaintVolumeGetDepthMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeGetDepth

instance O.OverloadedMethodInfo PaintVolumeGetDepthMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeGetDepth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeGetDepth"
        })


#endif

-- method PaintVolume::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_get_height" clutter_paint_volume_get_height :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO CFloat

-- | Retrieves the height of the volume\'s, axis aligned, bounding box.
-- 
-- In other words; this takes into account what actor\'s coordinate
-- space /@pv@/ belongs too and conceptually fits an axis aligned box
-- around the volume. It returns the size of that bounding box as
-- measured along the y-axis.
-- 
-- If, for example, 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume'
-- is used to transform a 2D child actor that is 100px wide, 100px
-- high and 0px deep into container coordinates then the height might
-- not simply be 100px if the child actor has a 3D rotation applied to
-- it.
-- 
-- Remember: if 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume' is
-- used then a transformed child volume will be defined relative to the
-- ancestor container actor and so a 2D child actor
-- can have a 3D bounding volume.
-- 
-- There are no accuracy guarantees for the reported height,
-- except that it must always be greater than, or equal to, the actor\'s
-- height. This is because actors may report simple, loose fitting paint
-- volumes for efficiency.
-- 
-- /Since: 1.6/
paintVolumeGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m Float
    -- ^ __Returns:__ the height, in units of /@pv@/\'s local coordinate system.
paintVolumeGetHeight :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m Float
paintVolumeGetHeight PaintVolume
pv = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    CFloat
result <- Ptr PaintVolume -> IO CFloat
clutter_paint_volume_get_height Ptr PaintVolume
pv'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeGetHeightMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod PaintVolumeGetHeightMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeGetHeight

instance O.OverloadedMethodInfo PaintVolumeGetHeightMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeGetHeight"
        })


#endif

-- method PaintVolume::get_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vertex"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Vertex" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the return location for a #ClutterVertex"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_get_origin" clutter_paint_volume_get_origin :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    Ptr Clutter.Vertex.Vertex ->            -- vertex : TInterface (Name {namespace = "Clutter", name = "Vertex"})
    IO ()

-- | Retrieves the origin of the t'GI.Clutter.Structs.PaintVolume.PaintVolume'.
-- 
-- /Since: 1.6/
paintVolumeGetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m (Clutter.Vertex.Vertex)
paintVolumeGetOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m Vertex
paintVolumeGetOrigin PaintVolume
pv = IO Vertex -> m Vertex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vertex -> m Vertex) -> IO Vertex -> m Vertex
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr Vertex
vertex <- Int -> IO (Ptr Vertex)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Clutter.Vertex.Vertex)
    Ptr PaintVolume -> Ptr Vertex -> IO ()
clutter_paint_volume_get_origin Ptr PaintVolume
pv' Ptr Vertex
vertex
    Vertex
vertex' <- ((ManagedPtr Vertex -> Vertex) -> Ptr Vertex -> IO Vertex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vertex -> Vertex
Clutter.Vertex.Vertex) Ptr Vertex
vertex
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    Vertex -> IO Vertex
forall (m :: * -> *) a. Monad m => a -> m a
return Vertex
vertex'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeGetOriginMethodInfo
instance (signature ~ (m (Clutter.Vertex.Vertex)), MonadIO m) => O.OverloadedMethod PaintVolumeGetOriginMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeGetOrigin

instance O.OverloadedMethodInfo PaintVolumeGetOriginMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeGetOrigin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeGetOrigin"
        })


#endif

-- method PaintVolume::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_get_width" clutter_paint_volume_get_width :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO CFloat

-- | Retrieves the width of the volume\'s, axis aligned, bounding box.
-- 
-- In other words; this takes into account what actor\'s coordinate
-- space /@pv@/ belongs too and conceptually fits an axis aligned box
-- around the volume. It returns the size of that bounding box as
-- measured along the x-axis.
-- 
-- If, for example, 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume'
-- is used to transform a 2D child actor that is 100px wide, 100px
-- high and 0px deep into container coordinates then the width might
-- not simply be 100px if the child actor has a 3D rotation applied to
-- it.
-- 
-- Remember: if 'GI.Clutter.Objects.Actor.actorGetTransformedPaintVolume' is
-- used then a transformed child volume will be defined relative to the
-- ancestor container actor and so a 2D child actor can have a 3D
-- bounding volume.
-- 
-- There are no accuracy guarantees for the reported width,
-- except that it must always be greater than, or equal to, the
-- actor\'s width. This is because actors may report simple, loose
-- fitting paint volumes for efficiency.
-- 
-- /Since: 1.6/
paintVolumeGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> m Float
    -- ^ __Returns:__ the width, in units of /@pv@/\'s local coordinate system.
paintVolumeGetWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> m Float
paintVolumeGetWidth PaintVolume
pv = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    CFloat
result <- Ptr PaintVolume -> IO CFloat
clutter_paint_volume_get_width Ptr PaintVolume
pv'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeGetWidthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod PaintVolumeGetWidthMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeGetWidth

instance O.OverloadedMethodInfo PaintVolumeGetWidthMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeGetWidth"
        })


#endif

-- method PaintVolume::set_depth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the depth of the paint volume, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_set_depth" clutter_paint_volume_set_depth :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    CFloat ->                               -- depth : TBasicType TFloat
    IO ()

-- | Sets the depth of the paint volume. The depth is measured along
-- the z axis in the actor coordinates that /@pv@/ is associated with.
-- 
-- /Since: 1.6/
paintVolumeSetDepth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> Float
    -- ^ /@depth@/: the depth of the paint volume, in pixels
    -> m ()
paintVolumeSetDepth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> Float -> m ()
paintVolumeSetDepth PaintVolume
pv Float
depth = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    let depth' :: CFloat
depth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
depth
    Ptr PaintVolume -> CFloat -> IO ()
clutter_paint_volume_set_depth Ptr PaintVolume
pv' CFloat
depth'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeSetDepthMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeSetDepthMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeSetDepth

instance O.OverloadedMethodInfo PaintVolumeSetDepthMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeSetDepth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeSetDepth"
        })


#endif

-- method PaintVolume::set_from_allocation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_set_from_allocation" clutter_paint_volume_set_from_allocation :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO CInt

-- | Sets the t'GI.Clutter.Structs.PaintVolume.PaintVolume' from the allocation of /@actor@/.
-- 
-- This function should be used when overriding the
-- t'GI.Clutter.Structs.ActorClass.ActorClass'.@/get_paint_volume/@() by t'GI.Clutter.Objects.Actor.Actor' sub-classes
-- that do not paint outside their allocation.
-- 
-- A typical example is:
-- 
-- >
-- >static gboolean
-- >my_actor_get_paint_volume (ClutterActor       *self,
-- >                           ClutterPaintVolume *volume)
-- >{
-- >  return clutter_paint_volume_set_from_allocation (volume, self);
-- >}
-- 
-- 
-- /Since: 1.6/
paintVolumeSetFromAllocation ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> a
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the paint volume was successfully set, and 'P.False'
    --   otherwise
paintVolumeSetFromAllocation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
PaintVolume -> a -> m Bool
paintVolumeSetFromAllocation PaintVolume
pv a
actor = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr Actor
actor' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
actor
    CInt
result <- Ptr PaintVolume -> Ptr Actor -> IO CInt
clutter_paint_volume_set_from_allocation Ptr PaintVolume
pv' Ptr Actor
actor'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
actor
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PaintVolumeSetFromAllocationMethodInfo
instance (signature ~ (a -> m Bool), MonadIO m, Clutter.Actor.IsActor a) => O.OverloadedMethod PaintVolumeSetFromAllocationMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeSetFromAllocation

instance O.OverloadedMethodInfo PaintVolumeSetFromAllocationMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeSetFromAllocation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeSetFromAllocation"
        })


#endif

-- method PaintVolume::set_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the paint volume, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_set_height" clutter_paint_volume_set_height :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    CFloat ->                               -- height : TBasicType TFloat
    IO ()

-- | Sets the height of the paint volume. The height is measured along
-- the y axis in the actor coordinates that /@pv@/ is associated with.
-- 
-- /Since: 1.6/
paintVolumeSetHeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> Float
    -- ^ /@height@/: the height of the paint volume, in pixels
    -> m ()
paintVolumeSetHeight :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> Float -> m ()
paintVolumeSetHeight PaintVolume
pv Float
height = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    let height' :: CFloat
height' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height
    Ptr PaintVolume -> CFloat -> IO ()
clutter_paint_volume_set_height Ptr PaintVolume
pv' CFloat
height'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeSetHeightMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeSetHeightMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeSetHeight

instance O.OverloadedMethodInfo PaintVolumeSetHeightMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeSetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeSetHeight"
        })


#endif

-- method PaintVolume::set_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Vertex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterVertex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_set_origin" clutter_paint_volume_set_origin :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    Ptr Clutter.Vertex.Vertex ->            -- origin : TInterface (Name {namespace = "Clutter", name = "Vertex"})
    IO ()

-- | Sets the origin of the paint volume.
-- 
-- The origin is defined as the X, Y and Z coordinates of the top-left
-- corner of an actor\'s paint volume, in actor coordinates.
-- 
-- The default is origin is assumed at: (0, 0, 0)
-- 
-- /Since: 1.6/
paintVolumeSetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> Clutter.Vertex.Vertex
    -- ^ /@origin@/: a t'GI.Clutter.Structs.Vertex.Vertex'
    -> m ()
paintVolumeSetOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> Vertex -> m ()
paintVolumeSetOrigin PaintVolume
pv Vertex
origin = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr Vertex
origin' <- Vertex -> IO (Ptr Vertex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vertex
origin
    Ptr PaintVolume -> Ptr Vertex -> IO ()
clutter_paint_volume_set_origin Ptr PaintVolume
pv' Ptr Vertex
origin'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    Vertex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vertex
origin
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeSetOriginMethodInfo
instance (signature ~ (Clutter.Vertex.Vertex -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeSetOriginMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeSetOrigin

instance O.OverloadedMethodInfo PaintVolumeSetOriginMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeSetOrigin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeSetOrigin"
        })


#endif

-- method PaintVolume::set_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the paint volume, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_set_width" clutter_paint_volume_set_width :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    CFloat ->                               -- width : TBasicType TFloat
    IO ()

-- | Sets the width of the paint volume. The width is measured along
-- the x axis in the actor coordinates that /@pv@/ is associated with.
-- 
-- /Since: 1.6/
paintVolumeSetWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> Float
    -- ^ /@width@/: the width of the paint volume, in pixels
    -> m ()
paintVolumeSetWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> Float -> m ()
paintVolumeSetWidth PaintVolume
pv Float
width = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    let width' :: CFloat
width' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width
    Ptr PaintVolume -> CFloat -> IO ()
clutter_paint_volume_set_width Ptr PaintVolume
pv' CFloat
width'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeSetWidthMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeSetWidthMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeSetWidth

instance O.OverloadedMethodInfo PaintVolumeSetWidthMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeSetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeSetWidth"
        })


#endif

-- method PaintVolume::union
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The first #ClutterPaintVolume and destination for resulting\n     union"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "another_pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A second #ClutterPaintVolume to union with @pv"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_union" clutter_paint_volume_union :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    Ptr PaintVolume ->                      -- another_pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    IO ()

-- | Updates the geometry of /@pv@/ to encompass /@pv@/ and /@anotherPv@/.
-- 
-- There are no guarantees about how precisely the two volumes
-- will be unioned.
-- 
-- /Since: 1.6/
paintVolumeUnion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: The first t'GI.Clutter.Structs.PaintVolume.PaintVolume' and destination for resulting
    --      union
    -> PaintVolume
    -- ^ /@anotherPv@/: A second t'GI.Clutter.Structs.PaintVolume.PaintVolume' to union with /@pv@/
    -> m ()
paintVolumeUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> PaintVolume -> m ()
paintVolumeUnion PaintVolume
pv PaintVolume
anotherPv = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr PaintVolume
anotherPv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
anotherPv
    Ptr PaintVolume -> Ptr PaintVolume -> IO ()
clutter_paint_volume_union Ptr PaintVolume
pv' Ptr PaintVolume
anotherPv'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
anotherPv
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeUnionMethodInfo
instance (signature ~ (PaintVolume -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeUnionMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeUnion

instance O.OverloadedMethodInfo PaintVolumeUnionMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeUnion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeUnion"
        })


#endif

-- method PaintVolume::union_box
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pv"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintVolume"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox to union to @pv"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_paint_volume_union_box" clutter_paint_volume_union_box :: 
    Ptr PaintVolume ->                      -- pv : TInterface (Name {namespace = "Clutter", name = "PaintVolume"})
    Ptr Clutter.ActorBox.ActorBox ->        -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO ()

-- | Unions the 2D region represented by /@box@/ to a t'GI.Clutter.Structs.PaintVolume.PaintVolume'.
-- 
-- This function is similar to 'GI.Clutter.Structs.PaintVolume.paintVolumeUnion', but it is
-- specific for 2D regions.
-- 
-- /Since: 1.10/
paintVolumeUnionBox ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PaintVolume
    -- ^ /@pv@/: a t'GI.Clutter.Structs.PaintVolume.PaintVolume'
    -> Clutter.ActorBox.ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox' to union to /@pv@/
    -> m ()
paintVolumeUnionBox :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PaintVolume -> ActorBox -> m ()
paintVolumeUnionBox PaintVolume
pv ActorBox
box = 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 PaintVolume
pv' <- PaintVolume -> IO (Ptr PaintVolume)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaintVolume
pv
    Ptr ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    Ptr PaintVolume -> Ptr ActorBox -> IO ()
clutter_paint_volume_union_box Ptr PaintVolume
pv' Ptr ActorBox
box'
    PaintVolume -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaintVolume
pv
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PaintVolumeUnionBoxMethodInfo
instance (signature ~ (Clutter.ActorBox.ActorBox -> m ()), MonadIO m) => O.OverloadedMethod PaintVolumeUnionBoxMethodInfo PaintVolume signature where
    overloadedMethod = paintVolumeUnionBox

instance O.OverloadedMethodInfo PaintVolumeUnionBoxMethodInfo PaintVolume where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.PaintVolume.paintVolumeUnionBox",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-PaintVolume.html#v:paintVolumeUnionBox"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePaintVolumeMethod (t :: Symbol) (o :: *) :: * where
    ResolvePaintVolumeMethod "copy" o = PaintVolumeCopyMethodInfo
    ResolvePaintVolumeMethod "free" o = PaintVolumeFreeMethodInfo
    ResolvePaintVolumeMethod "union" o = PaintVolumeUnionMethodInfo
    ResolvePaintVolumeMethod "unionBox" o = PaintVolumeUnionBoxMethodInfo
    ResolvePaintVolumeMethod "getDepth" o = PaintVolumeGetDepthMethodInfo
    ResolvePaintVolumeMethod "getHeight" o = PaintVolumeGetHeightMethodInfo
    ResolvePaintVolumeMethod "getOrigin" o = PaintVolumeGetOriginMethodInfo
    ResolvePaintVolumeMethod "getWidth" o = PaintVolumeGetWidthMethodInfo
    ResolvePaintVolumeMethod "setDepth" o = PaintVolumeSetDepthMethodInfo
    ResolvePaintVolumeMethod "setFromAllocation" o = PaintVolumeSetFromAllocationMethodInfo
    ResolvePaintVolumeMethod "setHeight" o = PaintVolumeSetHeightMethodInfo
    ResolvePaintVolumeMethod "setOrigin" o = PaintVolumeSetOriginMethodInfo
    ResolvePaintVolumeMethod "setWidth" o = PaintVolumeSetWidthMethodInfo
    ResolvePaintVolumeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif