{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A point in 2D space.
-- 
-- /Since: 1.12/

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

module GI.Clutter.Structs.Point
    ( 

-- * Exported types
    Point(..)                               ,
    newZeroPoint                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePointMethod                      ,
#endif

-- ** alloc #method:alloc#

    pointAlloc                              ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PointCopyMethodInfo                     ,
#endif
    pointCopy                               ,


-- ** distance #method:distance#

#if defined(ENABLE_OVERLOADING)
    PointDistanceMethodInfo                 ,
#endif
    pointDistance                           ,


-- ** equals #method:equals#

#if defined(ENABLE_OVERLOADING)
    PointEqualsMethodInfo                   ,
#endif
    pointEquals                             ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PointFreeMethodInfo                     ,
#endif
    pointFree                               ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    PointInitMethodInfo                     ,
#endif
    pointInit                               ,


-- ** zero #method:zero#

    pointZero                               ,




 -- * Properties


-- ** x #attr:x#
-- | X coordinate, in pixels

    getPointX                               ,
#if defined(ENABLE_OVERLOADING)
    point_x                                 ,
#endif
    setPointX                               ,


-- ** y #attr:y#
-- | Y coordinate, in pixels

    getPointY                               ,
#if defined(ENABLE_OVERLOADING)
    point_y                                 ,
#endif
    setPointY                               ,




    ) 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 Point = Point (SP.ManagedPtr Point)
    deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq)

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

foreign import ccall "clutter_point_get_type" c_clutter_point_get_type :: 
    IO GType

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

instance B.Types.TypedObject Point where
    glibType :: IO GType
glibType = IO GType
c_clutter_point_get_type

instance B.Types.GBoxed Point

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

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

instance tag ~ 'AttrSet => Constructible Point tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Point -> Point) -> [AttrOp Point tag] -> m Point
new ManagedPtr Point -> Point
_ [AttrOp Point tag]
attrs = do
        Point
o <- m Point
forall (m :: * -> *). MonadIO m => m Point
newZeroPoint
        Point -> [AttrOp Point 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Point
o [AttrOp Point tag]
[AttrOp Point 'AttrSet]
attrs
        Point -> m Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
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' point #x
-- @
getPointX :: MonadIO m => Point -> m Float
getPointX :: forall (m :: * -> *). MonadIO m => Point -> m Float
getPointX Point
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
$ Point -> (Ptr Point -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO Float) -> IO Float)
-> (Ptr Point -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Point
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point
ptr Ptr Point -> 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' point [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setPointX :: MonadIO m => Point -> Float -> m ()
setPointX :: forall (m :: * -> *). MonadIO m => Point -> Float -> m ()
setPointX Point
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
$ Point -> (Ptr Point -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO ()) -> IO ()) -> (Ptr Point -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point
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 Point
ptr Ptr Point -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CFloat
val' :: CFloat)

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

point_x :: AttrLabelProxy "x"
point_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' point #y
-- @
getPointY :: MonadIO m => Point -> m Float
getPointY :: forall (m :: * -> *). MonadIO m => Point -> m Float
getPointY Point
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
$ Point -> (Ptr Point -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO Float) -> IO Float)
-> (Ptr Point -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Point
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point
ptr Ptr Point -> 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' point [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setPointY :: MonadIO m => Point -> Float -> m ()
setPointY :: forall (m :: * -> *). MonadIO m => Point -> Float -> m ()
setPointY Point
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
$ Point -> (Ptr Point -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point
s ((Ptr Point -> IO ()) -> IO ()) -> (Ptr Point -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point
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 Point
ptr Ptr Point -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (CFloat
val' :: CFloat)

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

point_y :: AttrLabelProxy "y"
point_y = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Point
type instance O.AttributeList Point = PointAttributeList
type PointAttributeList = ('[ '("x", PointXFieldInfo), '("y", PointYFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "clutter_point_alloc" clutter_point_alloc :: 
    IO (Ptr Point)

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

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_point_copy" clutter_point_copy :: 
    Ptr Point ->                            -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO (Ptr Point)

-- | Creates a new t'GI.Clutter.Structs.Point.Point' with the same coordinates of /@point@/.
-- 
-- /Since: 1.12/
pointCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@point@/: a t'GI.Clutter.Structs.Point.Point'
    -> m Point
    -- ^ __Returns:__ a newly allocated t'GI.Clutter.Structs.Point.Point'.
    --   Use 'GI.Clutter.Structs.Point.pointFree' to free its resources.
pointCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Point -> m Point
pointCopy Point
point = IO Point -> m Point
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Point
result <- Ptr Point -> IO (Ptr Point)
clutter_point_copy Ptr Point
point'
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pointCopy" Ptr Point
result
    Point
result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Point) Ptr Point
result
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
data PointCopyMethodInfo
instance (signature ~ (m Point), MonadIO m) => O.OverloadedMethod PointCopyMethodInfo Point signature where
    overloadedMethod = pointCopy

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


#endif

-- method Point::distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_distance"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the horizontal\n  distance between the points"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_distance"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the vertical\n  distance between the points"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_point_distance" clutter_point_distance :: 
    Ptr Point ->                            -- a : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Point ->                            -- b : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr CFloat ->                           -- x_distance : TBasicType TFloat
    Ptr CFloat ->                           -- y_distance : TBasicType TFloat
    IO CFloat

-- | Computes the distance between two t'GI.Clutter.Structs.Point.Point'.
-- 
-- /Since: 1.12/
pointDistance ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@a@/: a t'GI.Clutter.Structs.Point.Point'
    -> Point
    -- ^ /@b@/: a t'GI.Clutter.Structs.Point.Point'
    -> m ((Float, Float, Float))
    -- ^ __Returns:__ the distance between the points.
pointDistance :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Point -> Point -> m (Float, Float, Float)
pointDistance Point
a Point
b = IO (Float, Float, Float) -> m (Float, Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float, Float) -> m (Float, Float, Float))
-> IO (Float, Float, Float) -> m (Float, Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point
a' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
a
    Ptr Point
b' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
b
    Ptr CFloat
xDistance <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
yDistance <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CFloat
result <- Ptr Point -> Ptr Point -> Ptr CFloat -> Ptr CFloat -> IO CFloat
clutter_point_distance Ptr Point
a' Ptr Point
b' Ptr CFloat
xDistance Ptr CFloat
yDistance
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    CFloat
xDistance' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
xDistance
    let xDistance'' :: Float
xDistance'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
xDistance'
    CFloat
yDistance' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
yDistance
    let yDistance'' :: Float
yDistance'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
yDistance'
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
a
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
b
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
xDistance
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
yDistance
    (Float, Float, Float) -> IO (Float, Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
result', Float
xDistance'', Float
yDistance'')

#if defined(ENABLE_OVERLOADING)
data PointDistanceMethodInfo
instance (signature ~ (Point -> m ((Float, Float, Float))), MonadIO m) => O.OverloadedMethod PointDistanceMethodInfo Point signature where
    overloadedMethod = pointDistance

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


#endif

-- method Point::equals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first #ClutterPoint to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second #ClutterPoint to compare"
--                 , 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_point_equals" clutter_point_equals :: 
    Ptr Point ->                            -- a : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Point ->                            -- b : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO CInt

-- | Compares two t'GI.Clutter.Structs.Point.Point' for equality.
-- 
-- /Since: 1.12/
pointEquals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@a@/: the first t'GI.Clutter.Structs.Point.Point' to compare
    -> Point
    -- ^ /@b@/: the second t'GI.Clutter.Structs.Point.Point' to compare
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the @/ClutterPoints/@ are equal
pointEquals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Point -> Point -> m Bool
pointEquals Point
a Point
b = 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 Point
a' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
a
    Ptr Point
b' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
b
    CInt
result <- Ptr Point -> Ptr Point -> IO CInt
clutter_point_equals Ptr Point
a' Ptr Point
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
a
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PointEqualsMethodInfo
instance (signature ~ (Point -> m Bool), MonadIO m) => O.OverloadedMethod PointEqualsMethodInfo Point signature where
    overloadedMethod = pointEquals

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


#endif

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

foreign import ccall "clutter_point_free" clutter_point_free :: 
    Ptr Point ->                            -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO ()

-- | Frees the resources allocated for /@point@/.
-- 
-- /Since: 1.12/
pointFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point
    -- ^ /@point@/: a t'GI.Clutter.Structs.Point.Point'
    -> m ()
pointFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Point -> m ()
pointFree Point
point = 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 Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Point -> IO ()
clutter_point_free Ptr Point
point'
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PointFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PointFreeMethodInfo Point signature where
    overloadedMethod = pointFree

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


#endif

-- method Point::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , 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 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 "the Y coordinate of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Point" })
-- throws : False
-- Skip return : False

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

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

#if defined(ENABLE_OVERLOADING)
data PointInitMethodInfo
instance (signature ~ (Float -> Float -> m Point), MonadIO m) => O.OverloadedMethod PointInitMethodInfo Point signature where
    overloadedMethod = pointInit

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


#endif

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

foreign import ccall "clutter_point_zero" clutter_point_zero :: 
    IO (Ptr Point)

-- | A point centered at (0, 0).
-- 
-- The returned value can be used as a guard.
-- 
-- /Since: 1.12/
pointZero ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Point
    -- ^ __Returns:__ a point centered in (0, 0); the returned t'GI.Clutter.Structs.Point.Point'
    --   is owned by Clutter and it should not be modified or freed.
pointZero :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Point
pointZero  = IO Point -> m Point
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point
result <- IO (Ptr Point)
clutter_point_zero
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pointZero" Ptr Point
result
    Point
result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point -> Point
Point) Ptr Point
result
    Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePointMethod (t :: Symbol) (o :: *) :: * where
    ResolvePointMethod "copy" o = PointCopyMethodInfo
    ResolvePointMethod "distance" o = PointDistanceMethodInfo
    ResolvePointMethod "equals" o = PointEqualsMethodInfo
    ResolvePointMethod "free" o = PointFreeMethodInfo
    ResolvePointMethod "init" o = PointInitMethodInfo
    ResolvePointMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif