{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A point in 3D space, expressed in pixels
-- 
-- /Since: 0.4/

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

module GI.Clutter.Structs.Vertex
    ( 

-- * Exported types
    Vertex(..)                              ,
    newZeroVertex                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Clutter.Structs.Vertex#g:method:copy"), [equal]("GI.Clutter.Structs.Vertex#g:method:equal"), [free]("GI.Clutter.Structs.Vertex#g:method:free"), [init]("GI.Clutter.Structs.Vertex#g:method:init").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVertexMethod                     ,
#endif

-- ** alloc #method:alloc#

    vertexAlloc                             ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VertexCopyMethodInfo                    ,
#endif
    vertexCopy                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    VertexEqualMethodInfo                   ,
#endif
    vertexEqual                             ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VertexFreeMethodInfo                    ,
#endif
    vertexFree                              ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    VertexInitMethodInfo                    ,
#endif
    vertexInit                              ,


-- ** new #method:new#

    vertexNew                               ,




 -- * Properties


-- ** x #attr:x#
-- | X coordinate of the vertex

    getVertexX                              ,
    setVertexX                              ,
#if defined(ENABLE_OVERLOADING)
    vertex_x                                ,
#endif


-- ** y #attr:y#
-- | Y coordinate of the vertex

    getVertexY                              ,
    setVertexY                              ,
#if defined(ENABLE_OVERLOADING)
    vertex_y                                ,
#endif


-- ** z #attr:z#
-- | Z coordinate of the vertex

    getVertexZ                              ,
    setVertexZ                              ,
#if defined(ENABLE_OVERLOADING)
    vertex_z                                ,
#endif




    ) 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


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

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

foreign import ccall "clutter_vertex_get_type" c_clutter_vertex_get_type :: 
    IO GType

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

instance B.Types.TypedObject Vertex where
    glibType :: IO GType
glibType = IO GType
c_clutter_vertex_get_type

instance B.Types.GBoxed Vertex

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

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

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


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vertex #x
-- @
getVertexX :: MonadIO m => Vertex -> m Float
getVertexX :: forall (m :: * -> *). MonadIO m => Vertex -> m Float
getVertexX Vertex
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
$ Vertex -> (Ptr Vertex -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO Float) -> IO Float)
-> (Ptr Vertex -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Vertex
ptr Ptr Vertex -> 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 “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' vertex [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setVertexX :: MonadIO m => Vertex -> Float -> m ()
setVertexX :: forall (m :: * -> *). MonadIO m => Vertex -> Float -> m ()
setVertexX Vertex
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
$ Vertex -> (Ptr Vertex -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO ()) -> IO ()) -> (Ptr Vertex -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
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 Vertex
ptr Ptr Vertex -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CFloat
val' :: CFloat)

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

vertex_x :: AttrLabelProxy "x"
vertex_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vertex #y
-- @
getVertexY :: MonadIO m => Vertex -> m Float
getVertexY :: forall (m :: * -> *). MonadIO m => Vertex -> m Float
getVertexY Vertex
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
$ Vertex -> (Ptr Vertex -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO Float) -> IO Float)
-> (Ptr Vertex -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Vertex
ptr Ptr Vertex -> 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 “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' vertex [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setVertexY :: MonadIO m => Vertex -> Float -> m ()
setVertexY :: forall (m :: * -> *). MonadIO m => Vertex -> Float -> m ()
setVertexY Vertex
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
$ Vertex -> (Ptr Vertex -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO ()) -> IO ()) -> (Ptr Vertex -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
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 Vertex
ptr Ptr Vertex -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (CFloat
val' :: CFloat)

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

vertex_y :: AttrLabelProxy "y"
vertex_y = AttrLabelProxy

#endif


-- | Get the value of the “@z@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vertex #z
-- @
getVertexZ :: MonadIO m => Vertex -> m Float
getVertexZ :: forall (m :: * -> *). MonadIO m => Vertex -> m Float
getVertexZ Vertex
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
$ Vertex -> (Ptr Vertex -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO Float) -> IO Float)
-> (Ptr Vertex -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Vertex
ptr Ptr Vertex -> 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 “@z@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' vertex [ #z 'Data.GI.Base.Attributes.:=' value ]
-- @
setVertexZ :: MonadIO m => Vertex -> Float -> m ()
setVertexZ :: forall (m :: * -> *). MonadIO m => Vertex -> Float -> m ()
setVertexZ Vertex
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
$ Vertex -> (Ptr Vertex -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Vertex
s ((Ptr Vertex -> IO ()) -> IO ()) -> (Ptr Vertex -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Vertex
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 Vertex
ptr Ptr Vertex -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CFloat
val' :: CFloat)

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

vertex_z :: AttrLabelProxy "z"
vertex_z = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Vertex
type instance O.AttributeList Vertex = VertexAttributeList
type VertexAttributeList = ('[ '("x", VertexXFieldInfo), '("y", VertexYFieldInfo), '("z", VertexZFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "clutter_vertex_alloc" clutter_vertex_alloc :: 
    IO (Ptr Vertex)

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

#if defined(ENABLE_OVERLOADING)
#endif

-- method Vertex::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Z coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Vertex" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_vertex_new" clutter_vertex_new :: 
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    IO (Ptr Vertex)

-- | Creates a new t'GI.Clutter.Structs.Vertex.Vertex' for the point in 3D space
-- identified by the 3 coordinates /@x@/, /@y@/, /@z@/.
-- 
-- This function is the logical equivalent of:
-- 
-- >
-- >  clutter_vertex_init (clutter_vertex_alloc (), x, y, z);
-- 
-- 
-- /Since: 1.0/
vertexNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@x@/: X coordinate
    -> Float
    -- ^ /@y@/: Y coordinate
    -> Float
    -- ^ /@z@/: Z coordinate
    -> m Vertex
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.Vertex.Vertex'.
    --   Use 'GI.Clutter.Structs.Vertex.vertexFree' to free the resources
vertexNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Float -> Float -> Float -> m Vertex
vertexNew Float
x Float
y Float
z = IO Vertex -> m Vertex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vertex -> m Vertex) -> IO Vertex -> m Vertex
forall a b. (a -> b) -> a -> b
$ do
    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 z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr Vertex
result <- CFloat -> CFloat -> CFloat -> IO (Ptr Vertex)
clutter_vertex_new CFloat
x' CFloat
y' CFloat
z'
    Text -> Ptr Vertex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vertexNew" Ptr Vertex
result
    Vertex
result' <- ((ManagedPtr Vertex -> Vertex) -> Ptr Vertex -> IO Vertex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vertex -> Vertex
Vertex) Ptr Vertex
result
    Vertex -> IO Vertex
forall (m :: * -> *) a. Monad m => a -> m a
return Vertex
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data VertexCopyMethodInfo
instance (signature ~ (m Vertex), MonadIO m) => O.OverloadedMethod VertexCopyMethodInfo Vertex signature where
    overloadedMethod = vertexCopy

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


#endif

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

foreign import ccall "clutter_vertex_equal" clutter_vertex_equal :: 
    Ptr Vertex ->                           -- vertex_a : TInterface (Name {namespace = "Clutter", name = "Vertex"})
    Ptr Vertex ->                           -- vertex_b : TInterface (Name {namespace = "Clutter", name = "Vertex"})
    IO CInt

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

#if defined(ENABLE_OVERLOADING)
data VertexEqualMethodInfo
instance (signature ~ (Vertex -> m Bool), MonadIO m) => O.OverloadedMethod VertexEqualMethodInfo Vertex signature where
    overloadedMethod = vertexEqual

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


#endif

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

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

-- | Frees a t'GI.Clutter.Structs.Vertex.Vertex' allocated using 'GI.Clutter.Structs.Vertex.vertexAlloc' or
-- 'GI.Clutter.Structs.Vertex.vertexCopy'.
-- 
-- /Since: 1.0/
vertexFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vertex
    -- ^ /@vertex@/: a t'GI.Clutter.Structs.Vertex.Vertex'
    -> m ()
vertexFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vertex -> m ()
vertexFree Vertex
vertex = 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 Vertex
vertex' <- Vertex -> IO (Ptr Vertex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vertex
vertex
    Ptr Vertex -> IO ()
clutter_vertex_free Ptr Vertex
vertex'
    Vertex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vertex
vertex
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VertexFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VertexFreeMethodInfo Vertex signature where
    overloadedMethod = vertexFree

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


#endif

-- method Vertex::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vertex"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Vertex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterVertex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "X coordinate" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Z coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Vertex" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_vertex_init" clutter_vertex_init :: 
    Ptr Vertex ->                           -- vertex : TInterface (Name {namespace = "Clutter", name = "Vertex"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    IO (Ptr Vertex)

-- | Initializes /@vertex@/ with the given coordinates.
-- 
-- /Since: 1.10/
vertexInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vertex
    -- ^ /@vertex@/: a t'GI.Clutter.Structs.Vertex.Vertex'
    -> Float
    -- ^ /@x@/: X coordinate
    -> Float
    -- ^ /@y@/: Y coordinate
    -> Float
    -- ^ /@z@/: Z coordinate
    -> m Vertex
    -- ^ __Returns:__ the initialized t'GI.Clutter.Structs.Vertex.Vertex'
vertexInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vertex -> Float -> Float -> Float -> m Vertex
vertexInit Vertex
vertex Float
x Float
y Float
z = IO Vertex -> m Vertex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vertex -> m Vertex) -> IO Vertex -> m Vertex
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vertex
vertex' <- Vertex -> IO (Ptr Vertex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vertex
vertex
    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 z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr Vertex
result <- Ptr Vertex -> CFloat -> CFloat -> CFloat -> IO (Ptr Vertex)
clutter_vertex_init Ptr Vertex
vertex' CFloat
x' CFloat
y' CFloat
z'
    Text -> Ptr Vertex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vertexInit" Ptr Vertex
result
    Vertex
result' <- ((ManagedPtr Vertex -> Vertex) -> Ptr Vertex -> IO Vertex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vertex -> Vertex
Vertex) Ptr Vertex
result
    Vertex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vertex
vertex
    Vertex -> IO Vertex
forall (m :: * -> *) a. Monad m => a -> m a
return Vertex
result'

#if defined(ENABLE_OVERLOADING)
data VertexInitMethodInfo
instance (signature ~ (Float -> Float -> Float -> m Vertex), MonadIO m) => O.OverloadedMethod VertexInitMethodInfo Vertex signature where
    overloadedMethod = vertexInit

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVertexMethod (t :: Symbol) (o :: *) :: * where
    ResolveVertexMethod "copy" o = VertexCopyMethodInfo
    ResolveVertexMethod "equal" o = VertexEqualMethodInfo
    ResolveVertexMethod "free" o = VertexFreeMethodInfo
    ResolveVertexMethod "init" o = VertexInitMethodInfo
    ResolveVertexMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif