{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Bounding box of an actor. The coordinates of the top left and right bottom
-- corners of an actor. The coordinates of the two points are expressed in
-- pixels with sub-pixel precision

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

module GI.Clutter.Structs.ActorBox
    ( 

-- * Exported types
    ActorBox(..)                            ,
    newZeroActorBox                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [clampToPixel]("GI.Clutter.Structs.ActorBox#g:method:clampToPixel"), [contains]("GI.Clutter.Structs.ActorBox#g:method:contains"), [copy]("GI.Clutter.Structs.ActorBox#g:method:copy"), [equal]("GI.Clutter.Structs.ActorBox#g:method:equal"), [free]("GI.Clutter.Structs.ActorBox#g:method:free"), [fromVertices]("GI.Clutter.Structs.ActorBox#g:method:fromVertices"), [init]("GI.Clutter.Structs.ActorBox#g:method:init"), [initRect]("GI.Clutter.Structs.ActorBox#g:method:initRect"), [interpolate]("GI.Clutter.Structs.ActorBox#g:method:interpolate"), [union]("GI.Clutter.Structs.ActorBox#g:method:union").
-- 
-- ==== Getters
-- [getArea]("GI.Clutter.Structs.ActorBox#g:method:getArea"), [getHeight]("GI.Clutter.Structs.ActorBox#g:method:getHeight"), [getOrigin]("GI.Clutter.Structs.ActorBox#g:method:getOrigin"), [getSize]("GI.Clutter.Structs.ActorBox#g:method:getSize"), [getWidth]("GI.Clutter.Structs.ActorBox#g:method:getWidth"), [getX]("GI.Clutter.Structs.ActorBox#g:method:getX"), [getY]("GI.Clutter.Structs.ActorBox#g:method:getY").
-- 
-- ==== Setters
-- [setOrigin]("GI.Clutter.Structs.ActorBox#g:method:setOrigin"), [setSize]("GI.Clutter.Structs.ActorBox#g:method:setSize").

#if defined(ENABLE_OVERLOADING)
    ResolveActorBoxMethod                   ,
#endif

-- ** alloc #method:alloc#

    actorBoxAlloc                           ,


-- ** clampToPixel #method:clampToPixel#

#if defined(ENABLE_OVERLOADING)
    ActorBoxClampToPixelMethodInfo          ,
#endif
    actorBoxClampToPixel                    ,


-- ** contains #method:contains#

#if defined(ENABLE_OVERLOADING)
    ActorBoxContainsMethodInfo              ,
#endif
    actorBoxContains                        ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ActorBoxCopyMethodInfo                  ,
#endif
    actorBoxCopy                            ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    ActorBoxEqualMethodInfo                 ,
#endif
    actorBoxEqual                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ActorBoxFreeMethodInfo                  ,
#endif
    actorBoxFree                            ,


-- ** fromVertices #method:fromVertices#

#if defined(ENABLE_OVERLOADING)
    ActorBoxFromVerticesMethodInfo          ,
#endif
    actorBoxFromVertices                    ,


-- ** getArea #method:getArea#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetAreaMethodInfo               ,
#endif
    actorBoxGetArea                         ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetHeightMethodInfo             ,
#endif
    actorBoxGetHeight                       ,


-- ** getOrigin #method:getOrigin#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetOriginMethodInfo             ,
#endif
    actorBoxGetOrigin                       ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetSizeMethodInfo               ,
#endif
    actorBoxGetSize                         ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetWidthMethodInfo              ,
#endif
    actorBoxGetWidth                        ,


-- ** getX #method:getX#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetXMethodInfo                  ,
#endif
    actorBoxGetX                            ,


-- ** getY #method:getY#

#if defined(ENABLE_OVERLOADING)
    ActorBoxGetYMethodInfo                  ,
#endif
    actorBoxGetY                            ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    ActorBoxInitMethodInfo                  ,
#endif
    actorBoxInit                            ,


-- ** initRect #method:initRect#

#if defined(ENABLE_OVERLOADING)
    ActorBoxInitRectMethodInfo              ,
#endif
    actorBoxInitRect                        ,


-- ** interpolate #method:interpolate#

#if defined(ENABLE_OVERLOADING)
    ActorBoxInterpolateMethodInfo           ,
#endif
    actorBoxInterpolate                     ,


-- ** new #method:new#

    actorBoxNew                             ,


-- ** setOrigin #method:setOrigin#

#if defined(ENABLE_OVERLOADING)
    ActorBoxSetOriginMethodInfo             ,
#endif
    actorBoxSetOrigin                       ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    ActorBoxSetSizeMethodInfo               ,
#endif
    actorBoxSetSize                         ,


-- ** union #method:union#

#if defined(ENABLE_OVERLOADING)
    ActorBoxUnionMethodInfo                 ,
#endif
    actorBoxUnion                           ,




 -- * Properties


-- ** x1 #attr:x1#
-- | X coordinate of the top left corner

#if defined(ENABLE_OVERLOADING)
    actorBox_x1                             ,
#endif
    getActorBoxX1                           ,
    setActorBoxX1                           ,


-- ** x2 #attr:x2#
-- | X coordinate of the bottom right corner

#if defined(ENABLE_OVERLOADING)
    actorBox_x2                             ,
#endif
    getActorBoxX2                           ,
    setActorBoxX2                           ,


-- ** y1 #attr:y1#
-- | Y coordinate of the top left corner

#if defined(ENABLE_OVERLOADING)
    actorBox_y1                             ,
#endif
    getActorBoxY1                           ,
    setActorBoxY1                           ,


-- ** y2 #attr:y2#
-- | Y coordinate of the bottom right corner

#if defined(ENABLE_OVERLOADING)
    actorBox_y2                             ,
#endif
    getActorBoxY2                           ,
    setActorBoxY2                           ,




    ) 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.Structs.Vertex as Clutter.Vertex

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

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

foreign import ccall "clutter_actor_box_get_type" c_clutter_actor_box_get_type :: 
    IO GType

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

instance B.Types.TypedObject ActorBox where
    glibType :: IO GType
glibType = IO GType
c_clutter_actor_box_get_type

instance B.Types.GBoxed ActorBox

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

-- | Construct a `ActorBox` struct initialized to zero.
newZeroActorBox :: MonadIO m => m ActorBox
newZeroActorBox :: forall (m :: * -> *). MonadIO m => m ActorBox
newZeroActorBox = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr ActorBox)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr ActorBox) -> (Ptr ActorBox -> IO ActorBox) -> IO ActorBox
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox

instance tag ~ 'AttrSet => Constructible ActorBox tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ActorBox -> ActorBox)
-> [AttrOp ActorBox tag] -> m ActorBox
new ManagedPtr ActorBox -> ActorBox
_ [AttrOp ActorBox tag]
attrs = do
        ActorBox
o <- m ActorBox
forall (m :: * -> *). MonadIO m => m ActorBox
newZeroActorBox
        ActorBox -> [AttrOp ActorBox 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActorBox
o [AttrOp ActorBox tag]
[AttrOp ActorBox 'AttrSet]
attrs
        ActorBox -> m ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
o


-- | Get the value of the “@x1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actorBox #x1
-- @
getActorBoxX1 :: MonadIO m => ActorBox -> m Float
getActorBoxX1 :: forall (m :: * -> *). MonadIO m => ActorBox -> m Float
getActorBoxX1 ActorBox
s = 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
$ ActorBox -> (Ptr ActorBox -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO Float) -> IO Float)
-> (Ptr ActorBox -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@x1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actorBox [ #x1 'Data.GI.Base.Attributes.:=' value ]
-- @
setActorBoxX1 :: MonadIO m => ActorBox -> Float -> m ()
setActorBoxX1 :: forall (m :: * -> *). MonadIO m => ActorBox -> Float -> m ()
setActorBoxX1 ActorBox
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorBox -> (Ptr ActorBox -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO ()) -> IO ())
-> (Ptr ActorBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ActorBoxX1FieldInfo
instance AttrInfo ActorBoxX1FieldInfo where
    type AttrBaseTypeConstraint ActorBoxX1FieldInfo = (~) ActorBox
    type AttrAllowedOps ActorBoxX1FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActorBoxX1FieldInfo = (~) Float
    type AttrTransferTypeConstraint ActorBoxX1FieldInfo = (~)Float
    type AttrTransferType ActorBoxX1FieldInfo = Float
    type AttrGetType ActorBoxX1FieldInfo = Float
    type AttrLabel ActorBoxX1FieldInfo = "x1"
    type AttrOrigin ActorBoxX1FieldInfo = ActorBox
    attrGet = getActorBoxX1
    attrSet = setActorBoxX1
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorBox.x1"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-ActorBox.html#g:attr:x1"
        })

actorBox_x1 :: AttrLabelProxy "x1"
actorBox_x1 = AttrLabelProxy

#endif


-- | Get the value of the “@y1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actorBox #y1
-- @
getActorBoxY1 :: MonadIO m => ActorBox -> m Float
getActorBoxY1 :: forall (m :: * -> *). MonadIO m => ActorBox -> m Float
getActorBoxY1 ActorBox
s = 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
$ ActorBox -> (Ptr ActorBox -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO Float) -> IO Float)
-> (Ptr ActorBox -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@y1@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actorBox [ #y1 'Data.GI.Base.Attributes.:=' value ]
-- @
setActorBoxY1 :: MonadIO m => ActorBox -> Float -> m ()
setActorBoxY1 :: forall (m :: * -> *). MonadIO m => ActorBox -> Float -> m ()
setActorBoxY1 ActorBox
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorBox -> (Ptr ActorBox -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO ()) -> IO ())
-> (Ptr ActorBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ActorBoxY1FieldInfo
instance AttrInfo ActorBoxY1FieldInfo where
    type AttrBaseTypeConstraint ActorBoxY1FieldInfo = (~) ActorBox
    type AttrAllowedOps ActorBoxY1FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActorBoxY1FieldInfo = (~) Float
    type AttrTransferTypeConstraint ActorBoxY1FieldInfo = (~)Float
    type AttrTransferType ActorBoxY1FieldInfo = Float
    type AttrGetType ActorBoxY1FieldInfo = Float
    type AttrLabel ActorBoxY1FieldInfo = "y1"
    type AttrOrigin ActorBoxY1FieldInfo = ActorBox
    attrGet = getActorBoxY1
    attrSet = setActorBoxY1
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorBox.y1"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-ActorBox.html#g:attr:y1"
        })

actorBox_y1 :: AttrLabelProxy "y1"
actorBox_y1 = AttrLabelProxy

#endif


-- | Get the value of the “@x2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actorBox #x2
-- @
getActorBoxX2 :: MonadIO m => ActorBox -> m Float
getActorBoxX2 :: forall (m :: * -> *). MonadIO m => ActorBox -> m Float
getActorBoxX2 ActorBox
s = 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
$ ActorBox -> (Ptr ActorBox -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO Float) -> IO Float)
-> (Ptr ActorBox -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@x2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actorBox [ #x2 'Data.GI.Base.Attributes.:=' value ]
-- @
setActorBoxX2 :: MonadIO m => ActorBox -> Float -> m ()
setActorBoxX2 :: forall (m :: * -> *). MonadIO m => ActorBox -> Float -> m ()
setActorBoxX2 ActorBox
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorBox -> (Ptr ActorBox -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO ()) -> IO ())
-> (Ptr ActorBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ActorBoxX2FieldInfo
instance AttrInfo ActorBoxX2FieldInfo where
    type AttrBaseTypeConstraint ActorBoxX2FieldInfo = (~) ActorBox
    type AttrAllowedOps ActorBoxX2FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActorBoxX2FieldInfo = (~) Float
    type AttrTransferTypeConstraint ActorBoxX2FieldInfo = (~)Float
    type AttrTransferType ActorBoxX2FieldInfo = Float
    type AttrGetType ActorBoxX2FieldInfo = Float
    type AttrLabel ActorBoxX2FieldInfo = "x2"
    type AttrOrigin ActorBoxX2FieldInfo = ActorBox
    attrGet = getActorBoxX2
    attrSet = setActorBoxX2
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorBox.x2"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-ActorBox.html#g:attr:x2"
        })

actorBox_x2 :: AttrLabelProxy "x2"
actorBox_x2 = AttrLabelProxy

#endif


-- | Get the value of the “@y2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actorBox #y2
-- @
getActorBoxY2 :: MonadIO m => ActorBox -> m Float
getActorBoxY2 :: forall (m :: * -> *). MonadIO m => ActorBox -> m Float
getActorBoxY2 ActorBox
s = 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
$ ActorBox -> (Ptr ActorBox -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO Float) -> IO Float)
-> (Ptr ActorBox -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@y2@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actorBox [ #y2 'Data.GI.Base.Attributes.:=' value ]
-- @
setActorBoxY2 :: MonadIO m => ActorBox -> Float -> m ()
setActorBoxY2 :: forall (m :: * -> *). MonadIO m => ActorBox -> Float -> m ()
setActorBoxY2 ActorBox
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorBox -> (Ptr ActorBox -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActorBox
s ((Ptr ActorBox -> IO ()) -> IO ())
-> (Ptr ActorBox -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActorBox
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActorBox
ptr Ptr ActorBox -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data ActorBoxY2FieldInfo
instance AttrInfo ActorBoxY2FieldInfo where
    type AttrBaseTypeConstraint ActorBoxY2FieldInfo = (~) ActorBox
    type AttrAllowedOps ActorBoxY2FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActorBoxY2FieldInfo = (~) Float
    type AttrTransferTypeConstraint ActorBoxY2FieldInfo = (~)Float
    type AttrTransferType ActorBoxY2FieldInfo = Float
    type AttrGetType ActorBoxY2FieldInfo = Float
    type AttrLabel ActorBoxY2FieldInfo = "y2"
    type AttrOrigin ActorBoxY2FieldInfo = ActorBox
    attrGet = getActorBoxY2
    attrSet = setActorBoxY2
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorBox.y2"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Structs-ActorBox.html#g:attr:y2"
        })

actorBox_y2 :: AttrLabelProxy "y2"
actorBox_y2 = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActorBox
type instance O.AttributeList ActorBox = ActorBoxAttributeList
type ActorBoxAttributeList = ('[ '("x1", ActorBoxX1FieldInfo), '("y1", ActorBoxY1FieldInfo), '("x2", ActorBoxX2FieldInfo), '("y2", ActorBoxY2FieldInfo)] :: [(Symbol, *)])
#endif

-- method ActorBox::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "x_1"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the top left point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_1"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the top left point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_2"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the bottom right point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_2"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the bottom right point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ActorBox" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_new" clutter_actor_box_new :: 
    CFloat ->                               -- x_1 : TBasicType TFloat
    CFloat ->                               -- y_1 : TBasicType TFloat
    CFloat ->                               -- x_2 : TBasicType TFloat
    CFloat ->                               -- y_2 : TBasicType TFloat
    IO (Ptr ActorBox)

-- | Allocates a new t'GI.Clutter.Structs.ActorBox.ActorBox' using the passed coordinates
-- for the top left and bottom right points.
-- 
-- This function is the logical equivalent of:
-- 
-- >
-- >  clutter_actor_box_init (clutter_actor_box_alloc (),
-- >                          x_1, y_1,
-- >                          x_2, y_2);
-- 
-- 
-- /Since: 1.0/
actorBoxNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@x1@/: X coordinate of the top left point
    -> Float
    -- ^ /@y1@/: Y coordinate of the top left point
    -> Float
    -- ^ /@x2@/: X coordinate of the bottom right point
    -> Float
    -- ^ /@y2@/: Y coordinate of the bottom right point
    -> m ActorBox
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.ActorBox.ActorBox'.
    --   Use 'GI.Clutter.Structs.ActorBox.actorBoxFree' to free the resources
actorBoxNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Float -> Float -> Float -> Float -> m ActorBox
actorBoxNew Float
x1 Float
y1 Float
x2 Float
y2 = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    let x1' :: CFloat
x1' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x1
    let y1' :: CFloat
y1' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y1
    let x2' :: CFloat
x2' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x2
    let y2' :: CFloat
y2' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y2
    Ptr ActorBox
result <- CFloat -> CFloat -> CFloat -> CFloat -> IO (Ptr ActorBox)
clutter_actor_box_new CFloat
x1' CFloat
y1' CFloat
x2' CFloat
y2'
    Text -> Ptr ActorBox -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"actorBoxNew" Ptr ActorBox
result
    ActorBox
result' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Clamps the components of /@box@/ to the nearest integer
-- 
-- /Since: 1.2/
actorBoxClampToPixel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: the t'GI.Clutter.Structs.ActorBox.ActorBox' to clamp
    -> m ()
actorBoxClampToPixel :: forall (m :: * -> *). (HasCallStack, MonadIO m) => ActorBox -> m ()
actorBoxClampToPixel 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ActorBox
box
    Ptr ActorBox -> IO ()
clutter_actor_box_clamp_to_pixel Ptr ActorBox
box'
    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 ActorBoxClampToPixelMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ActorBoxClampToPixelMethodInfo ActorBox signature where
    overloadedMethod = actorBoxClampToPixel

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


#endif

-- method ActorBox::contains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the point"
--                 , 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_actor_box_contains" clutter_actor_box_contains :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    IO CInt

-- | Checks whether a point with /@x@/, /@y@/ coordinates is contained
-- withing /@box@/
-- 
-- /Since: 1.0/
actorBoxContains ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Float
    -- ^ /@x@/: X coordinate of the point
    -> Float
    -- ^ /@y@/: Y coordinate of the point
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the point is contained by the t'GI.Clutter.Structs.ActorBox.ActorBox'
actorBoxContains :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> Float -> Float -> m Bool
actorBoxContains ActorBox
box Float
x Float
y = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    CInt
result <- Ptr ActorBox -> CFloat -> CFloat -> IO CInt
clutter_actor_box_contains Ptr ActorBox
box' CFloat
x' CFloat
y'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxContainsMethodInfo
instance (signature ~ (Float -> Float -> m Bool), MonadIO m) => O.OverloadedMethod ActorBoxContainsMethodInfo ActorBox signature where
    overloadedMethod = actorBoxContains

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


#endif

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

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

-- | Copies /@box@/
-- 
-- /Since: 1.0/
actorBoxCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m ActorBox
    -- ^ __Returns:__ a newly allocated copy of t'GI.Clutter.Structs.ActorBox.ActorBox'. Use
    --   'GI.Clutter.Structs.ActorBox.actorBoxFree' to free the allocated resources
actorBoxCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m ActorBox
actorBoxCopy ActorBox
box = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    Ptr ActorBox
result <- Ptr ActorBox -> IO (Ptr ActorBox)
clutter_actor_box_copy Ptr ActorBox
box'
    Text -> Ptr ActorBox -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"actorBoxCopy" Ptr ActorBox
result
    ActorBox
result' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxCopyMethodInfo
instance (signature ~ (m ActorBox), MonadIO m) => O.OverloadedMethod ActorBoxCopyMethodInfo ActorBox signature where
    overloadedMethod = actorBoxCopy

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


#endif

-- method ActorBox::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box_a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "box_b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_equal" clutter_actor_box_equal :: 
    Ptr ActorBox ->                         -- box_a : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr ActorBox ->                         -- box_b : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CInt

-- | Checks /@boxA@/ and /@boxB@/ for equality
-- 
-- /Since: 1.0/
actorBoxEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@boxA@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> ActorBox
    -- ^ /@boxB@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the passed t'GI.Clutter.Structs.ActorBox.ActorBox' are equal
actorBoxEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> ActorBox -> m Bool
actorBoxEqual ActorBox
boxA ActorBox
boxB = 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 ActorBox
boxA' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
boxA
    Ptr ActorBox
boxB' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
boxB
    CInt
result <- Ptr ActorBox -> Ptr ActorBox -> IO CInt
clutter_actor_box_equal Ptr ActorBox
boxA' Ptr ActorBox
boxB'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
boxA
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
boxB
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxEqualMethodInfo
instance (signature ~ (ActorBox -> m Bool), MonadIO m) => O.OverloadedMethod ActorBoxEqualMethodInfo ActorBox signature where
    overloadedMethod = actorBoxEqual

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


#endif

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

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

-- | Frees a t'GI.Clutter.Structs.ActorBox.ActorBox' allocated using 'GI.Clutter.Structs.ActorBox.actorBoxNew'
-- or 'GI.Clutter.Structs.ActorBox.actorBoxCopy'
-- 
-- /Since: 1.0/
actorBoxFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m ()
actorBoxFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => ActorBox -> m ()
actorBoxFree 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    Ptr ActorBox -> IO ()
clutter_actor_box_free Ptr ActorBox
box'
    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 ActorBoxFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ActorBoxFreeMethodInfo ActorBox signature where
    overloadedMethod = actorBoxFree

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


#endif

-- method ActorBox::from_vertices
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "verts"
--           , argType =
--               TCArray
--                 False
--                 4
--                 (-1)
--                 (TInterface Name { namespace = "Clutter" , name = "Vertex" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of four #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_actor_box_from_vertices" clutter_actor_box_from_vertices :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr Clutter.Vertex.Vertex ->            -- verts : TCArray False 4 (-1) (TInterface (Name {namespace = "Clutter", name = "Vertex"}))
    IO ()

-- | Calculates the bounding box represented by the four vertices; for details
-- of the vertex array see 'GI.Clutter.Objects.Actor.actorGetAbsAllocationVertices'.
-- 
-- /Since: 1.0/
actorBoxFromVertices ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> [Clutter.Vertex.Vertex]
    -- ^ /@verts@/: array of four t'GI.Clutter.Structs.Vertex.Vertex'
    -> m ()
actorBoxFromVertices :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> [Vertex] -> m ()
actorBoxFromVertices ActorBox
box [Vertex]
verts = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    [Ptr Vertex]
verts' <- (Vertex -> IO (Ptr Vertex)) -> [Vertex] -> IO [Ptr Vertex]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Vertex -> IO (Ptr Vertex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Vertex]
verts
    Ptr Vertex
verts'' <- Int -> [Ptr Vertex] -> IO (Ptr Vertex)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
12 [Ptr Vertex]
verts'
    Ptr ActorBox -> Ptr Vertex -> IO ()
clutter_actor_box_from_vertices Ptr ActorBox
box' Ptr Vertex
verts''
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    (Vertex -> IO ()) -> [Vertex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Vertex]
verts
    Ptr Vertex -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Vertex
verts''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ActorBoxFromVerticesMethodInfo
instance (signature ~ ([Clutter.Vertex.Vertex] -> m ()), MonadIO m) => O.OverloadedMethod ActorBoxFromVerticesMethodInfo ActorBox signature where
    overloadedMethod = actorBoxFromVertices

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


#endif

-- method ActorBox::get_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_get_area" clutter_actor_box_get_area :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CFloat

-- | Retrieves the area of /@box@/
-- 
-- /Since: 1.0/
actorBoxGetArea ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Float
    -- ^ __Returns:__ the area of a t'GI.Clutter.Structs.ActorBox.ActorBox', in pixels
actorBoxGetArea :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m Float
actorBoxGetArea ActorBox
box = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    CFloat
result <- Ptr ActorBox -> IO CFloat
clutter_actor_box_get_area Ptr ActorBox
box'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetAreaMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod ActorBoxGetAreaMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetArea

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


#endif

-- method ActorBox::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_get_height" clutter_actor_box_get_height :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CFloat

-- | Retrieves the height of the /@box@/
-- 
-- /Since: 1.0/
actorBoxGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Float
    -- ^ __Returns:__ the height of the box
actorBoxGetHeight :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m Float
actorBoxGetHeight ActorBox
box = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    CFloat
result <- Ptr ActorBox -> IO CFloat
clutter_actor_box_get_height Ptr ActorBox
box'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetHeightMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod ActorBoxGetHeightMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetHeight

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


#endif

-- method ActorBox::get_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the X coordinate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the Y coordinate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_get_origin" clutter_actor_box_get_origin :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr CFloat ->                           -- x : TBasicType TFloat
    Ptr CFloat ->                           -- y : TBasicType TFloat
    IO ()

-- | Retrieves the origin of /@box@/
-- 
-- /Since: 1.0/
actorBoxGetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m ((Float, Float))
actorBoxGetOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m (Float, Float)
actorBoxGetOrigin ActorBox
box = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    Ptr CFloat
x <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
y <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr ActorBox -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_actor_box_get_origin Ptr ActorBox
box' Ptr CFloat
x Ptr CFloat
y
    CFloat
x' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
x
    let x'' :: Float
x'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x'
    CFloat
y' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
y
    let y'' :: Float
y'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y'
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
x
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
y
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
x'', Float
y'')

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetOriginMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m) => O.OverloadedMethod ActorBoxGetOriginMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetOrigin

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


#endif

-- method ActorBox::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the width, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the height, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_get_size" clutter_actor_box_get_size :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr CFloat ->                           -- width : TBasicType TFloat
    Ptr CFloat ->                           -- height : TBasicType TFloat
    IO ()

-- | Retrieves the size of /@box@/
-- 
-- /Since: 1.0/
actorBoxGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m ((Float, Float))
actorBoxGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m (Float, Float)
actorBoxGetSize ActorBox
box = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    Ptr CFloat
width <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
height <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr ActorBox -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_actor_box_get_size Ptr ActorBox
box' Ptr CFloat
width Ptr CFloat
height
    CFloat
width' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
width
    let width'' :: Float
width'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
width'
    CFloat
height' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
height
    let height'' :: Float
height'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
height'
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
width
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
height
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
width'', Float
height'')

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetSizeMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m) => O.OverloadedMethod ActorBoxGetSizeMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetSize

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


#endif

-- method ActorBox::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_get_width" clutter_actor_box_get_width :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CFloat

-- | Retrieves the width of the /@box@/
-- 
-- /Since: 1.0/
actorBoxGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Float
    -- ^ __Returns:__ the width of the box
actorBoxGetWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m Float
actorBoxGetWidth ActorBox
box = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    CFloat
result <- Ptr ActorBox -> IO CFloat
clutter_actor_box_get_width Ptr ActorBox
box'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetWidthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod ActorBoxGetWidthMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetWidth

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


#endif

-- method ActorBox::get_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_get_x" clutter_actor_box_get_x :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CFloat

-- | Retrieves the X coordinate of the origin of /@box@/
-- 
-- /Since: 1.0/
actorBoxGetX ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Float
    -- ^ __Returns:__ the X coordinate of the origin
actorBoxGetX :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m Float
actorBoxGetX ActorBox
box = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    CFloat
result <- Ptr ActorBox -> IO CFloat
clutter_actor_box_get_x Ptr ActorBox
box'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetXMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod ActorBoxGetXMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetX

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


#endif

-- method ActorBox::get_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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_actor_box_get_y" clutter_actor_box_get_y :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO CFloat

-- | Retrieves the Y coordinate of the origin of /@box@/
-- 
-- /Since: 1.0/
actorBoxGetY ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m Float
    -- ^ __Returns:__ the Y coordinate of the origin
actorBoxGetY :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> m Float
actorBoxGetY ActorBox
box = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    CFloat
result <- Ptr ActorBox -> IO CFloat
clutter_actor_box_get_y Ptr ActorBox
box'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxGetYMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod ActorBoxGetYMethodInfo ActorBox signature where
    overloadedMethod = actorBoxGetY

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


#endif

-- method ActorBox::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_1"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the top left point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_1"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the top left point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_2"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the bottom right point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_2"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the bottom right point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ActorBox" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_init" clutter_actor_box_init :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CFloat ->                               -- x_1 : TBasicType TFloat
    CFloat ->                               -- y_1 : TBasicType TFloat
    CFloat ->                               -- x_2 : TBasicType TFloat
    CFloat ->                               -- y_2 : TBasicType TFloat
    IO (Ptr ActorBox)

-- | Initializes /@box@/ with the given coordinates.
-- 
-- /Since: 1.10/
actorBoxInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Float
    -- ^ /@x1@/: X coordinate of the top left point
    -> Float
    -- ^ /@y1@/: Y coordinate of the top left point
    -> Float
    -- ^ /@x2@/: X coordinate of the bottom right point
    -> Float
    -- ^ /@y2@/: Y coordinate of the bottom right point
    -> m ActorBox
    -- ^ __Returns:__ the initialized t'GI.Clutter.Structs.ActorBox.ActorBox'
actorBoxInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> Float -> Float -> Float -> Float -> m ActorBox
actorBoxInit ActorBox
box Float
x1 Float
y1 Float
x2 Float
y2 = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    let x1' :: CFloat
x1' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x1
    let y1' :: CFloat
y1' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y1
    let x2' :: CFloat
x2' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x2
    let y2' :: CFloat
y2' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y2
    Ptr ActorBox
result <- Ptr ActorBox
-> CFloat -> CFloat -> CFloat -> CFloat -> IO (Ptr ActorBox)
clutter_actor_box_init Ptr ActorBox
box' CFloat
x1' CFloat
y1' CFloat
x2' CFloat
y2'
    Text -> Ptr ActorBox -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"actorBoxInit" Ptr ActorBox
result
    ActorBox
result' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
box
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result'

#if defined(ENABLE_OVERLOADING)
data ActorBoxInitMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ActorBox), MonadIO m) => O.OverloadedMethod ActorBoxInitMethodInfo ActorBox signature where
    overloadedMethod = actorBoxInit

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


#endif

-- method ActorBox::init_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate of the origin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Y coordinate of the origin"
--                 , 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 "width of the box" , 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 "height of the box" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_init_rect" clutter_actor_box_init_rect :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- width : TBasicType TFloat
    CFloat ->                               -- height : TBasicType TFloat
    IO ()

-- | Initializes /@box@/ with the given origin and size.
-- 
-- /Since: 1.10/
actorBoxInitRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Float
    -- ^ /@x@/: X coordinate of the origin
    -> Float
    -- ^ /@y@/: Y coordinate of the origin
    -> Float
    -- ^ /@width@/: width of the box
    -> Float
    -- ^ /@height@/: height of the box
    -> m ()
actorBoxInitRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> Float -> Float -> Float -> Float -> m ()
actorBoxInitRect ActorBox
box Float
x Float
y Float
width 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    let width' :: CFloat
width' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width
    let height' :: CFloat
height' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height
    Ptr ActorBox -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
clutter_actor_box_init_rect Ptr ActorBox
box' CFloat
x' CFloat
y' CFloat
width' CFloat
height'
    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 ActorBoxInitRectMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod ActorBoxInitRectMethodInfo ActorBox signature where
    overloadedMethod = actorBoxInitRect

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


#endif

-- method ActorBox::interpolate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "initial"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial #ClutterActorBox"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the final #ClutterActorBox"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interpolation progress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the interpolation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_interpolate" clutter_actor_box_interpolate :: 
    Ptr ActorBox ->                         -- initial : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr ActorBox ->                         -- final : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr ActorBox ->                         -- result : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO ()

-- | Interpolates between /@initial@/ and /@final@/ t'GI.Clutter.Structs.ActorBox.ActorBox'es
-- using /@progress@/
-- 
-- /Since: 1.2/
actorBoxInterpolate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@initial@/: the initial t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> ActorBox
    -- ^ /@final@/: the final t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Double
    -- ^ /@progress@/: the interpolation progress
    -> m (ActorBox)
actorBoxInterpolate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> ActorBox -> Double -> m ActorBox
actorBoxInterpolate ActorBox
initial ActorBox
final Double
progress = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
initial' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
initial
    Ptr ActorBox
final' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
final
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr ActorBox
result_ <- Int -> IO (Ptr ActorBox)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr ActorBox)
    Ptr ActorBox -> Ptr ActorBox -> CDouble -> Ptr ActorBox -> IO ()
clutter_actor_box_interpolate Ptr ActorBox
initial' Ptr ActorBox
final' CDouble
progress' Ptr ActorBox
result_
    ActorBox
result_' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result_
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
initial
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
final
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result_'

#if defined(ENABLE_OVERLOADING)
data ActorBoxInterpolateMethodInfo
instance (signature ~ (ActorBox -> Double -> m (ActorBox)), MonadIO m) => O.OverloadedMethod ActorBoxInterpolateMethodInfo ActorBox signature where
    overloadedMethod = actorBoxInterpolate

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


#endif

-- method ActorBox::set_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the X coordinate of the new origin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Y coordinate of the new origin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_set_origin" clutter_actor_box_set_origin :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    IO ()

-- | Changes the origin of /@box@/, maintaining the size of the t'GI.Clutter.Structs.ActorBox.ActorBox'.
-- 
-- /Since: 1.6/
actorBoxSetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Float
    -- ^ /@x@/: the X coordinate of the new origin
    -> Float
    -- ^ /@y@/: the Y coordinate of the new origin
    -> m ()
actorBoxSetOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> Float -> Float -> m ()
actorBoxSetOrigin ActorBox
box Float
x Float
y = 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    Ptr ActorBox -> CFloat -> CFloat -> IO ()
clutter_actor_box_set_origin Ptr ActorBox
box' CFloat
x' CFloat
y'
    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 ActorBoxSetOriginMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod ActorBoxSetOriginMethodInfo ActorBox signature where
    overloadedMethod = actorBoxSetOrigin

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


#endif

-- method ActorBox::set_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "box"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorBox" , 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 new width" , 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 new height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_set_size" clutter_actor_box_set_size :: 
    Ptr ActorBox ->                         -- box : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    CFloat ->                               -- width : TBasicType TFloat
    CFloat ->                               -- height : TBasicType TFloat
    IO ()

-- | Sets the size of /@box@/, maintaining the origin of the t'GI.Clutter.Structs.ActorBox.ActorBox'.
-- 
-- /Since: 1.6/
actorBoxSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@box@/: a t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> Float
    -- ^ /@width@/: the new width
    -> Float
    -- ^ /@height@/: the new height
    -> m ()
actorBoxSetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> Float -> Float -> m ()
actorBoxSetSize ActorBox
box Float
width 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 ActorBox
box' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
box
    let width' :: CFloat
width' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width
    let height' :: CFloat
height' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height
    Ptr ActorBox -> CFloat -> CFloat -> IO ()
clutter_actor_box_set_size Ptr ActorBox
box' CFloat
width' CFloat
height'
    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 ActorBoxSetSizeMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod ActorBoxSetSizeMethodInfo ActorBox signature where
    overloadedMethod = actorBoxSetSize

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


#endif

-- method ActorBox::union
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first #ClutterActorBox"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second #ClutterActorBox"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorBox" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #ClutterActorBox representing a union\n  of @a and @b"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_box_union" clutter_actor_box_union :: 
    Ptr ActorBox ->                         -- a : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr ActorBox ->                         -- b : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    Ptr ActorBox ->                         -- result : TInterface (Name {namespace = "Clutter", name = "ActorBox"})
    IO ()

-- | Unions the two boxes /@a@/ and /@b@/ and stores the result in /@result@/.
-- 
-- /Since: 1.4/
actorBoxUnion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorBox
    -- ^ /@a@/: the first t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> ActorBox
    -- ^ /@b@/: the second t'GI.Clutter.Structs.ActorBox.ActorBox'
    -> m (ActorBox)
actorBoxUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorBox -> ActorBox -> m ActorBox
actorBoxUnion ActorBox
a ActorBox
b = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
a' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
a
    Ptr ActorBox
b' <- ActorBox -> IO (Ptr ActorBox)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorBox
b
    Ptr ActorBox
result_ <- Int -> IO (Ptr ActorBox)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr ActorBox)
    Ptr ActorBox -> Ptr ActorBox -> Ptr ActorBox -> IO ()
clutter_actor_box_union Ptr ActorBox
a' Ptr ActorBox
b' Ptr ActorBox
result_
    ActorBox
result_' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result_
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
a
    ActorBox -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorBox
b
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result_'

#if defined(ENABLE_OVERLOADING)
data ActorBoxUnionMethodInfo
instance (signature ~ (ActorBox -> m (ActorBox)), MonadIO m) => O.OverloadedMethod ActorBoxUnionMethodInfo ActorBox signature where
    overloadedMethod = actorBoxUnion

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


#endif

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

foreign import ccall "clutter_actor_box_alloc" clutter_actor_box_alloc :: 
    IO (Ptr ActorBox)

-- | Allocates a new t'GI.Clutter.Structs.ActorBox.ActorBox'.
-- 
-- /Since: 1.12/
actorBoxAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ActorBox
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.ActorBox.ActorBox'.
    --   Use 'GI.Clutter.Structs.ActorBox.actorBoxFree' to free its resources
actorBoxAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ActorBox
actorBoxAlloc  = IO ActorBox -> m ActorBox
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorBox -> m ActorBox) -> IO ActorBox -> m ActorBox
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorBox
result <- IO (Ptr ActorBox)
clutter_actor_box_alloc
    Text -> Ptr ActorBox -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"actorBoxAlloc" Ptr ActorBox
result
    ActorBox
result' <- ((ManagedPtr ActorBox -> ActorBox) -> Ptr ActorBox -> IO ActorBox
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ActorBox -> ActorBox
ActorBox) Ptr ActorBox
result
    ActorBox -> IO ActorBox
forall (m :: * -> *) a. Monad m => a -> m a
return ActorBox
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveActorBoxMethod (t :: Symbol) (o :: *) :: * where
    ResolveActorBoxMethod "clampToPixel" o = ActorBoxClampToPixelMethodInfo
    ResolveActorBoxMethod "contains" o = ActorBoxContainsMethodInfo
    ResolveActorBoxMethod "copy" o = ActorBoxCopyMethodInfo
    ResolveActorBoxMethod "equal" o = ActorBoxEqualMethodInfo
    ResolveActorBoxMethod "free" o = ActorBoxFreeMethodInfo
    ResolveActorBoxMethod "fromVertices" o = ActorBoxFromVerticesMethodInfo
    ResolveActorBoxMethod "init" o = ActorBoxInitMethodInfo
    ResolveActorBoxMethod "initRect" o = ActorBoxInitRectMethodInfo
    ResolveActorBoxMethod "interpolate" o = ActorBoxInterpolateMethodInfo
    ResolveActorBoxMethod "union" o = ActorBoxUnionMethodInfo
    ResolveActorBoxMethod "getArea" o = ActorBoxGetAreaMethodInfo
    ResolveActorBoxMethod "getHeight" o = ActorBoxGetHeightMethodInfo
    ResolveActorBoxMethod "getOrigin" o = ActorBoxGetOriginMethodInfo
    ResolveActorBoxMethod "getSize" o = ActorBoxGetSizeMethodInfo
    ResolveActorBoxMethod "getWidth" o = ActorBoxGetWidthMethodInfo
    ResolveActorBoxMethod "getX" o = ActorBoxGetXMethodInfo
    ResolveActorBoxMethod "getY" o = ActorBoxGetYMethodInfo
    ResolveActorBoxMethod "setOrigin" o = ActorBoxSetOriginMethodInfo
    ResolveActorBoxMethod "setSize" o = ActorBoxSetSizeMethodInfo
    ResolveActorBoxMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif