{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A 4 vertex quadrilateral, as represented by four t'GI.Graphene.Structs.Point.Point'.
-- 
-- The contents of a t'GI.Graphene.Structs.Quad.Quad' are private and should never be
-- accessed directly.
-- 
-- /Since: 1.0/

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

module GI.Graphene.Structs.Quad
    ( 

-- * Exported types
    Quad(..)                                ,
    newZeroQuad                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bounds]("GI.Graphene.Structs.Quad#g:method:bounds"), [contains]("GI.Graphene.Structs.Quad#g:method:contains"), [free]("GI.Graphene.Structs.Quad#g:method:free"), [init]("GI.Graphene.Structs.Quad#g:method:init"), [initFromPoints]("GI.Graphene.Structs.Quad#g:method:initFromPoints"), [initFromRect]("GI.Graphene.Structs.Quad#g:method:initFromRect").
-- 
-- ==== Getters
-- [getPoint]("GI.Graphene.Structs.Quad#g:method:getPoint").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveQuadMethod                       ,
#endif

-- ** alloc #method:alloc#

    quadAlloc                               ,


-- ** bounds #method:bounds#

#if defined(ENABLE_OVERLOADING)
    QuadBoundsMethodInfo                    ,
#endif
    quadBounds                              ,


-- ** contains #method:contains#

#if defined(ENABLE_OVERLOADING)
    QuadContainsMethodInfo                  ,
#endif
    quadContains                            ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    QuadFreeMethodInfo                      ,
#endif
    quadFree                                ,


-- ** getPoint #method:getPoint#

#if defined(ENABLE_OVERLOADING)
    QuadGetPointMethodInfo                  ,
#endif
    quadGetPoint                            ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    QuadInitMethodInfo                      ,
#endif
    quadInit                                ,


-- ** initFromPoints #method:initFromPoints#

#if defined(ENABLE_OVERLOADING)
    QuadInitFromPointsMethodInfo            ,
#endif
    quadInitFromPoints                      ,


-- ** initFromRect #method:initFromRect#

#if defined(ENABLE_OVERLOADING)
    QuadInitFromRectMethodInfo              ,
#endif
    quadInitFromRect                        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Graphene.Structs.Point as Graphene.Point
import {-# SOURCE #-} qualified GI.Graphene.Structs.Rect as Graphene.Rect

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

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

foreign import ccall "graphene_quad_get_type" c_graphene_quad_get_type :: 
    IO GType

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

instance B.Types.TypedObject Quad where
    glibType :: IO GType
glibType = IO GType
c_graphene_quad_get_type

instance B.Types.GBoxed Quad

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

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

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



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Quad
type instance O.AttributeList Quad = QuadAttributeList
type QuadAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "graphene_quad_alloc" graphene_quad_alloc :: 
    IO (Ptr Quad)

-- | Allocates a new t'GI.Graphene.Structs.Quad.Quad' instance.
-- 
-- The contents of the returned instance are undefined.
-- 
-- /Since: 1.0/
quadAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Quad
    -- ^ __Returns:__ the newly created t'GI.Graphene.Structs.Quad.Quad' instance
quadAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Quad
quadAlloc  = IO Quad -> m Quad
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Quad -> m Quad) -> IO Quad -> m Quad
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
result <- IO (Ptr Quad)
graphene_quad_alloc
    Text -> Ptr Quad -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"quadAlloc" Ptr Quad
result
    Quad
result' <- ((ManagedPtr Quad -> Quad) -> Ptr Quad -> IO Quad
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Quad -> Quad
Quad) Ptr Quad
result
    Quad -> IO Quad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Quad
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Quad::bounds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_quad_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #graphene_rect_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_quad_bounds" graphene_quad_bounds :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Ptr Graphene.Rect.Rect ->               -- r : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO ()

-- | Computes the bounding rectangle of /@q@/ and places it into /@r@/.
-- 
-- /Since: 1.0/
quadBounds ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: a t'GI.Graphene.Structs.Quad.Quad'
    -> m (Graphene.Rect.Rect)
quadBounds :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Quad -> m Rect
quadBounds Quad
q = IO Rect -> m Rect
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rect -> m Rect) -> IO Rect -> m Rect
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Rect
r <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Rect.Rect)
    Ptr Quad -> Ptr Rect -> IO ()
graphene_quad_bounds Ptr Quad
q' Ptr Rect
r
    Rect
r' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Graphene.Rect.Rect) Ptr Rect
r
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    Rect -> IO Rect
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rect
r'

#if defined(ENABLE_OVERLOADING)
data QuadBoundsMethodInfo
instance (signature ~ (m (Graphene.Rect.Rect)), MonadIO m) => O.OverloadedMethod QuadBoundsMethodInfo Quad signature where
    overloadedMethod = quadBounds

instance O.OverloadedMethodInfo QuadBoundsMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadBounds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadBounds"
        })


#endif

-- method Quad::contains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_quad_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point_t"
--                 , 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 "graphene_quad_contains" graphene_quad_contains :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Ptr Graphene.Point.Point ->             -- p : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO CInt

-- | Checks if the given t'GI.Graphene.Structs.Quad.Quad' contains the given t'GI.Graphene.Structs.Point.Point'.
-- 
-- /Since: 1.0/
quadContains ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: a t'GI.Graphene.Structs.Quad.Quad'
    -> Graphene.Point.Point
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point.Point'
    -> m Bool
    -- ^ __Returns:__ @true@ if the point is inside the t'GI.Graphene.Structs.Quad.Quad'
quadContains :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Quad -> Point -> m Bool
quadContains Quad
q Point
p = IO Bool -> m Bool
forall a. IO a -> m a
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 Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Point
p' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
p
    CInt
result <- Ptr Quad -> Ptr Point -> IO CInt
graphene_quad_contains Ptr Quad
q' Ptr Point
p'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
p
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data QuadContainsMethodInfo
instance (signature ~ (Graphene.Point.Point -> m Bool), MonadIO m) => O.OverloadedMethod QuadContainsMethodInfo Quad signature where
    overloadedMethod = quadContains

instance O.OverloadedMethodInfo QuadContainsMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadContains",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadContains"
        })


#endif

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

foreign import ccall "graphene_quad_free" graphene_quad_free :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    IO ()

-- | Frees the resources allocated by 'GI.Graphene.Structs.Quad.quadAlloc'
-- 
-- /Since: 1.0/
quadFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: a t'GI.Graphene.Structs.Quad.Quad'
    -> m ()
quadFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Quad -> m ()
quadFree Quad
q = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Quad -> IO ()
graphene_quad_free Ptr Quad
q'
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuadFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod QuadFreeMethodInfo Quad signature where
    overloadedMethod = quadFree

instance O.OverloadedMethodInfo QuadFreeMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadFree"
        })


#endif

-- method Quad::get_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_quad_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the point to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Point" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_quad_get_point" graphene_quad_get_point :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr Graphene.Point.Point)

-- | Retrieves the point of a t'GI.Graphene.Structs.Quad.Quad' at the given index.
-- 
-- /Since: 1.0/
quadGetPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: a t'GI.Graphene.Structs.Quad.Quad'
    -> Word32
    -- ^ /@index_@/: the index of the point to retrieve
    -> m Graphene.Point.Point
    -- ^ __Returns:__ a t'GI.Graphene.Structs.Point.Point'
quadGetPoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Quad -> Word32 -> m Point
quadGetPoint Quad
q Word32
index_ = IO Point -> m Point
forall a. IO a -> m a
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 Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Point
result <- Ptr Quad -> Word32 -> IO (Ptr Point)
graphene_quad_get_point Ptr Quad
q' Word32
index_
    Text -> Ptr Point -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"quadGetPoint" 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
Graphene.Point.Point) Ptr Point
result
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
result'

#if defined(ENABLE_OVERLOADING)
data QuadGetPointMethodInfo
instance (signature ~ (Word32 -> m Graphene.Point.Point), MonadIO m) => O.OverloadedMethod QuadGetPointMethodInfo Quad signature where
    overloadedMethod = quadGetPoint

instance O.OverloadedMethodInfo QuadGetPointMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadGetPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadGetPoint"
        })


#endif

-- method Quad::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #graphene_quad_t to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p1"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first point of the quadrilateral"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p2"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second point of the quadrilateral"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p3"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the third point of the quadrilateral"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "p4"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the fourth point of the quadrilateral"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Quad" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_quad_init" graphene_quad_init :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Ptr Graphene.Point.Point ->             -- p1 : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Graphene.Point.Point ->             -- p2 : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Graphene.Point.Point ->             -- p3 : TInterface (Name {namespace = "Graphene", name = "Point"})
    Ptr Graphene.Point.Point ->             -- p4 : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO (Ptr Quad)

-- | Initializes a t'GI.Graphene.Structs.Quad.Quad' with the given points.
-- 
-- /Since: 1.0/
quadInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: the t'GI.Graphene.Structs.Quad.Quad' to initialize
    -> Graphene.Point.Point
    -- ^ /@p1@/: the first point of the quadrilateral
    -> Graphene.Point.Point
    -- ^ /@p2@/: the second point of the quadrilateral
    -> Graphene.Point.Point
    -- ^ /@p3@/: the third point of the quadrilateral
    -> Graphene.Point.Point
    -- ^ /@p4@/: the fourth point of the quadrilateral
    -> m Quad
    -- ^ __Returns:__ the initialized t'GI.Graphene.Structs.Quad.Quad'
quadInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Quad -> Point -> Point -> Point -> Point -> m Quad
quadInit Quad
q Point
p1 Point
p2 Point
p3 Point
p4 = IO Quad -> m Quad
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Quad -> m Quad) -> IO Quad -> m Quad
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Point
p1' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
p1
    Ptr Point
p2' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
p2
    Ptr Point
p3' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
p3
    Ptr Point
p4' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
p4
    Ptr Quad
result <- Ptr Quad
-> Ptr Point
-> Ptr Point
-> Ptr Point
-> Ptr Point
-> IO (Ptr Quad)
graphene_quad_init Ptr Quad
q' Ptr Point
p1' Ptr Point
p2' Ptr Point
p3' Ptr Point
p4'
    Text -> Ptr Quad -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"quadInit" Ptr Quad
result
    Quad
result' <- ((ManagedPtr Quad -> Quad) -> Ptr Quad -> IO Quad
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Quad -> Quad
Quad) Ptr Quad
result
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
p1
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
p2
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
p3
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
p4
    Quad -> IO Quad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Quad
result'

#if defined(ENABLE_OVERLOADING)
data QuadInitMethodInfo
instance (signature ~ (Graphene.Point.Point -> Graphene.Point.Point -> Graphene.Point.Point -> Graphene.Point.Point -> m Quad), MonadIO m) => O.OverloadedMethod QuadInitMethodInfo Quad signature where
    overloadedMethod = quadInit

instance O.OverloadedMethodInfo QuadInitMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadInit"
        })


#endif

-- method Quad::init_from_points
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #graphene_quad_t to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "points"
--           , argType =
--               TCArray
--                 False
--                 4
--                 (-1)
--                 (TInterface Name { namespace = "Graphene" , name = "Point" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of 4 #graphene_point_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Quad" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_quad_init_from_points" graphene_quad_init_from_points :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Ptr Graphene.Point.Point ->             -- points : TCArray False 4 (-1) (TInterface (Name {namespace = "Graphene", name = "Point"}))
    IO (Ptr Quad)

-- | Initializes a t'GI.Graphene.Structs.Quad.Quad' using an array of points.
-- 
-- /Since: 1.2/
quadInitFromPoints ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: the t'GI.Graphene.Structs.Quad.Quad' to initialize
    -> [Graphene.Point.Point]
    -- ^ /@points@/: an array of 4 t'GI.Graphene.Structs.Point.Point'
    -> m Quad
    -- ^ __Returns:__ the initialized t'GI.Graphene.Structs.Quad.Quad'
quadInitFromPoints :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Quad -> [Point] -> m Quad
quadInitFromPoints Quad
q [Point]
points = IO Quad -> m Quad
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Quad -> m Quad) -> IO Quad -> m Quad
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    [Ptr Point]
points' <- (Point -> IO (Ptr Point)) -> [Point] -> IO [Ptr Point]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Point]
points
    Ptr Point
points'' <- Int -> [Ptr Point] -> IO (Ptr Point)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
8 [Ptr Point]
points'
    Ptr Quad
result <- Ptr Quad -> Ptr Point -> IO (Ptr Quad)
graphene_quad_init_from_points Ptr Quad
q' Ptr Point
points''
    Text -> Ptr Quad -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"quadInitFromPoints" Ptr Quad
result
    Quad
result' <- ((ManagedPtr Quad -> Quad) -> Ptr Quad -> IO Quad
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Quad -> Quad
Quad) Ptr Quad
result
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    (Point -> IO ()) -> [Point] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Point]
points
    Ptr Point -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Point
points''
    Quad -> IO Quad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Quad
result'

#if defined(ENABLE_OVERLOADING)
data QuadInitFromPointsMethodInfo
instance (signature ~ ([Graphene.Point.Point] -> m Quad), MonadIO m) => O.OverloadedMethod QuadInitFromPointsMethodInfo Quad signature where
    overloadedMethod = quadInitFromPoints

instance O.OverloadedMethodInfo QuadInitFromPointsMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadInitFromPoints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadInitFromPoints"
        })


#endif

-- method Quad::init_from_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "q"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Quad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #graphene_quad_t to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_rect_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Quad" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_quad_init_from_rect" graphene_quad_init_from_rect :: 
    Ptr Quad ->                             -- q : TInterface (Name {namespace = "Graphene", name = "Quad"})
    Ptr Graphene.Rect.Rect ->               -- r : TInterface (Name {namespace = "Graphene", name = "Rect"})
    IO (Ptr Quad)

-- | Initializes a t'GI.Graphene.Structs.Quad.Quad' using the four corners of the
-- given t'GI.Graphene.Structs.Rect.Rect'.
-- 
-- /Since: 1.0/
quadInitFromRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Quad
    -- ^ /@q@/: the t'GI.Graphene.Structs.Quad.Quad' to initialize
    -> Graphene.Rect.Rect
    -- ^ /@r@/: a t'GI.Graphene.Structs.Rect.Rect'
    -> m Quad
    -- ^ __Returns:__ the initialized t'GI.Graphene.Structs.Quad.Quad'
quadInitFromRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Quad -> Rect -> m Quad
quadInitFromRect Quad
q Rect
r = IO Quad -> m Quad
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Quad -> m Quad) -> IO Quad -> m Quad
forall a b. (a -> b) -> a -> b
$ do
    Ptr Quad
q' <- Quad -> IO (Ptr Quad)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Quad
q
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Quad
result <- Ptr Quad -> Ptr Rect -> IO (Ptr Quad)
graphene_quad_init_from_rect Ptr Quad
q' Ptr Rect
r'
    Text -> Ptr Quad -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"quadInitFromRect" Ptr Quad
result
    Quad
result' <- ((ManagedPtr Quad -> Quad) -> Ptr Quad -> IO Quad
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Quad -> Quad
Quad) Ptr Quad
result
    Quad -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Quad
q
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Quad -> IO Quad
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Quad
result'

#if defined(ENABLE_OVERLOADING)
data QuadInitFromRectMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> m Quad), MonadIO m) => O.OverloadedMethod QuadInitFromRectMethodInfo Quad signature where
    overloadedMethod = quadInitFromRect

instance O.OverloadedMethodInfo QuadInitFromRectMethodInfo Quad where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Quad.quadInitFromRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.7/docs/GI-Graphene-Structs-Quad.html#v:quadInitFromRect"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveQuadMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveQuadMethod "bounds" o = QuadBoundsMethodInfo
    ResolveQuadMethod "contains" o = QuadContainsMethodInfo
    ResolveQuadMethod "free" o = QuadFreeMethodInfo
    ResolveQuadMethod "init" o = QuadInitMethodInfo
    ResolveQuadMethod "initFromPoints" o = QuadInitFromPointsMethodInfo
    ResolveQuadMethod "initFromRect" o = QuadInitFromRectMethodInfo
    ResolveQuadMethod "getPoint" o = QuadGetPointMethodInfo
    ResolveQuadMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif