{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GskPathPoint@ is an opaque type representing a point on a path.
-- 
-- It can be queried for properties of the path at that point, such as
-- its tangent or its curvature.
-- 
-- To obtain a @GskPathPoint@, use 'GI.Gsk.Structs.Path.pathGetClosestPoint',
-- 'GI.Gsk.Structs.Path.pathGetStartPoint', 'GI.Gsk.Structs.Path.pathGetEndPoint'
-- or 'GI.Gsk.Structs.PathMeasure.pathMeasureGetPoint'.
-- 
-- Note that @GskPathPoint@ structs are meant to be stack-allocated,
-- and don\'t hold a reference to the path object they are obtained from.
-- It is the callers responsibility to keep a reference to the path
-- as long as the @GskPathPoint@ is used.
-- 
-- /Since: 4.14/

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

module GI.Gsk.Structs.PathPoint
    ( 

-- * Exported types
    PathPoint(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [compare]("GI.Gsk.Structs.PathPoint#g:method:compare"), [copy]("GI.Gsk.Structs.PathPoint#g:method:copy"), [equal]("GI.Gsk.Structs.PathPoint#g:method:equal"), [free]("GI.Gsk.Structs.PathPoint#g:method:free").
-- 
-- ==== Getters
-- [getCurvature]("GI.Gsk.Structs.PathPoint#g:method:getCurvature"), [getDistance]("GI.Gsk.Structs.PathPoint#g:method:getDistance"), [getPosition]("GI.Gsk.Structs.PathPoint#g:method:getPosition"), [getRotation]("GI.Gsk.Structs.PathPoint#g:method:getRotation"), [getTangent]("GI.Gsk.Structs.PathPoint#g:method:getTangent").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolvePathPointMethod                  ,
#endif

-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    PathPointCompareMethodInfo              ,
#endif
    pathPointCompare                        ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PathPointCopyMethodInfo                 ,
#endif
    pathPointCopy                           ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    PathPointEqualMethodInfo                ,
#endif
    pathPointEqual                          ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PathPointFreeMethodInfo                 ,
#endif
    pathPointFree                           ,


-- ** getCurvature #method:getCurvature#

#if defined(ENABLE_OVERLOADING)
    PathPointGetCurvatureMethodInfo         ,
#endif
    pathPointGetCurvature                   ,


-- ** getDistance #method:getDistance#

#if defined(ENABLE_OVERLOADING)
    PathPointGetDistanceMethodInfo          ,
#endif
    pathPointGetDistance                    ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    PathPointGetPositionMethodInfo          ,
#endif
    pathPointGetPosition                    ,


-- ** getRotation #method:getRotation#

#if defined(ENABLE_OVERLOADING)
    PathPointGetRotationMethodInfo          ,
#endif
    pathPointGetRotation                    ,


-- ** getTangent #method:getTangent#

#if defined(ENABLE_OVERLOADING)
    PathPointGetTangentMethodInfo           ,
#endif
    pathPointGetTangent                     ,




    ) 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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Vec2 as Graphene.Vec2
import qualified GI.Gsk.Callbacks as Gsk.Callbacks
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums
import {-# SOURCE #-} qualified GI.Gsk.Flags as Gsk.Flags
import {-# SOURCE #-} qualified GI.Gsk.Structs.Path as Gsk.Path
import {-# SOURCE #-} qualified GI.Gsk.Structs.PathMeasure as Gsk.PathMeasure
import {-# SOURCE #-} qualified GI.Gsk.Structs.Stroke as Gsk.Stroke

#else
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Vec2 as Graphene.Vec2
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums
import {-# SOURCE #-} qualified GI.Gsk.Structs.Path as Gsk.Path
import {-# SOURCE #-} qualified GI.Gsk.Structs.PathMeasure as Gsk.PathMeasure

#endif

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

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

foreign import ccall "gsk_path_point_get_type" c_gsk_path_point_get_type :: 
    IO GType

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

instance B.Types.TypedObject PathPoint where
    glibType :: IO GType
glibType = IO GType
c_gsk_path_point_get_type

instance B.Types.GBoxed PathPoint

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


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

-- method PathPoint::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point1"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point2"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GskPathPoint`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_compare" gsk_path_point_compare :: 
    Ptr PathPoint ->                        -- point1 : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr PathPoint ->                        -- point2 : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    IO Int32

-- | Returns whether /@point1@/ is before or after /@point2@/.
-- 
-- /Since: 4.14/
pathPointCompare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point1@/: a @GskPathPoint@
    -> PathPoint
    -- ^ /@point2@/: another @GskPathPoint@
    -> m Int32
    -- ^ __Returns:__ -1 if /@point1@/ is before /@point2@/,
    --   1 if /@point1@/ is after /@point2@/,
    --   0 if they are equal
pathPointCompare :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> PathPoint -> m Int32
pathPointCompare PathPoint
point1 PathPoint
point2 = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point1' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point1
    Ptr PathPoint
point2' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point2
    Int32
result <- Ptr PathPoint -> Ptr PathPoint -> IO Int32
gsk_path_point_compare Ptr PathPoint
point1' Ptr PathPoint
point2'
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point1
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point2
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PathPointCompareMethodInfo
instance (signature ~ (PathPoint -> m Int32), MonadIO m) => O.OverloadedMethod PathPointCompareMethodInfo PathPoint signature where
    overloadedMethod = pathPointCompare

instance O.OverloadedMethodInfo PathPointCompareMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointCompare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointCompare"
        })


#endif

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

foreign import ccall "gsk_path_point_copy" gsk_path_point_copy :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    IO (Ptr PathPoint)

-- | /No description available in the introspection data./
pathPointCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -> m PathPoint
pathPointCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> m PathPoint
pathPointCopy PathPoint
point = IO PathPoint -> m PathPoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PathPoint -> m PathPoint) -> IO PathPoint -> m PathPoint
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr PathPoint
result <- Ptr PathPoint -> IO (Ptr PathPoint)
gsk_path_point_copy Ptr PathPoint
point'
    Text -> Ptr PathPoint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathPointCopy" Ptr PathPoint
result
    PathPoint
result' <- ((ManagedPtr PathPoint -> PathPoint)
-> Ptr PathPoint -> IO PathPoint
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PathPoint -> PathPoint
PathPoint) Ptr PathPoint
result
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    PathPoint -> IO PathPoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PathPoint
result'

#if defined(ENABLE_OVERLOADING)
data PathPointCopyMethodInfo
instance (signature ~ (m PathPoint), MonadIO m) => O.OverloadedMethod PathPointCopyMethodInfo PathPoint signature where
    overloadedMethod = pathPointCopy

instance O.OverloadedMethodInfo PathPointCopyMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointCopy"
        })


#endif

-- method PathPoint::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point1"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point2"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GskPathPoint`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_equal" gsk_path_point_equal :: 
    Ptr PathPoint ->                        -- point1 : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr PathPoint ->                        -- point2 : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    IO CInt

-- | Returns whether the two path points refer to the same
-- location on all paths.
-- 
-- Note that the start- and endpoint of a closed contour
-- will compare nonequal according to this definition.
-- Use 'GI.Gsk.Structs.Path.pathIsClosed' to find out if the
-- start- and endpoint of a concrete path refer to the
-- same location.
-- 
-- /Since: 4.14/
pathPointEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point1@/: a @GskPathPoint@
    -> PathPoint
    -- ^ /@point2@/: another @GskPathPoint@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@point1@/ and /@point2@/ are equal
pathPointEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> PathPoint -> m Bool
pathPointEqual PathPoint
point1 PathPoint
point2 = 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 PathPoint
point1' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point1
    Ptr PathPoint
point2' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point2
    CInt
result <- Ptr PathPoint -> Ptr PathPoint -> IO CInt
gsk_path_point_equal Ptr PathPoint
point1' Ptr PathPoint
point2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point1
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point2
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathPointEqualMethodInfo
instance (signature ~ (PathPoint -> m Bool), MonadIO m) => O.OverloadedMethod PathPointEqualMethodInfo PathPoint signature where
    overloadedMethod = pathPointEqual

instance O.OverloadedMethodInfo PathPointEqualMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointEqual"
        })


#endif

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

foreign import ccall "gsk_path_point_free" gsk_path_point_free :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    IO ()

-- | /No description available in the introspection data./
pathPointFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -> m ()
pathPointFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> m ()
pathPointFree PathPoint
point = 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 PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr PathPoint -> IO ()
gsk_path_point_free Ptr PathPoint
point'
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathPointFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PathPointFreeMethodInfo PathPoint signature where
    overloadedMethod = pathPointFree

instance O.OverloadedMethodInfo PathPointFreeMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointFree"
        })


#endif

-- method PathPoint::get_curvature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path that @point is on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the direction for which to return the curvature"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Return location for\n  the center of the osculating circle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_get_curvature" gsk_path_point_get_curvature :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr Gsk.Path.Path ->                    -- path : TInterface (Name {namespace = "Gsk", name = "Path"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gsk", name = "PathDirection"})
    Ptr Graphene.Point.Point ->             -- center : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO CFloat

-- | Calculates the curvature of the path at the point.
-- 
-- Optionally, returns the center of the osculating circle as well.
-- The curvature is the inverse of the radius of the osculating circle.
-- 
-- Lines have a curvature of zero (indicating an osculating circle of
-- infinite radius. In this case, the /@center@/ is not modified.
-- 
-- Circles with a radius of zero have @INFINITY@ as curvature
-- 
-- Note that certain points on a path may not have a single curvature,
-- such as sharp turns. At such points, there are two curvatures --
-- the (limit of) the curvature of the path going into the point,
-- and the (limit of) the curvature of the path coming out of it.
-- The /@direction@/ argument lets you choose which one to get.
-- 
-- \<picture>
--   \<source srcset=\"curvature-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img alt=\"Osculating circle\" src=\"curvature-light.png\">
-- \<\/picture>
-- 
-- /Since: 4.14/
pathPointGetCurvature ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point@/: a @GskPathPoint@
    -> Gsk.Path.Path
    -- ^ /@path@/: the path that /@point@/ is on
    -> Gsk.Enums.PathDirection
    -- ^ /@direction@/: the direction for which to return the curvature
    -> m ((Float, Maybe Graphene.Point.Point))
    -- ^ __Returns:__ The curvature of the path at the given point
pathPointGetCurvature :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> Path -> PathDirection -> m (Float, Maybe Point)
pathPointGetCurvature PathPoint
point Path
path PathDirection
direction = IO (Float, Maybe Point) -> m (Float, Maybe Point)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Maybe Point) -> m (Float, Maybe Point))
-> IO (Float, Maybe Point) -> m (Float, Maybe Point)
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr Path
path' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
path
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PathDirection -> Int) -> PathDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathDirection -> Int
forall a. Enum a => a -> Int
fromEnum) PathDirection
direction
    Ptr Point
center <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Graphene.Point.Point)
    CFloat
result <- Ptr PathPoint -> Ptr Path -> CUInt -> Ptr Point -> IO CFloat
gsk_path_point_get_curvature Ptr PathPoint
point' Ptr Path
path' CUInt
direction' Ptr Point
center
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Maybe Point
maybeCenter <- Ptr Point -> (Ptr Point -> IO Point) -> IO (Maybe Point)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Point
center ((Ptr Point -> IO Point) -> IO (Maybe Point))
-> (Ptr Point -> IO Point) -> IO (Maybe Point)
forall a b. (a -> b) -> a -> b
$ \Ptr Point
center' -> do
        Point
center'' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Graphene.Point.Point) Ptr Point
center'
        Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
center''
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
path
    (Float, Maybe Point) -> IO (Float, Maybe Point)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
result', Maybe Point
maybeCenter)

#if defined(ENABLE_OVERLOADING)
data PathPointGetCurvatureMethodInfo
instance (signature ~ (Gsk.Path.Path -> Gsk.Enums.PathDirection -> m ((Float, Maybe Graphene.Point.Point))), MonadIO m) => O.OverloadedMethod PathPointGetCurvatureMethodInfo PathPoint signature where
    overloadedMethod = pathPointGetCurvature

instance O.OverloadedMethodInfo PathPointGetCurvatureMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointGetCurvature",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointGetCurvature"
        })


#endif

-- method PathPoint::get_distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint on the path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "measure"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathMeasure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathMeasure` for the path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_get_distance" gsk_path_point_get_distance :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr Gsk.PathMeasure.PathMeasure ->      -- measure : TInterface (Name {namespace = "Gsk", name = "PathMeasure"})
    IO CFloat

-- | Returns the distance from the beginning of the path
-- to /@point@/.
-- 
-- /Since: 4.14/
pathPointGetDistance ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point@/: a \`GskPathPoint on the path
    -> Gsk.PathMeasure.PathMeasure
    -- ^ /@measure@/: a @GskPathMeasure@ for the path
    -> m Float
    -- ^ __Returns:__ the distance of /@point@/
pathPointGetDistance :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> PathMeasure -> m Float
pathPointGetDistance PathPoint
point PathMeasure
measure = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr PathMeasure
measure' <- PathMeasure -> IO (Ptr PathMeasure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathMeasure
measure
    CFloat
result <- Ptr PathPoint -> Ptr PathMeasure -> IO CFloat
gsk_path_point_get_distance Ptr PathPoint
point' Ptr PathMeasure
measure'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    PathMeasure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathMeasure
measure
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data PathPointGetDistanceMethodInfo
instance (signature ~ (Gsk.PathMeasure.PathMeasure -> m Float), MonadIO m) => O.OverloadedMethod PathPointGetDistanceMethodInfo PathPoint signature where
    overloadedMethod = pathPointGetDistance

instance O.OverloadedMethodInfo PathPointGetDistanceMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointGetDistance",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointGetDistance"
        })


#endif

-- method PathPoint::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path that @point is on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Return location for\n  the coordinates of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_get_position" gsk_path_point_get_position :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr Gsk.Path.Path ->                    -- path : TInterface (Name {namespace = "Gsk", name = "Path"})
    Ptr Graphene.Point.Point ->             -- position : TInterface (Name {namespace = "Graphene", name = "Point"})
    IO ()

-- | Gets the position of the point.
-- 
-- /Since: 4.14/
pathPointGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point@/: a @GskPathPoint@
    -> Gsk.Path.Path
    -- ^ /@path@/: the path that /@point@/ is on
    -> m (Graphene.Point.Point)
pathPointGetPosition :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> Path -> m Point
pathPointGetPosition PathPoint
point Path
path = 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 PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr Path
path' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
path
    Ptr Point
position <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Graphene.Point.Point)
    Ptr PathPoint -> Ptr Path -> Ptr Point -> IO ()
gsk_path_point_get_position Ptr PathPoint
point' Ptr Path
path' Ptr Point
position
    Point
position' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Graphene.Point.Point) Ptr Point
position
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
path
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
position'

#if defined(ENABLE_OVERLOADING)
data PathPointGetPositionMethodInfo
instance (signature ~ (Gsk.Path.Path -> m (Graphene.Point.Point)), MonadIO m) => O.OverloadedMethod PathPointGetPositionMethodInfo PathPoint signature where
    overloadedMethod = pathPointGetPosition

instance O.OverloadedMethodInfo PathPointGetPositionMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointGetPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointGetPosition"
        })


#endif

-- method PathPoint::get_rotation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path that @point is on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the direction for which to return the rotation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_get_rotation" gsk_path_point_get_rotation :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr Gsk.Path.Path ->                    -- path : TInterface (Name {namespace = "Gsk", name = "Path"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gsk", name = "PathDirection"})
    IO CFloat

-- | Gets the direction of the tangent at a given point.
-- 
-- This is a convenience variant of 'GI.Gsk.Structs.PathPoint.pathPointGetTangent'
-- that returns the angle between the tangent and the X axis. The angle
-- can e.g. be used in
-- <http://developer.gnome.org/gsk/stable/../gtk4/method.Snapshot.rotate.html gtk_snapshot_rotate()>.
-- 
-- /Since: 4.14/
pathPointGetRotation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point@/: a @GskPathPoint@
    -> Gsk.Path.Path
    -- ^ /@path@/: the path that /@point@/ is on
    -> Gsk.Enums.PathDirection
    -- ^ /@direction@/: the direction for which to return the rotation
    -> m Float
    -- ^ __Returns:__ the angle between the tangent and the X axis, in degrees
pathPointGetRotation :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> Path -> PathDirection -> m Float
pathPointGetRotation PathPoint
point Path
path PathDirection
direction = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr Path
path' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
path
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PathDirection -> Int) -> PathDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathDirection -> Int
forall a. Enum a => a -> Int
fromEnum) PathDirection
direction
    CFloat
result <- Ptr PathPoint -> Ptr Path -> CUInt -> IO CFloat
gsk_path_point_get_rotation Ptr PathPoint
point' Ptr Path
path' CUInt
direction'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
path
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data PathPointGetRotationMethodInfo
instance (signature ~ (Gsk.Path.Path -> Gsk.Enums.PathDirection -> m Float), MonadIO m) => O.OverloadedMethod PathPointGetRotationMethodInfo PathPoint signature where
    overloadedMethod = pathPointGetRotation

instance O.OverloadedMethodInfo PathPointGetRotationMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointGetRotation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointGetRotation"
        })


#endif

-- method PathPoint::get_tangent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskPathPoint`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path that @point is on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "PathDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the direction for which to return the tangent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tangent"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec2" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Return location for\n  the tangent at the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_path_point_get_tangent" gsk_path_point_get_tangent :: 
    Ptr PathPoint ->                        -- point : TInterface (Name {namespace = "Gsk", name = "PathPoint"})
    Ptr Gsk.Path.Path ->                    -- path : TInterface (Name {namespace = "Gsk", name = "Path"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gsk", name = "PathDirection"})
    Ptr Graphene.Vec2.Vec2 ->               -- tangent : TInterface (Name {namespace = "Graphene", name = "Vec2"})
    IO ()

-- | Gets the tangent of the path at the point.
-- 
-- Note that certain points on a path may not have a single
-- tangent, such as sharp turns. At such points, there are
-- two tangents -- the direction of the path going into the
-- point, and the direction coming out of it. The /@direction@/
-- argument lets you choose which one to get.
-- 
-- If the path is just a single point (e.g. a circle with
-- radius zero), then /@tangent@/ is set to @0, 0@.
-- 
-- If you want to orient something in the direction of the
-- path, 'GI.Gsk.Structs.PathPoint.pathPointGetRotation' may be more
-- convenient to use.
-- 
-- /Since: 4.14/
pathPointGetTangent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PathPoint
    -- ^ /@point@/: a @GskPathPoint@
    -> Gsk.Path.Path
    -- ^ /@path@/: the path that /@point@/ is on
    -> Gsk.Enums.PathDirection
    -- ^ /@direction@/: the direction for which to return the tangent
    -> m (Graphene.Vec2.Vec2)
pathPointGetTangent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PathPoint -> Path -> PathDirection -> m Vec2
pathPointGetTangent PathPoint
point Path
path PathDirection
direction = IO Vec2 -> m Vec2
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec2 -> m Vec2) -> IO Vec2 -> m Vec2
forall a b. (a -> b) -> a -> b
$ do
    Ptr PathPoint
point' <- PathPoint -> IO (Ptr PathPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathPoint
point
    Ptr Path
path' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
path
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PathDirection -> Int) -> PathDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathDirection -> Int
forall a. Enum a => a -> Int
fromEnum) PathDirection
direction
    Ptr Vec2
tangent <- Int -> IO (Ptr Vec2)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Vec2.Vec2)
    Ptr PathPoint -> Ptr Path -> CUInt -> Ptr Vec2 -> IO ()
gsk_path_point_get_tangent Ptr PathPoint
point' Ptr Path
path' CUInt
direction' Ptr Vec2
tangent
    Vec2
tangent' <- ((ManagedPtr Vec2 -> Vec2) -> Ptr Vec2 -> IO Vec2
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec2 -> Vec2
Graphene.Vec2.Vec2) Ptr Vec2
tangent
    PathPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathPoint
point
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
path
    Vec2 -> IO Vec2
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vec2
tangent'

#if defined(ENABLE_OVERLOADING)
data PathPointGetTangentMethodInfo
instance (signature ~ (Gsk.Path.Path -> Gsk.Enums.PathDirection -> m (Graphene.Vec2.Vec2)), MonadIO m) => O.OverloadedMethod PathPointGetTangentMethodInfo PathPoint signature where
    overloadedMethod = pathPointGetTangent

instance O.OverloadedMethodInfo PathPointGetTangentMethodInfo PathPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.PathPoint.pathPointGetTangent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathPoint.html#v:pathPointGetTangent"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePathPointMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePathPointMethod "compare" o = PathPointCompareMethodInfo
    ResolvePathPointMethod "copy" o = PathPointCopyMethodInfo
    ResolvePathPointMethod "equal" o = PathPointEqualMethodInfo
    ResolvePathPointMethod "free" o = PathPointFreeMethodInfo
    ResolvePathPointMethod "getCurvature" o = PathPointGetCurvatureMethodInfo
    ResolvePathPointMethod "getDistance" o = PathPointGetDistanceMethodInfo
    ResolvePathPointMethod "getPosition" o = PathPointGetPositionMethodInfo
    ResolvePathPointMethod "getRotation" o = PathPointGetRotationMethodInfo
    ResolvePathPointMethod "getTangent" o = PathPointGetTangentMethodInfo
    ResolvePathPointMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif