{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GskStroke@ struct collects the parameters that influence
-- the operation of stroking a path.
-- 
-- /Since: 4.14/

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

module GI.Gsk.Structs.Stroke
    ( 

-- * Exported types
    Stroke(..)                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gsk.Structs.Stroke#g:method:copy"), [free]("GI.Gsk.Structs.Stroke#g:method:free"), [toCairo]("GI.Gsk.Structs.Stroke#g:method:toCairo").
-- 
-- ==== Getters
-- [getDash]("GI.Gsk.Structs.Stroke#g:method:getDash"), [getDashOffset]("GI.Gsk.Structs.Stroke#g:method:getDashOffset"), [getLineCap]("GI.Gsk.Structs.Stroke#g:method:getLineCap"), [getLineJoin]("GI.Gsk.Structs.Stroke#g:method:getLineJoin"), [getLineWidth]("GI.Gsk.Structs.Stroke#g:method:getLineWidth"), [getMiterLimit]("GI.Gsk.Structs.Stroke#g:method:getMiterLimit").
-- 
-- ==== Setters
-- [setDash]("GI.Gsk.Structs.Stroke#g:method:setDash"), [setDashOffset]("GI.Gsk.Structs.Stroke#g:method:setDashOffset"), [setLineCap]("GI.Gsk.Structs.Stroke#g:method:setLineCap"), [setLineJoin]("GI.Gsk.Structs.Stroke#g:method:setLineJoin"), [setLineWidth]("GI.Gsk.Structs.Stroke#g:method:setLineWidth"), [setMiterLimit]("GI.Gsk.Structs.Stroke#g:method:setMiterLimit").

#if defined(ENABLE_OVERLOADING)
    ResolveStrokeMethod                     ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    StrokeCopyMethodInfo                    ,
#endif
    strokeCopy                              ,


-- ** equal #method:equal#

    strokeEqual                             ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    StrokeFreeMethodInfo                    ,
#endif
    strokeFree                              ,


-- ** getDash #method:getDash#

#if defined(ENABLE_OVERLOADING)
    StrokeGetDashMethodInfo                 ,
#endif
    strokeGetDash                           ,


-- ** getDashOffset #method:getDashOffset#

#if defined(ENABLE_OVERLOADING)
    StrokeGetDashOffsetMethodInfo           ,
#endif
    strokeGetDashOffset                     ,


-- ** getLineCap #method:getLineCap#

#if defined(ENABLE_OVERLOADING)
    StrokeGetLineCapMethodInfo              ,
#endif
    strokeGetLineCap                        ,


-- ** getLineJoin #method:getLineJoin#

#if defined(ENABLE_OVERLOADING)
    StrokeGetLineJoinMethodInfo             ,
#endif
    strokeGetLineJoin                       ,


-- ** getLineWidth #method:getLineWidth#

#if defined(ENABLE_OVERLOADING)
    StrokeGetLineWidthMethodInfo            ,
#endif
    strokeGetLineWidth                      ,


-- ** getMiterLimit #method:getMiterLimit#

#if defined(ENABLE_OVERLOADING)
    StrokeGetMiterLimitMethodInfo           ,
#endif
    strokeGetMiterLimit                     ,


-- ** new #method:new#

    strokeNew                               ,


-- ** setDash #method:setDash#

#if defined(ENABLE_OVERLOADING)
    StrokeSetDashMethodInfo                 ,
#endif
    strokeSetDash                           ,


-- ** setDashOffset #method:setDashOffset#

#if defined(ENABLE_OVERLOADING)
    StrokeSetDashOffsetMethodInfo           ,
#endif
    strokeSetDashOffset                     ,


-- ** setLineCap #method:setLineCap#

#if defined(ENABLE_OVERLOADING)
    StrokeSetLineCapMethodInfo              ,
#endif
    strokeSetLineCap                        ,


-- ** setLineJoin #method:setLineJoin#

#if defined(ENABLE_OVERLOADING)
    StrokeSetLineJoinMethodInfo             ,
#endif
    strokeSetLineJoin                       ,


-- ** setLineWidth #method:setLineWidth#

#if defined(ENABLE_OVERLOADING)
    StrokeSetLineWidthMethodInfo            ,
#endif
    strokeSetLineWidth                      ,


-- ** setMiterLimit #method:setMiterLimit#

#if defined(ENABLE_OVERLOADING)
    StrokeSetMiterLimitMethodInfo           ,
#endif
    strokeSetMiterLimit                     ,


-- ** toCairo #method:toCairo#

#if defined(ENABLE_OVERLOADING)
    StrokeToCairoMethodInfo                 ,
#endif
    strokeToCairo                           ,




    ) 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 {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums

#else
import qualified GI.Cairo.Structs.Context as Cairo.Context
import {-# SOURCE #-} qualified GI.Gsk.Enums as Gsk.Enums

#endif

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

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

foreign import ccall "gsk_stroke_get_type" c_gsk_stroke_get_type :: 
    IO GType

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

instance B.Types.TypedObject Stroke where
    glibType :: IO GType
glibType = IO GType
c_gsk_stroke_get_type

instance B.Types.GBoxed Stroke

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


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

-- method Stroke::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "line_width"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "line width of the stroke. Must be > 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "Stroke" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_stroke_new" gsk_stroke_new :: 
    CFloat ->                               -- line_width : TBasicType TFloat
    IO (Ptr Stroke)

-- | Creates a new @GskStroke@ with the given /@lineWidth@/.
-- 
-- /Since: 4.14/
strokeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@lineWidth@/: line width of the stroke. Must be > 0
    -> m Stroke
    -- ^ __Returns:__ a new @GskStroke@
strokeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Float -> m Stroke
strokeNew Float
lineWidth = IO Stroke -> m Stroke
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stroke -> m Stroke) -> IO Stroke -> m Stroke
forall a b. (a -> b) -> a -> b
$ do
    let lineWidth' :: CFloat
lineWidth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
lineWidth
    Ptr Stroke
result <- CFloat -> IO (Ptr Stroke)
gsk_stroke_new CFloat
lineWidth'
    Text -> Ptr Stroke -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"strokeNew" Ptr Stroke
result
    Stroke
result' <- ((ManagedPtr Stroke -> Stroke) -> Ptr Stroke -> IO Stroke
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Stroke -> Stroke
Stroke) Ptr Stroke
result
    Stroke -> IO Stroke
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stroke
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gsk_stroke_copy" gsk_stroke_copy :: 
    Ptr Stroke ->                           -- other : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO (Ptr Stroke)

-- | Creates a copy of the given /@other@/ stroke.
-- 
-- /Since: 4.14/
strokeCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@other@/: @GskStroke@ to copy
    -> m Stroke
    -- ^ __Returns:__ a new @GskStroke@. Use 'GI.Gsk.Structs.Stroke.strokeFree' to free it
strokeCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m Stroke
strokeCopy Stroke
other = IO Stroke -> m Stroke
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stroke -> m Stroke) -> IO Stroke -> m Stroke
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stroke
other' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
other
    Ptr Stroke
result <- Ptr Stroke -> IO (Ptr Stroke)
gsk_stroke_copy Ptr Stroke
other'
    Text -> Ptr Stroke -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"strokeCopy" Ptr Stroke
result
    Stroke
result' <- ((ManagedPtr Stroke -> Stroke) -> Ptr Stroke -> IO Stroke
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Stroke -> Stroke
Stroke) Ptr Stroke
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
other
    Stroke -> IO Stroke
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stroke
result'

#if defined(ENABLE_OVERLOADING)
data StrokeCopyMethodInfo
instance (signature ~ (m Stroke), MonadIO m) => O.OverloadedMethod StrokeCopyMethodInfo Stroke signature where
    overloadedMethod = strokeCopy

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


#endif

-- method Stroke::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , 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_stroke_free" gsk_stroke_free :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO ()

-- | Frees a @GskStroke@.
-- 
-- /Since: 4.14/
strokeFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m ()
strokeFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Stroke -> m ()
strokeFree Stroke
self = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    Ptr Stroke -> IO ()
gsk_stroke_free Ptr Stroke
self'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod StrokeFreeMethodInfo Stroke signature where
    overloadedMethod = strokeFree

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


#endif

-- method Stroke::get_dash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_dash"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of elements in the array returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_dash"
--              , argType = TBasicType TSize
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of elements in the array returned"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TFloat))
-- throws : False
-- Skip return : False

foreign import ccall "gsk_stroke_get_dash" gsk_stroke_get_dash :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    Ptr FCT.CSize ->                        -- n_dash : TBasicType TSize
    IO (Ptr CFloat)

-- | Gets the dash array in use or @NULL@ if dashing is disabled.
-- 
-- /Since: 4.14/
strokeGetDash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m (Maybe [Float])
    -- ^ __Returns:__ 
    --   The dash array or @NULL@ if the dash array is empty.
strokeGetDash :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m (Maybe [Float])
strokeGetDash Stroke
self = IO (Maybe [Float]) -> m (Maybe [Float])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Float]) -> m (Maybe [Float]))
-> IO (Maybe [Float]) -> m (Maybe [Float])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    Ptr CSize
nDash <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr FCT.CSize)
    Ptr CFloat
result <- Ptr Stroke -> Ptr CSize -> IO (Ptr CFloat)
gsk_stroke_get_dash Ptr Stroke
self' Ptr CSize
nDash
    CSize
nDash' <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
nDash
    Maybe [Float]
maybeResult <- Ptr CFloat -> (Ptr CFloat -> IO [Float]) -> IO (Maybe [Float])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CFloat
result ((Ptr CFloat -> IO [Float]) -> IO (Maybe [Float]))
-> (Ptr CFloat -> IO [Float]) -> IO (Maybe [Float])
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
result' -> do
        [Float]
result'' <- ((CFloat -> Float) -> CSize -> Ptr CFloat -> IO [Float]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CSize
nDash') Ptr CFloat
result'
        [Float] -> IO [Float]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Float]
result''
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CSize
nDash
    Maybe [Float] -> IO (Maybe [Float])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Float]
maybeResult

#if defined(ENABLE_OVERLOADING)
data StrokeGetDashMethodInfo
instance (signature ~ (m (Maybe [Float])), MonadIO m) => O.OverloadedMethod StrokeGetDashMethodInfo Stroke signature where
    overloadedMethod = strokeGetDash

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


#endif

-- method Stroke::get_dash_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , 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_stroke_get_dash_offset" gsk_stroke_get_dash_offset :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO CFloat

-- | Returns the dash_offset of a @GskStroke@.
-- 
-- /Since: 4.14/
strokeGetDashOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m Float
strokeGetDashOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m Float
strokeGetDashOffset Stroke
self = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    CFloat
result <- Ptr Stroke -> IO CFloat
gsk_stroke_get_dash_offset Ptr Stroke
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data StrokeGetDashOffsetMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod StrokeGetDashOffsetMethodInfo Stroke signature where
    overloadedMethod = strokeGetDashOffset

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


#endif

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

foreign import ccall "gsk_stroke_get_line_cap" gsk_stroke_get_line_cap :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO CUInt

-- | Gets the line cap used.
-- 
-- See t'GI.Gsk.Enums.LineCap' for details.
-- 
-- /Since: 4.14/
strokeGetLineCap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m Gsk.Enums.LineCap
    -- ^ __Returns:__ The line cap
strokeGetLineCap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m LineCap
strokeGetLineCap Stroke
self = IO LineCap -> m LineCap
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LineCap -> m LineCap) -> IO LineCap -> m LineCap
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    CUInt
result <- Ptr Stroke -> IO CUInt
gsk_stroke_get_line_cap Ptr Stroke
self'
    let result' :: LineCap
result' = (Int -> LineCap
forall a. Enum a => Int -> a
toEnum (Int -> LineCap) -> (CUInt -> Int) -> CUInt -> LineCap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    LineCap -> IO LineCap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
result'

#if defined(ENABLE_OVERLOADING)
data StrokeGetLineCapMethodInfo
instance (signature ~ (m Gsk.Enums.LineCap), MonadIO m) => O.OverloadedMethod StrokeGetLineCapMethodInfo Stroke signature where
    overloadedMethod = strokeGetLineCap

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


#endif

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

foreign import ccall "gsk_stroke_get_line_join" gsk_stroke_get_line_join :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO CUInt

-- | Gets the line join used.
-- 
-- See t'GI.Gsk.Enums.LineJoin' for details.
-- 
-- /Since: 4.14/
strokeGetLineJoin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m Gsk.Enums.LineJoin
    -- ^ __Returns:__ The line join
strokeGetLineJoin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m LineJoin
strokeGetLineJoin Stroke
self = IO LineJoin -> m LineJoin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LineJoin -> m LineJoin) -> IO LineJoin -> m LineJoin
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    CUInt
result <- Ptr Stroke -> IO CUInt
gsk_stroke_get_line_join Ptr Stroke
self'
    let result' :: LineJoin
result' = (Int -> LineJoin
forall a. Enum a => Int -> a
toEnum (Int -> LineJoin) -> (CUInt -> Int) -> CUInt -> LineJoin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    LineJoin -> IO LineJoin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
result'

#if defined(ENABLE_OVERLOADING)
data StrokeGetLineJoinMethodInfo
instance (signature ~ (m Gsk.Enums.LineJoin), MonadIO m) => O.OverloadedMethod StrokeGetLineJoinMethodInfo Stroke signature where
    overloadedMethod = strokeGetLineJoin

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


#endif

-- method Stroke::get_line_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , 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_stroke_get_line_width" gsk_stroke_get_line_width :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO CFloat

-- | Gets the line width used.
-- 
-- /Since: 4.14/
strokeGetLineWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m Float
    -- ^ __Returns:__ The line width
strokeGetLineWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m Float
strokeGetLineWidth Stroke
self = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    CFloat
result <- Ptr Stroke -> IO CFloat
gsk_stroke_get_line_width Ptr Stroke
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data StrokeGetLineWidthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod StrokeGetLineWidthMethodInfo Stroke signature where
    overloadedMethod = strokeGetLineWidth

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


#endif

-- method Stroke::get_miter_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , 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_stroke_get_miter_limit" gsk_stroke_get_miter_limit :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    IO CFloat

-- | Returns the miter limit of a @GskStroke@.
-- 
-- /Since: 4.14/
strokeGetMiterLimit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> m Float
strokeGetMiterLimit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> m Float
strokeGetMiterLimit Stroke
self = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    CFloat
result <- Ptr Stroke -> IO CFloat
gsk_stroke_get_miter_limit Ptr Stroke
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data StrokeGetMiterLimitMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod StrokeGetMiterLimitMethodInfo Stroke signature where
    overloadedMethod = strokeGetMiterLimit

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


#endif

-- method Stroke::set_dash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dash"
--           , argType = TCArray False (-1) 2 (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "\n  the array of dashes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_dash"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of elements in @dash"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_dash"
--              , argType = TBasicType TSize
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of elements in @dash"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gsk_stroke_set_dash" gsk_stroke_set_dash :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    Ptr CFloat ->                           -- dash : TCArray False (-1) 2 (TBasicType TFloat)
    FCT.CSize ->                            -- n_dash : TBasicType TSize
    IO ()

-- | Sets the dash pattern to use by this stroke.
-- 
-- A dash pattern is specified by an array of alternating non-negative
-- values. Each value provides the length of alternate \"on\" and \"off\"
-- portions of the stroke.
-- 
-- Each \"on\" segment will have caps applied as if the segment were a
-- separate contour. In particular, it is valid to use an \"on\" length
-- of 0 with @GSK_LINE_CAP_ROUND@ or @GSK_LINE_CAP_SQUARE@ to draw dots
-- or squares along a path.
-- 
-- If /@nDash@/ is 0, if all elements in /@dash@/ are 0, or if there are
-- negative values in /@dash@/, then dashing is disabled.
-- 
-- If /@nDash@/ is 1, an alternating \"on\" and \"off\" pattern with the
-- single dash length provided is assumed.
-- 
-- If /@nDash@/ is uneven, the dash array will be used with the first
-- element in /@dash@/ defining an \"on\" or \"off\" in alternating passes
-- through the array.
-- 
-- You can specify a starting offset into the dash with
-- 'GI.Gsk.Structs.Stroke.strokeSetDashOffset'.
-- 
-- /Since: 4.14/
strokeSetDash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Maybe ([Float])
    -- ^ /@dash@/: 
    --   the array of dashes
    -> m ()
strokeSetDash :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> Maybe [Float] -> m ()
strokeSetDash Stroke
self Maybe [Float]
dash = 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
    let nDash :: CSize
nDash = case Maybe [Float]
dash of
            Maybe [Float]
Nothing -> CSize
0
            Just [Float]
jDash -> Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ [Float] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Float]
jDash
    Ptr Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    Ptr CFloat
maybeDash <- case Maybe [Float]
dash of
        Maybe [Float]
Nothing -> Ptr CFloat -> IO (Ptr CFloat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CFloat
forall a. Ptr a
nullPtr
        Just [Float]
jDash -> do
            Ptr CFloat
jDash' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
jDash
            Ptr CFloat -> IO (Ptr CFloat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CFloat
jDash'
    Ptr Stroke -> Ptr CFloat -> CSize -> IO ()
gsk_stroke_set_dash Ptr Stroke
self' Ptr CFloat
maybeDash CSize
nDash
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
maybeDash
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetDashMethodInfo
instance (signature ~ (Maybe ([Float]) -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetDashMethodInfo Stroke signature where
    overloadedMethod = strokeSetDash

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


#endif

-- method Stroke::set_dash_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset into the dash pattern"
--                 , 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_stroke_set_dash_offset" gsk_stroke_set_dash_offset :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    CFloat ->                               -- offset : TBasicType TFloat
    IO ()

-- | Sets the offset into the dash pattern where dashing should begin.
-- 
-- This is an offset into the length of the path, not an index into
-- the array values of the dash array.
-- 
-- See 'GI.Gsk.Structs.Stroke.strokeSetDash' for more details on dashing.
-- 
-- /Since: 4.14/
strokeSetDashOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Float
    -- ^ /@offset@/: offset into the dash pattern
    -> m ()
strokeSetDashOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> Float -> m ()
strokeSetDashOffset Stroke
self Float
offset = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    let offset' :: CFloat
offset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
offset
    Ptr Stroke -> CFloat -> IO ()
gsk_stroke_set_dash_offset Ptr Stroke
self' CFloat
offset'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetDashOffsetMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetDashOffsetMethodInfo Stroke signature where
    overloadedMethod = strokeSetDashOffset

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


#endif

-- method Stroke::set_line_cap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a`GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_cap"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "LineCap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GskLineCap`" , 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_stroke_set_line_cap" gsk_stroke_set_line_cap :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    CUInt ->                                -- line_cap : TInterface (Name {namespace = "Gsk", name = "LineCap"})
    IO ()

-- | Sets the line cap to be used when stroking.
-- 
-- See t'GI.Gsk.Enums.LineCap' for details.
-- 
-- /Since: 4.14/
strokeSetLineCap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a@GskStroke@
    -> Gsk.Enums.LineCap
    -- ^ /@lineCap@/: the @GskLineCap@
    -> m ()
strokeSetLineCap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> LineCap -> m ()
strokeSetLineCap Stroke
self LineCap
lineCap = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    let lineCap' :: CUInt
lineCap' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (LineCap -> Int) -> LineCap -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> Int
forall a. Enum a => a -> Int
fromEnum) LineCap
lineCap
    Ptr Stroke -> CUInt -> IO ()
gsk_stroke_set_line_cap Ptr Stroke
self' CUInt
lineCap'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetLineCapMethodInfo
instance (signature ~ (Gsk.Enums.LineCap -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetLineCapMethodInfo Stroke signature where
    overloadedMethod = strokeSetLineCap

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


#endif

-- method Stroke::set_line_join
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_join"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "LineJoin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The line join to use"
--                 , 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_stroke_set_line_join" gsk_stroke_set_line_join :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    CUInt ->                                -- line_join : TInterface (Name {namespace = "Gsk", name = "LineJoin"})
    IO ()

-- | Sets the line join to be used when stroking.
-- 
-- See t'GI.Gsk.Enums.LineJoin' for details.
-- 
-- /Since: 4.14/
strokeSetLineJoin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Gsk.Enums.LineJoin
    -- ^ /@lineJoin@/: The line join to use
    -> m ()
strokeSetLineJoin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> LineJoin -> m ()
strokeSetLineJoin Stroke
self LineJoin
lineJoin = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    let lineJoin' :: CUInt
lineJoin' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (LineJoin -> Int) -> LineJoin -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> Int
forall a. Enum a => a -> Int
fromEnum) LineJoin
lineJoin
    Ptr Stroke -> CUInt -> IO ()
gsk_stroke_set_line_join Ptr Stroke
self' CUInt
lineJoin'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetLineJoinMethodInfo
instance (signature ~ (Gsk.Enums.LineJoin -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetLineJoinMethodInfo Stroke signature where
    overloadedMethod = strokeSetLineJoin

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


#endif

-- method Stroke::set_line_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_width"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the line in pixels"
--                 , 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_stroke_set_line_width" gsk_stroke_set_line_width :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    CFloat ->                               -- line_width : TBasicType TFloat
    IO ()

-- | Sets the line width to be used when stroking.
-- 
-- The line width must be > 0.
-- 
-- /Since: 4.14/
strokeSetLineWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Float
    -- ^ /@lineWidth@/: width of the line in pixels
    -> m ()
strokeSetLineWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> Float -> m ()
strokeSetLineWidth Stroke
self Float
lineWidth = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    let lineWidth' :: CFloat
lineWidth' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
lineWidth
    Ptr Stroke -> CFloat -> IO ()
gsk_stroke_set_line_width Ptr Stroke
self' CFloat
lineWidth'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetLineWidthMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetLineWidthMethodInfo Stroke signature where
    overloadedMethod = strokeSetLineWidth

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


#endif

-- method Stroke::set_miter_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "limit"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the miter limit" , 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_stroke_set_miter_limit" gsk_stroke_set_miter_limit :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    CFloat ->                               -- limit : TBasicType TFloat
    IO ()

-- | Sets the limit for the distance from the corner where sharp
-- turns of joins get cut off.
-- 
-- The miter limit is in units of line width and must be non-negative.
-- 
-- For joins of type @GSK_LINE_JOIN_MITER@ that exceed the miter
-- limit, the join gets rendered as if it was of type
-- @GSK_LINE_JOIN_BEVEL@.
-- 
-- /Since: 4.14/
strokeSetMiterLimit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Float
    -- ^ /@limit@/: the miter limit
    -> m ()
strokeSetMiterLimit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> Float -> m ()
strokeSetMiterLimit Stroke
self Float
limit = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    let limit' :: CFloat
limit' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
limit
    Ptr Stroke -> CFloat -> IO ()
gsk_stroke_set_miter_limit Ptr Stroke
self' CFloat
limit'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeSetMiterLimitMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod StrokeSetMiterLimitMethodInfo Stroke signature where
    overloadedMethod = strokeSetMiterLimit

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


#endif

-- method Stroke::to_cairo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gsk" , name = "Stroke" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GskStroke`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the cairo context to configure"
--                 , 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_stroke_to_cairo" gsk_stroke_to_cairo :: 
    Ptr Stroke ->                           -- self : TInterface (Name {namespace = "Gsk", name = "Stroke"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    IO ()

-- | A helper function that sets the stroke parameters
-- of /@cr@/ from the values found in /@self@/.
-- 
-- /Since: 4.14/
strokeToCairo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Stroke
    -- ^ /@self@/: a @GskStroke@
    -> Cairo.Context.Context
    -- ^ /@cr@/: the cairo context to configure
    -> m ()
strokeToCairo :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Stroke -> Context -> m ()
strokeToCairo Stroke
self Context
cr = 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 Stroke
self' <- Stroke -> IO (Ptr Stroke)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Stroke
self
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Stroke -> Ptr Context -> IO ()
gsk_stroke_to_cairo Ptr Stroke
self' Ptr Context
cr'
    Stroke -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Stroke
self
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StrokeToCairoMethodInfo
instance (signature ~ (Cairo.Context.Context -> m ()), MonadIO m) => O.OverloadedMethod StrokeToCairoMethodInfo Stroke signature where
    overloadedMethod = strokeToCairo

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


#endif

-- method Stroke::equal
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "stroke1"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first `GskStroke`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stroke2"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second `GskStroke`"
--                 , 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_stroke_equal" gsk_stroke_equal :: 
    Ptr () ->                               -- stroke1 : TBasicType TPtr
    Ptr () ->                               -- stroke2 : TBasicType TPtr
    IO CInt

-- | Checks if 2 strokes are identical.
-- 
-- /Since: 4.14/
strokeEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@stroke1@/: the first @GskStroke@
    -> Ptr ()
    -- ^ /@stroke2@/: the second @GskStroke@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the 2 strokes are equal, @FALSE@ otherwise
strokeEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> Ptr () -> m Bool
strokeEqual Ptr ()
stroke1 Ptr ()
stroke2 = 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
    CInt
result <- Ptr () -> Ptr () -> IO CInt
gsk_stroke_equal Ptr ()
stroke1 Ptr ()
stroke2
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveStrokeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveStrokeMethod "copy" o = StrokeCopyMethodInfo
    ResolveStrokeMethod "free" o = StrokeFreeMethodInfo
    ResolveStrokeMethod "toCairo" o = StrokeToCairoMethodInfo
    ResolveStrokeMethod "getDash" o = StrokeGetDashMethodInfo
    ResolveStrokeMethod "getDashOffset" o = StrokeGetDashOffsetMethodInfo
    ResolveStrokeMethod "getLineCap" o = StrokeGetLineCapMethodInfo
    ResolveStrokeMethod "getLineJoin" o = StrokeGetLineJoinMethodInfo
    ResolveStrokeMethod "getLineWidth" o = StrokeGetLineWidthMethodInfo
    ResolveStrokeMethod "getMiterLimit" o = StrokeGetMiterLimitMethodInfo
    ResolveStrokeMethod "setDash" o = StrokeSetDashMethodInfo
    ResolveStrokeMethod "setDashOffset" o = StrokeSetDashOffsetMethodInfo
    ResolveStrokeMethod "setLineCap" o = StrokeSetLineCapMethodInfo
    ResolveStrokeMethod "setLineJoin" o = StrokeSetLineJoinMethodInfo
    ResolveStrokeMethod "setLineWidth" o = StrokeSetLineWidthMethodInfo
    ResolveStrokeMethod "setMiterLimit" o = StrokeSetMiterLimitMethodInfo
    ResolveStrokeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif