{-# LANGUAGE TypeApplications #-} -- | Copyright : Will Thompson and Iñaki García Etxebarria -- License : LGPL-2.1 -- Maintainer : Iñaki García Etxebarria -- -- @GskPathBuilder@ is an auxiliary object for constructing -- @GskPath@ objects. -- -- A path is constructed like this: -- -- -- === /C code/ -- > -- >GskPath * -- >construct_path (void) -- >{ -- > GskPathBuilder *builder; -- > -- > builder = gsk_path_builder_new (); -- > -- > // add contours to the path here -- > -- > return gsk_path_builder_free_to_path (builder); -- -- -- Adding contours to the path can be done in two ways. -- The easiest option is to use the @gsk_path_builder_add_*@ group -- of functions that add predefined contours to the current path, -- either common shapes like 'GI.Gsk.Structs.PathBuilder.pathBuilderAddCircle' -- or by adding from other paths like 'GI.Gsk.Structs.PathBuilder.pathBuilderAddPath'. -- -- The @gsk_path_builder_add_*@ methods always add complete contours, -- and do not use or modify the current point. -- -- The other option is to define each line and curve manually with -- the @gsk_path_builder_*_to@ group of functions. You start with -- a call to 'GI.Gsk.Structs.PathBuilder.pathBuilderMoveTo' to set the starting point -- and then use multiple calls to any of the drawing functions to -- move the pen along the plane. Once you are done, you can call -- 'GI.Gsk.Structs.PathBuilder.pathBuilderClose' to close the path by connecting it -- back with a line to the starting point. -- -- This is similar to how paths are drawn in Cairo. -- -- Note that @GskPathBuilder@ will reduce the degree of added Bézier -- curves as much as possible, to simplify rendering. -- -- /Since: 4.14/ #if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__)) #define ENABLE_OVERLOADING #endif module GI.Gsk.Structs.PathBuilder ( -- * Exported types PathBuilder(..) , -- * Methods -- | -- -- === __Click to display all available methods, including inherited ones__ -- ==== Methods -- [addCairoPath]("GI.Gsk.Structs.PathBuilder#g:method:addCairoPath"), [addCircle]("GI.Gsk.Structs.PathBuilder#g:method:addCircle"), [addLayout]("GI.Gsk.Structs.PathBuilder#g:method:addLayout"), [addPath]("GI.Gsk.Structs.PathBuilder#g:method:addPath"), [addRect]("GI.Gsk.Structs.PathBuilder#g:method:addRect"), [addReversePath]("GI.Gsk.Structs.PathBuilder#g:method:addReversePath"), [addRoundedRect]("GI.Gsk.Structs.PathBuilder#g:method:addRoundedRect"), [addSegment]("GI.Gsk.Structs.PathBuilder#g:method:addSegment"), [arcTo]("GI.Gsk.Structs.PathBuilder#g:method:arcTo"), [close]("GI.Gsk.Structs.PathBuilder#g:method:close"), [conicTo]("GI.Gsk.Structs.PathBuilder#g:method:conicTo"), [cubicTo]("GI.Gsk.Structs.PathBuilder#g:method:cubicTo"), [htmlArcTo]("GI.Gsk.Structs.PathBuilder#g:method:htmlArcTo"), [lineTo]("GI.Gsk.Structs.PathBuilder#g:method:lineTo"), [moveTo]("GI.Gsk.Structs.PathBuilder#g:method:moveTo"), [quadTo]("GI.Gsk.Structs.PathBuilder#g:method:quadTo"), [ref]("GI.Gsk.Structs.PathBuilder#g:method:ref"), [relArcTo]("GI.Gsk.Structs.PathBuilder#g:method:relArcTo"), [relConicTo]("GI.Gsk.Structs.PathBuilder#g:method:relConicTo"), [relCubicTo]("GI.Gsk.Structs.PathBuilder#g:method:relCubicTo"), [relHtmlArcTo]("GI.Gsk.Structs.PathBuilder#g:method:relHtmlArcTo"), [relLineTo]("GI.Gsk.Structs.PathBuilder#g:method:relLineTo"), [relMoveTo]("GI.Gsk.Structs.PathBuilder#g:method:relMoveTo"), [relQuadTo]("GI.Gsk.Structs.PathBuilder#g:method:relQuadTo"), [relSvgArcTo]("GI.Gsk.Structs.PathBuilder#g:method:relSvgArcTo"), [svgArcTo]("GI.Gsk.Structs.PathBuilder#g:method:svgArcTo"), [toPath]("GI.Gsk.Structs.PathBuilder#g:method:toPath"), [unref]("GI.Gsk.Structs.PathBuilder#g:method:unref"). -- -- ==== Getters -- [getCurrentPoint]("GI.Gsk.Structs.PathBuilder#g:method:getCurrentPoint"). -- -- ==== Setters -- /None/. #if defined(ENABLE_OVERLOADING) ResolvePathBuilderMethod , #endif -- ** addCairoPath #method:addCairoPath# #if defined(ENABLE_OVERLOADING) PathBuilderAddCairoPathMethodInfo , #endif pathBuilderAddCairoPath , -- ** addCircle #method:addCircle# #if defined(ENABLE_OVERLOADING) PathBuilderAddCircleMethodInfo , #endif pathBuilderAddCircle , -- ** addLayout #method:addLayout# #if defined(ENABLE_OVERLOADING) PathBuilderAddLayoutMethodInfo , #endif pathBuilderAddLayout , -- ** addPath #method:addPath# #if defined(ENABLE_OVERLOADING) PathBuilderAddPathMethodInfo , #endif pathBuilderAddPath , -- ** addRect #method:addRect# #if defined(ENABLE_OVERLOADING) PathBuilderAddRectMethodInfo , #endif pathBuilderAddRect , -- ** addReversePath #method:addReversePath# #if defined(ENABLE_OVERLOADING) PathBuilderAddReversePathMethodInfo , #endif pathBuilderAddReversePath , -- ** addRoundedRect #method:addRoundedRect# #if defined(ENABLE_OVERLOADING) PathBuilderAddRoundedRectMethodInfo , #endif pathBuilderAddRoundedRect , -- ** addSegment #method:addSegment# #if defined(ENABLE_OVERLOADING) PathBuilderAddSegmentMethodInfo , #endif pathBuilderAddSegment , -- ** arcTo #method:arcTo# #if defined(ENABLE_OVERLOADING) PathBuilderArcToMethodInfo , #endif pathBuilderArcTo , -- ** close #method:close# #if defined(ENABLE_OVERLOADING) PathBuilderCloseMethodInfo , #endif pathBuilderClose , -- ** conicTo #method:conicTo# #if defined(ENABLE_OVERLOADING) PathBuilderConicToMethodInfo , #endif pathBuilderConicTo , -- ** cubicTo #method:cubicTo# #if defined(ENABLE_OVERLOADING) PathBuilderCubicToMethodInfo , #endif pathBuilderCubicTo , -- ** getCurrentPoint #method:getCurrentPoint# #if defined(ENABLE_OVERLOADING) PathBuilderGetCurrentPointMethodInfo , #endif pathBuilderGetCurrentPoint , -- ** htmlArcTo #method:htmlArcTo# #if defined(ENABLE_OVERLOADING) PathBuilderHtmlArcToMethodInfo , #endif pathBuilderHtmlArcTo , -- ** lineTo #method:lineTo# #if defined(ENABLE_OVERLOADING) PathBuilderLineToMethodInfo , #endif pathBuilderLineTo , -- ** moveTo #method:moveTo# #if defined(ENABLE_OVERLOADING) PathBuilderMoveToMethodInfo , #endif pathBuilderMoveTo , -- ** new #method:new# pathBuilderNew , -- ** quadTo #method:quadTo# #if defined(ENABLE_OVERLOADING) PathBuilderQuadToMethodInfo , #endif pathBuilderQuadTo , -- ** ref #method:ref# #if defined(ENABLE_OVERLOADING) PathBuilderRefMethodInfo , #endif pathBuilderRef , -- ** relArcTo #method:relArcTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelArcToMethodInfo , #endif pathBuilderRelArcTo , -- ** relConicTo #method:relConicTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelConicToMethodInfo , #endif pathBuilderRelConicTo , -- ** relCubicTo #method:relCubicTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelCubicToMethodInfo , #endif pathBuilderRelCubicTo , -- ** relHtmlArcTo #method:relHtmlArcTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelHtmlArcToMethodInfo , #endif pathBuilderRelHtmlArcTo , -- ** relLineTo #method:relLineTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelLineToMethodInfo , #endif pathBuilderRelLineTo , -- ** relMoveTo #method:relMoveTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelMoveToMethodInfo , #endif pathBuilderRelMoveTo , -- ** relQuadTo #method:relQuadTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelQuadToMethodInfo , #endif pathBuilderRelQuadTo , -- ** relSvgArcTo #method:relSvgArcTo# #if defined(ENABLE_OVERLOADING) PathBuilderRelSvgArcToMethodInfo , #endif pathBuilderRelSvgArcTo , -- ** svgArcTo #method:svgArcTo# #if defined(ENABLE_OVERLOADING) PathBuilderSvgArcToMethodInfo , #endif pathBuilderSvgArcTo , -- ** toPath #method:toPath# #if defined(ENABLE_OVERLOADING) PathBuilderToPathMethodInfo , #endif pathBuilderToPath , -- ** unref #method:unref# #if defined(ENABLE_OVERLOADING) PathBuilderUnrefMethodInfo , #endif pathBuilderUnref , ) 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.Cairo.Structs.Path as Cairo.Path 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.Size as Graphene.Size 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.PathPoint as Gsk.PathPoint import {-# SOURCE #-} qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect import {-# SOURCE #-} qualified GI.Gsk.Structs.Stroke as Gsk.Stroke import qualified GI.Pango.Objects.Layout as Pango.Layout #else import qualified GI.Cairo.Structs.Path as Cairo.Path import qualified GI.Graphene.Structs.Point as Graphene.Point import qualified GI.Graphene.Structs.Rect as Graphene.Rect import {-# SOURCE #-} qualified GI.Gsk.Structs.Path as Gsk.Path import {-# SOURCE #-} qualified GI.Gsk.Structs.PathPoint as Gsk.PathPoint import {-# SOURCE #-} qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect import qualified GI.Pango.Objects.Layout as Pango.Layout #endif -- | Memory-managed wrapper type. newtype PathBuilder = PathBuilder (SP.ManagedPtr PathBuilder) deriving (PathBuilder -> PathBuilder -> Bool (PathBuilder -> PathBuilder -> Bool) -> (PathBuilder -> PathBuilder -> Bool) -> Eq PathBuilder forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: PathBuilder -> PathBuilder -> Bool == :: PathBuilder -> PathBuilder -> Bool $c/= :: PathBuilder -> PathBuilder -> Bool /= :: PathBuilder -> PathBuilder -> Bool Eq) instance SP.ManagedPtrNewtype PathBuilder where toManagedPtr :: PathBuilder -> ManagedPtr PathBuilder toManagedPtr (PathBuilder ManagedPtr PathBuilder p) = ManagedPtr PathBuilder p foreign import ccall "gsk_path_builder_get_type" c_gsk_path_builder_get_type :: IO GType type instance O.ParentTypes PathBuilder = '[] instance O.HasParentTypes PathBuilder instance B.Types.TypedObject PathBuilder where glibType :: IO GType glibType = IO GType c_gsk_path_builder_get_type instance B.Types.GBoxed PathBuilder -- | Convert 'PathBuilder' 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 PathBuilder) where gvalueGType_ :: IO GType gvalueGType_ = IO GType c_gsk_path_builder_get_type gvalueSet_ :: Ptr GValue -> Maybe PathBuilder -> IO () gvalueSet_ Ptr GValue gv Maybe PathBuilder P.Nothing = Ptr GValue -> Ptr PathBuilder -> IO () forall a. Ptr GValue -> Ptr a -> IO () B.GValue.set_boxed Ptr GValue gv (Ptr PathBuilder forall a. Ptr a FP.nullPtr :: FP.Ptr PathBuilder) gvalueSet_ Ptr GValue gv (P.Just PathBuilder obj) = PathBuilder -> (Ptr PathBuilder -> IO ()) -> IO () forall a c. (HasCallStack, ManagedPtrNewtype a) => a -> (Ptr a -> IO c) -> IO c B.ManagedPtr.withManagedPtr PathBuilder obj (Ptr GValue -> Ptr PathBuilder -> IO () forall a. Ptr GValue -> Ptr a -> IO () B.GValue.set_boxed Ptr GValue gv) gvalueGet_ :: Ptr GValue -> IO (Maybe PathBuilder) gvalueGet_ Ptr GValue gv = do Ptr PathBuilder ptr <- Ptr GValue -> IO (Ptr PathBuilder) forall b. Ptr GValue -> IO (Ptr b) B.GValue.get_boxed Ptr GValue gv :: IO (Ptr PathBuilder) if Ptr PathBuilder ptr Ptr PathBuilder -> Ptr PathBuilder -> Bool forall a. Eq a => a -> a -> Bool /= Ptr PathBuilder forall a. Ptr a FP.nullPtr then PathBuilder -> Maybe PathBuilder forall a. a -> Maybe a P.Just (PathBuilder -> Maybe PathBuilder) -> IO PathBuilder -> IO (Maybe PathBuilder) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (ManagedPtr PathBuilder -> PathBuilder) -> Ptr PathBuilder -> IO PathBuilder forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a B.ManagedPtr.newBoxed ManagedPtr PathBuilder -> PathBuilder PathBuilder Ptr PathBuilder ptr else Maybe PathBuilder -> IO (Maybe PathBuilder) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Maybe PathBuilder forall a. Maybe a P.Nothing #if defined(ENABLE_OVERLOADING) instance O.HasAttributeList PathBuilder type instance O.AttributeList PathBuilder = PathBuilderAttributeList type PathBuilderAttributeList = ('[ ] :: [(Symbol, DK.Type)]) #endif -- method PathBuilder::new -- method type : Constructor -- Args: [] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Gsk" , name = "PathBuilder" }) -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_new" gsk_path_builder_new :: IO (Ptr PathBuilder) -- | Create a new @GskPathBuilder@ object. -- -- The resulting builder would create an empty @GskPath@. -- Use addition functions to add types to it. -- -- /Since: 4.14/ pathBuilderNew :: (B.CallStack.HasCallStack, MonadIO m) => m PathBuilder -- ^ __Returns:__ a new @GskPathBuilder@ pathBuilderNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m PathBuilder pathBuilderNew = IO PathBuilder -> m PathBuilder forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO PathBuilder -> m PathBuilder) -> IO PathBuilder -> m PathBuilder forall a b. (a -> b) -> a -> b $ do Ptr PathBuilder result <- IO (Ptr PathBuilder) gsk_path_builder_new Text -> Ptr PathBuilder -> IO () forall a. HasCallStack => Text -> Ptr a -> IO () checkUnexpectedReturnNULL Text "pathBuilderNew" Ptr PathBuilder result PathBuilder result' <- ((ManagedPtr PathBuilder -> PathBuilder) -> Ptr PathBuilder -> IO PathBuilder forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a wrapBoxed ManagedPtr PathBuilder -> PathBuilder PathBuilder) Ptr PathBuilder result PathBuilder -> IO PathBuilder forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return PathBuilder result' #if defined(ENABLE_OVERLOADING) #endif -- method PathBuilder::add_cairo_path -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "path" -- , argType = TInterface Name { namespace = "cairo" , name = "Path" } -- , 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_builder_add_cairo_path" gsk_path_builder_add_cairo_path :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Cairo.Path.Path -> -- path : TInterface (Name {namespace = "cairo", name = "Path"}) IO () -- | Adds a Cairo path to the builder. -- -- You can use @/cairo_copy_path()/@ to access the path -- from a Cairo context. -- -- /Since: 4.14/ pathBuilderAddCairoPath :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Cairo.Path.Path -> m () pathBuilderAddCairoPath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Path -> m () pathBuilderAddCairoPath PathBuilder self Path path = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Path path' <- Path -> IO (Ptr Path) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Path path Ptr PathBuilder -> Ptr Path -> IO () gsk_path_builder_add_cairo_path Ptr PathBuilder self' Ptr Path path' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Path -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Path path () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddCairoPathMethodInfo instance (signature ~ (Cairo.Path.Path -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddCairoPathMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddCairoPath instance O.OverloadedMethodInfo PathBuilderAddCairoPathMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddCairoPath", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddCairoPath" }) #endif -- method PathBuilder::add_circle -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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 = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the center of the circle" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "radius" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the radius of the circle" -- , 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_builder_add_circle" gsk_path_builder_add_circle :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Graphene.Point.Point -> -- center : TInterface (Name {namespace = "Graphene", name = "Point"}) CFloat -> -- radius : TBasicType TFloat IO () -- | Adds a circle with the /@center@/ and /@radius@/. -- -- The path is going around the circle in clockwise direction. -- -- If /@radius@/ is zero, the contour will be a closed point. -- -- /Since: 4.14/ pathBuilderAddCircle :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Graphene.Point.Point -- ^ /@center@/: the center of the circle -> Float -- ^ /@radius@/: the radius of the circle -> m () pathBuilderAddCircle :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Point -> Float -> m () pathBuilderAddCircle PathBuilder self Point center Float radius = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Point center' <- Point -> IO (Ptr Point) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Point center let radius' :: CFloat radius' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float radius Ptr PathBuilder -> Ptr Point -> CFloat -> IO () gsk_path_builder_add_circle Ptr PathBuilder self' Ptr Point center' CFloat radius' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Point -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Point center () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddCircleMethodInfo instance (signature ~ (Graphene.Point.Point -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddCircleMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddCircle instance O.OverloadedMethodInfo PathBuilderAddCircleMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddCircle", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddCircle" }) #endif -- method PathBuilder::add_layout -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GskPathBuilder" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "layout" -- , argType = -- TInterface Name { namespace = "Pango" , name = "Layout" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the pango layout to add" -- , 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_builder_add_layout" gsk_path_builder_add_layout :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Pango.Layout.Layout -> -- layout : TInterface (Name {namespace = "Pango", name = "Layout"}) IO () -- | Adds the outlines for the glyphs in /@layout@/ to the builder. -- -- /Since: 4.14/ pathBuilderAddLayout :: (B.CallStack.HasCallStack, MonadIO m, Pango.Layout.IsLayout a) => PathBuilder -- ^ /@self@/: a t'GI.Gsk.Structs.PathBuilder.PathBuilder' -> a -- ^ /@layout@/: the pango layout to add -> m () pathBuilderAddLayout :: forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsLayout a) => PathBuilder -> a -> m () pathBuilderAddLayout PathBuilder self a layout = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Layout layout' <- a -> IO (Ptr Layout) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) unsafeManagedPtrCastPtr a layout Ptr PathBuilder -> Ptr Layout -> IO () gsk_path_builder_add_layout Ptr PathBuilder self' Ptr Layout layout' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self a -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr a layout () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddLayoutMethodInfo instance (signature ~ (a -> m ()), MonadIO m, Pango.Layout.IsLayout a) => O.OverloadedMethod PathBuilderAddLayoutMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddLayout instance O.OverloadedMethodInfo PathBuilderAddLayoutMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddLayout", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddLayout" }) #endif -- method PathBuilder::add_path -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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 to append" , 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_builder_add_path" gsk_path_builder_add_path :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Gsk.Path.Path -> -- path : TInterface (Name {namespace = "Gsk", name = "Path"}) IO () -- | Appends all of /@path@/ to the builder. -- -- /Since: 4.14/ pathBuilderAddPath :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Gsk.Path.Path -- ^ /@path@/: the path to append -> m () pathBuilderAddPath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Path -> m () pathBuilderAddPath PathBuilder self Path path = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Path path' <- Path -> IO (Ptr Path) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Path path Ptr PathBuilder -> Ptr Path -> IO () gsk_path_builder_add_path Ptr PathBuilder self' Ptr Path path' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Path -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Path path () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddPathMethodInfo instance (signature ~ (Gsk.Path.Path -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddPathMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddPath instance O.OverloadedMethodInfo PathBuilderAddPathMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddPath", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddPath" }) #endif -- method PathBuilder::add_rect -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "A `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "rect" -- , argType = -- TInterface Name { namespace = "Graphene" , name = "Rect" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "The rectangle to create a path for" -- , 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_builder_add_rect" gsk_path_builder_add_rect :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Graphene.Rect.Rect -> -- rect : TInterface (Name {namespace = "Graphene", name = "Rect"}) IO () -- | Adds /@rect@/ as a new contour to the path built by the builder. -- -- The path is going around the rectangle in clockwise direction. -- -- If the the width or height are 0, the path will be a closed -- horizontal or vertical line. If both are 0, it\'ll be a closed dot. -- -- /Since: 4.14/ pathBuilderAddRect :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: A @GskPathBuilder@ -> Graphene.Rect.Rect -- ^ /@rect@/: The rectangle to create a path for -> m () pathBuilderAddRect :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Rect -> m () pathBuilderAddRect PathBuilder self Rect rect = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Rect rect' <- Rect -> IO (Ptr Rect) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Rect rect Ptr PathBuilder -> Ptr Rect -> IO () gsk_path_builder_add_rect Ptr PathBuilder self' Ptr Rect rect' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Rect -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Rect rect () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddRectMethodInfo instance (signature ~ (Graphene.Rect.Rect -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddRectMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddRect instance O.OverloadedMethodInfo PathBuilderAddRectMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddRect", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddRect" }) #endif -- method PathBuilder::add_reverse_path -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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 to append" , 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_builder_add_reverse_path" gsk_path_builder_add_reverse_path :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Gsk.Path.Path -> -- path : TInterface (Name {namespace = "Gsk", name = "Path"}) IO () -- | Appends all of /@path@/ to the builder, in reverse order. -- -- /Since: 4.14/ pathBuilderAddReversePath :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Gsk.Path.Path -- ^ /@path@/: the path to append -> m () pathBuilderAddReversePath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Path -> m () pathBuilderAddReversePath PathBuilder self Path path = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Path path' <- Path -> IO (Ptr Path) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Path path Ptr PathBuilder -> Ptr Path -> IO () gsk_path_builder_add_reverse_path Ptr PathBuilder self' Ptr Path path' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Path -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Path path () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddReversePathMethodInfo instance (signature ~ (Gsk.Path.Path -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddReversePathMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddReversePath instance O.OverloadedMethodInfo PathBuilderAddReversePathMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddReversePath", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddReversePath" }) #endif -- method PathBuilder::add_rounded_rect -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GskPathBuilder" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "rect" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "RoundedRect" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the rounded rect" , 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_builder_add_rounded_rect" gsk_path_builder_add_rounded_rect :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Gsk.RoundedRect.RoundedRect -> -- rect : TInterface (Name {namespace = "Gsk", name = "RoundedRect"}) IO () -- | Adds /@rect@/ as a new contour to the path built in /@self@/. -- -- The path is going around the rectangle in clockwise direction. -- -- /Since: 4.14/ pathBuilderAddRoundedRect :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a t'GI.Gsk.Structs.PathBuilder.PathBuilder' -> Gsk.RoundedRect.RoundedRect -- ^ /@rect@/: the rounded rect -> m () pathBuilderAddRoundedRect :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> RoundedRect -> m () pathBuilderAddRoundedRect PathBuilder self RoundedRect rect = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr RoundedRect rect' <- RoundedRect -> IO (Ptr RoundedRect) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr RoundedRect rect Ptr PathBuilder -> Ptr RoundedRect -> IO () gsk_path_builder_add_rounded_rect Ptr PathBuilder self' Ptr RoundedRect rect' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self RoundedRect -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr RoundedRect rect () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddRoundedRectMethodInfo instance (signature ~ (Gsk.RoundedRect.RoundedRect -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddRoundedRectMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddRoundedRect instance O.OverloadedMethodInfo PathBuilderAddRoundedRectMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddRoundedRect", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddRoundedRect" }) #endif -- method PathBuilder::add_segment -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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 `GskPath` to take the segment to" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "start" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathPoint" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the point on @path to start at" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "end" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathPoint" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the point on @path to end at" -- , 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_builder_add_segment" gsk_path_builder_add_segment :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) Ptr Gsk.Path.Path -> -- path : TInterface (Name {namespace = "Gsk", name = "Path"}) Ptr Gsk.PathPoint.PathPoint -> -- start : TInterface (Name {namespace = "Gsk", name = "PathPoint"}) Ptr Gsk.PathPoint.PathPoint -> -- end : TInterface (Name {namespace = "Gsk", name = "PathPoint"}) IO () -- | Adds to /@self@/ the segment of /@path@/ from /@start@/ to /@end@/. -- -- If /@start@/ is equal to or after /@end@/, the path will first add the -- segment from /@start@/ to the end of the path, and then add the segment -- from the beginning to /@end@/. If the path is closed, these segments -- will be connected. -- -- Note that this method always adds a path with the given start point -- and end point. To add a closed path, use 'GI.Gsk.Structs.PathBuilder.pathBuilderAddPath'. -- -- /Since: 4.14/ pathBuilderAddSegment :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Gsk.Path.Path -- ^ /@path@/: the @GskPath@ to take the segment to -> Gsk.PathPoint.PathPoint -- ^ /@start@/: the point on /@path@/ to start at -> Gsk.PathPoint.PathPoint -- ^ /@end@/: the point on /@path@/ to end at -> m () pathBuilderAddSegment :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Path -> PathPoint -> PathPoint -> m () pathBuilderAddSegment PathBuilder self Path path PathPoint start PathPoint end = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Path path' <- Path -> IO (Ptr Path) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Path path Ptr PathPoint start' <- PathPoint -> IO (Ptr PathPoint) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathPoint start Ptr PathPoint end' <- PathPoint -> IO (Ptr PathPoint) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathPoint end Ptr PathBuilder -> Ptr Path -> Ptr PathPoint -> Ptr PathPoint -> IO () gsk_path_builder_add_segment Ptr PathBuilder self' Ptr Path path' Ptr PathPoint start' Ptr PathPoint end' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Path -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr Path path PathPoint -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathPoint start PathPoint -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathPoint end () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderAddSegmentMethodInfo instance (signature ~ (Gsk.Path.Path -> Gsk.PathPoint.PathPoint -> Gsk.PathPoint.PathPoint -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderAddSegmentMethodInfo PathBuilder signature where overloadedMethod = pathBuilderAddSegment instance O.OverloadedMethodInfo PathBuilderAddSegmentMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderAddSegment", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderAddSegment" }) #endif -- method PathBuilder::arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of second control point" -- , 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_builder_arc_to" gsk_path_builder_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat IO () -- | Adds an elliptical arc from the current point to /@x2@/, /@y2@/ -- with /@x1@/, /@y1@/ determining the tangent directions. -- -- After this, /@x2@/, /@y2@/ will be the new current point. -- -- Note: Two points and their tangents do not determine -- a unique ellipse, so GSK just picks one. If you need more -- precise control, use 'GI.Gsk.Structs.PathBuilder.pathBuilderConicTo' -- or 'GI.Gsk.Structs.PathBuilder.pathBuilderSvgArcTo'. -- -- \<picture> -- \<source srcset=\"arc-dark.png\" media=\"(prefers-color-scheme: dark)\"> -- \<img alt=\"Arc To\" src=\"arc-light.png\"> -- \<\/picture> -- -- /Since: 4.14/ pathBuilderArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x coordinate of first control point -> Float -- ^ /@y1@/: y coordinate of first control point -> Float -- ^ /@x2@/: x coordinate of second control point -> Float -- ^ /@y2@/: y coordinate of second control point -> m () pathBuilderArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> m () pathBuilderArcTo PathBuilder self Float x1 Float y1 Float x2 Float y2 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_arc_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderArcTo instance O.OverloadedMethodInfo PathBuilderArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderArcTo" }) #endif -- method PathBuilder::close -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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_builder_close" gsk_path_builder_close :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) IO () -- | Ends the current contour with a line back to the start point. -- -- Note that this is different from calling 'GI.Gsk.Structs.PathBuilder.pathBuilderLineTo' -- with the start point in that the contour will be closed. A closed -- contour behaves differently from an open one. When stroking, its -- start and end point are considered connected, so they will be -- joined via the line join, and not ended with line caps. -- -- /Since: 4.14/ pathBuilderClose :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> m () pathBuilderClose :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> m () pathBuilderClose PathBuilder 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr PathBuilder -> IO () gsk_path_builder_close Ptr PathBuilder self' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderCloseMethodInfo instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PathBuilderCloseMethodInfo PathBuilder signature where overloadedMethod = pathBuilderClose instance O.OverloadedMethodInfo PathBuilderCloseMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderClose", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderClose" }) #endif -- method PathBuilder::conic_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "weight" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = -- Just "weight of the control point, must be greater than zero" -- , 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_builder_conic_to" gsk_path_builder_conic_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- weight : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/Non-uniform_rational_B-spline conic curve> -- from the current point to /@x2@/, /@y2@/ with the given /@weight@/ and /@x1@/, /@y1@/ as the -- control point. -- -- The weight determines how strongly the curve is pulled towards the control point. -- A conic with weight 1 is identical to a quadratic Bézier curve with the same points. -- -- Conic curves can be used to draw ellipses and circles. They are also known as -- rational quadratic Bézier curves. -- -- After this, /@x2@/, /@y2@/ will be the new current point. -- -- \<picture> -- \<source srcset=\"conic-dark.png\" media=\"(prefers-color-scheme: dark)\"> -- \<img alt=\"Conic To\" src=\"conic-light.png\"> -- \<\/picture> -- -- /Since: 4.14/ pathBuilderConicTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x coordinate of control point -> Float -- ^ /@y1@/: y coordinate of control point -> Float -- ^ /@x2@/: x coordinate of the end of the curve -> Float -- ^ /@y2@/: y coordinate of the end of the curve -> Float -- ^ /@weight@/: weight of the control point, must be greater than zero -> m () pathBuilderConicTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderConicTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float weight = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let weight' :: CFloat weight' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float weight Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_conic_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat weight' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderConicToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderConicToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderConicTo instance O.OverloadedMethodInfo PathBuilderConicToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderConicTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderConicTo" }) #endif -- method PathBuilder::cubic_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x3" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y3" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of the end of the curve" -- , 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_builder_cubic_to" gsk_path_builder_cubic_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- x3 : TBasicType TFloat CFloat -> -- y3 : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/B%C3%A9zier_curve cubic Bézier curve> -- from the current point to /@x3@/, /@y3@/ with /@x1@/, /@y1@/ and /@x2@/, /@y2@/ as the control -- points. -- -- After this, /@x3@/, /@y3@/ will be the new current point. -- -- \<picture> -- \<source srcset=\"cubic-dark.png\" media=\"(prefers-color-scheme: dark)\"> -- \<img alt=\"Cubic To\" src=\"cubic-light.png\"> -- \<\/picture> -- -- /Since: 4.14/ pathBuilderCubicTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x coordinate of first control point -> Float -- ^ /@y1@/: y coordinate of first control point -> Float -- ^ /@x2@/: x coordinate of second control point -> Float -- ^ /@y2@/: y coordinate of second control point -> Float -- ^ /@x3@/: x coordinate of the end of the curve -> Float -- ^ /@y3@/: y coordinate of the end of the curve -> m () pathBuilderCubicTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderCubicTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float x3 Float y3 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let x3' :: CFloat x3' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x3 let y3' :: CFloat y3' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y3 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_cubic_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat x3' CFloat y3' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderCubicToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderCubicToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderCubicTo instance O.OverloadedMethodInfo PathBuilderCubicToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderCubicTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderCubicTo" }) #endif -- method PathBuilder::get_current_point -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- ] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Point" }) -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_get_current_point" gsk_path_builder_get_current_point :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) IO (Ptr Graphene.Point.Point) -- | Gets the current point. -- -- The current point is used for relative drawing commands and -- updated after every operation. -- -- When the builder is created, the default current point is set -- to @0, 0@. Note that this is different from cairo, which starts -- out without a current point. -- -- /Since: 4.14/ pathBuilderGetCurrentPoint :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> m Graphene.Point.Point -- ^ __Returns:__ The current point pathBuilderGetCurrentPoint :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> m Point pathBuilderGetCurrentPoint PathBuilder self = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Point result <- Ptr PathBuilder -> IO (Ptr Point) gsk_path_builder_get_current_point Ptr PathBuilder self' Text -> Ptr Point -> IO () forall a. HasCallStack => Text -> Ptr a -> IO () checkUnexpectedReturnNULL Text "pathBuilderGetCurrentPoint" Ptr Point result Point result' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a newBoxed ManagedPtr Point -> Point Graphene.Point.Point) Ptr Point result PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Point -> IO Point forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Point result' #if defined(ENABLE_OVERLOADING) data PathBuilderGetCurrentPointMethodInfo instance (signature ~ (m Graphene.Point.Point), MonadIO m) => O.OverloadedMethod PathBuilderGetCurrentPointMethodInfo PathBuilder signature where overloadedMethod = pathBuilderGetCurrentPoint instance O.OverloadedMethodInfo PathBuilderGetCurrentPointMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderGetCurrentPoint", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderGetCurrentPoint" }) #endif -- method PathBuilder::html_arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "radius" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Radius of the circle" -- , 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_builder_html_arc_to" gsk_path_builder_html_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- radius : TBasicType TFloat IO () -- | Implements arc-to according to the HTML Canvas spec. -- -- A convenience function that implements the -- <https://html.spec.whatwg.org/multipage/canvas.html#dom-context-2d-arcto-dev HTML arc_to> -- functionality. -- -- After this, the current point will be the point where -- the circle with the given radius touches the line from -- /@x1@/, /@y1@/ to /@x2@/, /@y2@/. -- -- /Since: 4.14/ pathBuilderHtmlArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: X coordinate of first control point -> Float -- ^ /@y1@/: Y coordinate of first control point -> Float -- ^ /@x2@/: X coordinate of second control point -> Float -- ^ /@y2@/: Y coordinate of second control point -> Float -- ^ /@radius@/: Radius of the circle -> m () pathBuilderHtmlArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderHtmlArcTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float radius = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let radius' :: CFloat radius' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float radius Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_html_arc_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat radius' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderHtmlArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderHtmlArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderHtmlArcTo instance O.OverloadedMethodInfo PathBuilderHtmlArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderHtmlArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderHtmlArcTo" }) #endif -- method PathBuilder::line_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- ] -- Lengths: [] -- returnType: Nothing -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_line_to" gsk_path_builder_line_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Draws a line from the current point to /@x@/, /@y@/ and makes it -- the new current point. -- -- \<picture> -- \<source srcset=\"line-dark.png\" media=\"(prefers-color-scheme: dark)\"> -- \<img alt=\"Line To\" src=\"line-light.png\"> -- \<\/picture> -- -- /Since: 4.14/ pathBuilderLineTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x@/: x coordinate -> Float -- ^ /@y@/: y coordinate -> m () pathBuilderLineTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> m () pathBuilderLineTo PathBuilder self Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> IO () gsk_path_builder_line_to Ptr PathBuilder self' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderLineToMethodInfo instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderLineToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderLineTo instance O.OverloadedMethodInfo PathBuilderLineToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderLineTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderLineTo" }) #endif -- method PathBuilder::move_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- ] -- Lengths: [] -- returnType: Nothing -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_move_to" gsk_path_builder_move_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Starts a new contour by placing the pen at /@x@/, /@y@/. -- -- If this function is called twice in succession, the first -- call will result in a contour made up of a single point. -- The second call will start a new contour. -- -- /Since: 4.14/ pathBuilderMoveTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x@/: x coordinate -> Float -- ^ /@y@/: y coordinate -> m () pathBuilderMoveTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> m () pathBuilderMoveTo PathBuilder self Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> IO () gsk_path_builder_move_to Ptr PathBuilder self' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderMoveToMethodInfo instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderMoveToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderMoveTo instance O.OverloadedMethodInfo PathBuilderMoveToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderMoveTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderMoveTo" }) #endif -- method PathBuilder::quad_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GskPathBuilder" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of the end of the curve" -- , 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_builder_quad_to" gsk_path_builder_quad_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/B%C3%A9zier_curve quadratic Bézier curve> -- from the current point to /@x2@/, /@y2@/ with /@x1@/, /@y1@/ as the control point. -- -- After this, /@x2@/, /@y2@/ will be the new current point. -- -- \<picture> -- \<source srcset=\"quad-dark.png\" media=\"(prefers-color-scheme: dark)\"> -- \<img alt=\"Quad To\" src=\"quad-light.png\"> -- \<\/picture> -- -- /Since: 4.14/ pathBuilderQuadTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a t'GI.Gsk.Structs.PathBuilder.PathBuilder' -> Float -- ^ /@x1@/: x coordinate of control point -> Float -- ^ /@y1@/: y coordinate of control point -> Float -- ^ /@x2@/: x coordinate of the end of the curve -> Float -- ^ /@y2@/: y coordinate of the end of the curve -> m () pathBuilderQuadTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> m () pathBuilderQuadTo PathBuilder self Float x1 Float y1 Float x2 Float y2 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_quad_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderQuadToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderQuadToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderQuadTo instance O.OverloadedMethodInfo PathBuilderQuadToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderQuadTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderQuadTo" }) #endif -- method PathBuilder::ref -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- ] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Gsk" , name = "PathBuilder" }) -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_ref" gsk_path_builder_ref :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) IO (Ptr PathBuilder) -- | Acquires a reference on the given builder. -- -- This function is intended primarily for language bindings. -- @GskPathBuilder@ objects should not be kept around. -- -- /Since: 4.14/ pathBuilderRef :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> m PathBuilder -- ^ __Returns:__ the given @GskPathBuilder@ with -- its reference count increased pathBuilderRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> m PathBuilder pathBuilderRef PathBuilder self = IO PathBuilder -> m PathBuilder forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO PathBuilder -> m PathBuilder) -> IO PathBuilder -> m PathBuilder forall a b. (a -> b) -> a -> b $ do Ptr PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr PathBuilder result <- Ptr PathBuilder -> IO (Ptr PathBuilder) gsk_path_builder_ref Ptr PathBuilder self' Text -> Ptr PathBuilder -> IO () forall a. HasCallStack => Text -> Ptr a -> IO () checkUnexpectedReturnNULL Text "pathBuilderRef" Ptr PathBuilder result PathBuilder result' <- ((ManagedPtr PathBuilder -> PathBuilder) -> Ptr PathBuilder -> IO PathBuilder forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a newBoxed ManagedPtr PathBuilder -> PathBuilder PathBuilder) Ptr PathBuilder result PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self PathBuilder -> IO PathBuilder forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return PathBuilder result' #if defined(ENABLE_OVERLOADING) data PathBuilderRefMethodInfo instance (signature ~ (m PathBuilder), MonadIO m) => O.OverloadedMethod PathBuilderRefMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRef instance O.OverloadedMethodInfo PathBuilderRefMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRef", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRef" }) #endif -- method PathBuilder::rel_arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y coordinate of second control point" -- , 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_builder_rel_arc_to" gsk_path_builder_rel_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat IO () -- | Adds an elliptical arc from the current point to /@x2@/, /@y2@/ -- with /@x1@/, /@y1@/ determining the tangent directions. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderArcTo'. -- -- /Since: 4.14/ pathBuilderRelArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x coordinate of first control point -> Float -- ^ /@y1@/: y coordinate of first control point -> Float -- ^ /@x2@/: x coordinate of second control point -> Float -- ^ /@y2@/: y coordinate of second control point -> m () pathBuilderRelArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> m () pathBuilderRelArcTo PathBuilder self Float x1 Float y1 Float x2 Float y2 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_rel_arc_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelArcTo instance O.OverloadedMethodInfo PathBuilderRelArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelArcTo" }) #endif -- method PathBuilder::rel_conic_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "weight" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = -- Just "weight of the curve, must be greater than zero" -- , 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_builder_rel_conic_to" gsk_path_builder_rel_conic_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- weight : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/Non-uniform_rational_B-spline conic curve> -- from the current point to /@x2@/, /@y2@/ with the given /@weight@/ and /@x1@/, /@y1@/ as the -- control point. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderConicTo'. -- -- /Since: 4.14/ pathBuilderRelConicTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x offset of control point -> Float -- ^ /@y1@/: y offset of control point -> Float -- ^ /@x2@/: x offset of the end of the curve -> Float -- ^ /@y2@/: y offset of the end of the curve -> Float -- ^ /@weight@/: weight of the curve, must be greater than zero -> m () pathBuilderRelConicTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderRelConicTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float weight = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let weight' :: CFloat weight' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float weight Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_rel_conic_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat weight' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelConicToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelConicToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelConicTo instance O.OverloadedMethodInfo PathBuilderRelConicToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelConicTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelConicTo" }) #endif -- method PathBuilder::rel_cubic_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x3" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y3" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of the end of the curve" -- , 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_builder_rel_cubic_to" gsk_path_builder_rel_cubic_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- x3 : TBasicType TFloat CFloat -> -- y3 : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/B%C3%A9zier_curve cubic Bézier curve> -- from the current point to /@x3@/, /@y3@/ with /@x1@/, /@y1@/ and /@x2@/, /@y2@/ as the control -- points. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderCubicTo'. -- -- /Since: 4.14/ pathBuilderRelCubicTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x offset of first control point -> Float -- ^ /@y1@/: y offset of first control point -> Float -- ^ /@x2@/: x offset of second control point -> Float -- ^ /@y2@/: y offset of second control point -> Float -- ^ /@x3@/: x offset of the end of the curve -> Float -- ^ /@y3@/: y offset of the end of the curve -> m () pathBuilderRelCubicTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderRelCubicTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float x3 Float y3 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let x3' :: CFloat x3' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x3 let y3' :: CFloat y3' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y3 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_rel_cubic_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat x3' CFloat y3' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelCubicToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelCubicToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelCubicTo instance O.OverloadedMethodInfo PathBuilderRelCubicToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelCubicTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelCubicTo" }) #endif -- method PathBuilder::rel_html_arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y coordinate of first control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y coordinate of second control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "radius" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Radius of the circle" -- , 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_builder_rel_html_arc_to" gsk_path_builder_rel_html_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat CFloat -> -- radius : TBasicType TFloat IO () -- | Implements arc-to according to the HTML Canvas spec. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderHtmlArcTo'. -- -- /Since: 4.14/ pathBuilderRelHtmlArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: X coordinate of first control point -> Float -- ^ /@y1@/: Y coordinate of first control point -> Float -- ^ /@x2@/: X coordinate of second control point -> Float -- ^ /@y2@/: Y coordinate of second control point -> Float -- ^ /@radius@/: Radius of the circle -> m () pathBuilderRelHtmlArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> Float -> m () pathBuilderRelHtmlArcTo PathBuilder self Float x1 Float y1 Float x2 Float y2 Float radius = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 let radius' :: CFloat radius' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float radius Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_rel_html_arc_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' CFloat radius' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelHtmlArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelHtmlArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelHtmlArcTo instance O.OverloadedMethodInfo PathBuilderRelHtmlArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelHtmlArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelHtmlArcTo" }) #endif -- method PathBuilder::rel_line_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset" , 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_builder_rel_line_to" gsk_path_builder_rel_line_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Draws a line from the current point to a point offset from it -- by /@x@/, /@y@/ and makes it the new current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderLineTo'. -- -- /Since: 4.14/ pathBuilderRelLineTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x@/: x offset -> Float -- ^ /@y@/: y offset -> m () pathBuilderRelLineTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> m () pathBuilderRelLineTo PathBuilder self Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> IO () gsk_path_builder_rel_line_to Ptr PathBuilder self' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelLineToMethodInfo instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelLineToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelLineTo instance O.OverloadedMethodInfo PathBuilderRelLineToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelLineTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelLineTo" }) #endif -- method PathBuilder::rel_move_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset" , 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_builder_rel_move_to" gsk_path_builder_rel_move_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Starts a new contour by placing the pen at /@x@/, /@y@/ -- relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderMoveTo'. -- -- /Since: 4.14/ pathBuilderRelMoveTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x@/: x offset -> Float -- ^ /@y@/: y offset -> m () pathBuilderRelMoveTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> m () pathBuilderRelMoveTo PathBuilder self Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> IO () gsk_path_builder_rel_move_to Ptr PathBuilder self' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelMoveToMethodInfo instance (signature ~ (Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelMoveToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelMoveTo instance O.OverloadedMethodInfo PathBuilderRelMoveToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelMoveTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelMoveTo" }) #endif -- method PathBuilder::rel_quad_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y1" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of control point" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "x offset of the end of the curve" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y2" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "y offset of the end of the curve" -- , 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_builder_rel_quad_to" gsk_path_builder_rel_quad_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- x1 : TBasicType TFloat CFloat -> -- y1 : TBasicType TFloat CFloat -> -- x2 : TBasicType TFloat CFloat -> -- y2 : TBasicType TFloat IO () -- | Adds a <https://en.wikipedia.org/wiki/B%C3%A9zier_curve quadratic Bézier curve> -- from the current point to /@x2@/, /@y2@/ with /@x1@/, /@y1@/ the control point. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderQuadTo'. -- -- /Since: 4.14/ pathBuilderRelQuadTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@x1@/: x offset of control point -> Float -- ^ /@y1@/: y offset of control point -> Float -- ^ /@x2@/: x offset of the end of the curve -> Float -- ^ /@y2@/: y offset of the end of the curve -> m () pathBuilderRelQuadTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Float -> m () pathBuilderRelQuadTo PathBuilder self Float x1 Float y1 Float x2 Float y2 = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let x1' :: CFloat x1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x1 let y1' :: CFloat y1' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y1 let x2' :: CFloat x2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x2 let y2' :: CFloat y2' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y2 Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CFloat -> IO () gsk_path_builder_rel_quad_to Ptr PathBuilder self' CFloat x1' CFloat y1' CFloat x2' CFloat y2' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelQuadToMethodInfo instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelQuadToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelQuadTo instance O.OverloadedMethodInfo PathBuilderRelQuadToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelQuadTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelQuadTo" }) #endif -- method PathBuilder::rel_svg_arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "rx" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X radius" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "ry" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y radius" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x_axis_rotation" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the rotation of the ellipsis" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "large_arc" -- , argType = TBasicType TBoolean -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "whether to add the large arc" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "positive_sweep" -- , argType = TBasicType TBoolean -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "whether to sweep in the positive direction" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the X coordinate of the endpoint" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the Y coordinate of the endpoint" -- , 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_builder_rel_svg_arc_to" gsk_path_builder_rel_svg_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- rx : TBasicType TFloat CFloat -> -- ry : TBasicType TFloat CFloat -> -- x_axis_rotation : TBasicType TFloat CInt -> -- large_arc : TBasicType TBoolean CInt -> -- positive_sweep : TBasicType TBoolean CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Implements arc-to according to the SVG spec. -- -- All coordinates are given relative to the current point. -- -- This is the relative version of 'GI.Gsk.Structs.PathBuilder.pathBuilderSvgArcTo'. -- -- /Since: 4.14/ pathBuilderRelSvgArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@rx@/: X radius -> Float -- ^ /@ry@/: Y radius -> Float -- ^ /@xAxisRotation@/: the rotation of the ellipsis -> Bool -- ^ /@largeArc@/: whether to add the large arc -> Bool -- ^ /@positiveSweep@/: whether to sweep in the positive direction -> Float -- ^ /@x@/: the X coordinate of the endpoint -> Float -- ^ /@y@/: the Y coordinate of the endpoint -> m () pathBuilderRelSvgArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> m () pathBuilderRelSvgArcTo PathBuilder self Float rx Float ry Float xAxisRotation Bool largeArc Bool positiveSweep Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let rx' :: CFloat rx' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float rx let ry' :: CFloat ry' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float ry let xAxisRotation' :: CFloat xAxisRotation' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float xAxisRotation let largeArc' :: CInt largeArc' = (Int -> CInt forall a b. (Integral a, Num b) => a -> b P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> Int forall a. Enum a => a -> Int P.fromEnum) Bool largeArc let positiveSweep' :: CInt positiveSweep' = (Int -> CInt forall a b. (Integral a, Num b) => a -> b P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> Int forall a. Enum a => a -> Int P.fromEnum) Bool positiveSweep let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CInt -> CInt -> CFloat -> CFloat -> IO () gsk_path_builder_rel_svg_arc_to Ptr PathBuilder self' CFloat rx' CFloat ry' CFloat xAxisRotation' CInt largeArc' CInt positiveSweep' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderRelSvgArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderRelSvgArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderRelSvgArcTo instance O.OverloadedMethodInfo PathBuilderRelSvgArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderRelSvgArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderRelSvgArcTo" }) #endif -- method PathBuilder::svg_arc_to -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "rx" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "X radius" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "ry" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "Y radius" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x_axis_rotation" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the rotation of the ellipsis" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "large_arc" -- , argType = TBasicType TBoolean -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "whether to add the large arc" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "positive_sweep" -- , argType = TBasicType TBoolean -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "whether to sweep in the positive direction" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "x" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the X coordinate of the endpoint" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "y" -- , argType = TBasicType TFloat -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the Y coordinate of the endpoint" -- , 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_builder_svg_arc_to" gsk_path_builder_svg_arc_to :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) CFloat -> -- rx : TBasicType TFloat CFloat -> -- ry : TBasicType TFloat CFloat -> -- x_axis_rotation : TBasicType TFloat CInt -> -- large_arc : TBasicType TBoolean CInt -> -- positive_sweep : TBasicType TBoolean CFloat -> -- x : TBasicType TFloat CFloat -> -- y : TBasicType TFloat IO () -- | Implements arc-to according to the SVG spec. -- -- A convenience function that implements the -- <https://www.w3.org/TR/SVG11/paths.html#PathDataEllipticalArcCommands SVG arc_to> -- functionality. -- -- After this, /@x@/, /@y@/ will be the new current point. -- -- /Since: 4.14/ pathBuilderSvgArcTo :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> Float -- ^ /@rx@/: X radius -> Float -- ^ /@ry@/: Y radius -> Float -- ^ /@xAxisRotation@/: the rotation of the ellipsis -> Bool -- ^ /@largeArc@/: whether to add the large arc -> Bool -- ^ /@positiveSweep@/: whether to sweep in the positive direction -> Float -- ^ /@x@/: the X coordinate of the endpoint -> Float -- ^ /@y@/: the Y coordinate of the endpoint -> m () pathBuilderSvgArcTo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> m () pathBuilderSvgArcTo PathBuilder self Float rx Float ry Float xAxisRotation Bool largeArc Bool positiveSweep Float x Float y = 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self let rx' :: CFloat rx' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float rx let ry' :: CFloat ry' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float ry let xAxisRotation' :: CFloat xAxisRotation' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float xAxisRotation let largeArc' :: CInt largeArc' = (Int -> CInt forall a b. (Integral a, Num b) => a -> b P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> Int forall a. Enum a => a -> Int P.fromEnum) Bool largeArc let positiveSweep' :: CInt positiveSweep' = (Int -> CInt forall a b. (Integral a, Num b) => a -> b P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> Int forall a. Enum a => a -> Int P.fromEnum) Bool positiveSweep let x' :: CFloat x' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float x let y' :: CFloat y' = Float -> CFloat forall a b. (Real a, Fractional b) => a -> b realToFrac Float y Ptr PathBuilder -> CFloat -> CFloat -> CFloat -> CInt -> CInt -> CFloat -> CFloat -> IO () gsk_path_builder_svg_arc_to Ptr PathBuilder self' CFloat rx' CFloat ry' CFloat xAxisRotation' CInt largeArc' CInt positiveSweep' CFloat x' CFloat y' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderSvgArcToMethodInfo instance (signature ~ (Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod PathBuilderSvgArcToMethodInfo PathBuilder signature where overloadedMethod = pathBuilderSvgArcTo instance O.OverloadedMethodInfo PathBuilderSvgArcToMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderSvgArcTo", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderSvgArcTo" }) #endif -- method PathBuilder::to_path -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- ] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Gsk" , name = "Path" }) -- throws : False -- Skip return : False foreign import ccall "gsk_path_builder_to_path" gsk_path_builder_to_path :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) IO (Ptr Gsk.Path.Path) -- | Creates a new @GskPath@ from the given builder. -- -- The given @GskPathBuilder@ is reset once this function returns; -- you cannot call this function multiple times on the same builder -- instance. -- -- This function is intended primarily for language bindings. -- C code should use t'GI.Gsk.Structs.PathBuilder.PathBuilder'.@/free_to_path/@(). -- -- /Since: 4.14/ pathBuilderToPath :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> m Gsk.Path.Path -- ^ __Returns:__ the newly created @GskPath@ -- with all the contours added to the builder pathBuilderToPath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> m Path pathBuilderToPath PathBuilder self = IO Path -> m Path forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Path -> m Path) -> IO Path -> m Path forall a b. (a -> b) -> a -> b $ do Ptr PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr Path result <- Ptr PathBuilder -> IO (Ptr Path) gsk_path_builder_to_path Ptr PathBuilder self' Text -> Ptr Path -> IO () forall a. HasCallStack => Text -> Ptr a -> IO () checkUnexpectedReturnNULL Text "pathBuilderToPath" Ptr Path result Path result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a wrapBoxed ManagedPtr Path -> Path Gsk.Path.Path) Ptr Path result PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self Path -> IO Path forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Path result' #if defined(ENABLE_OVERLOADING) data PathBuilderToPathMethodInfo instance (signature ~ (m Gsk.Path.Path), MonadIO m) => O.OverloadedMethod PathBuilderToPathMethodInfo PathBuilder signature where overloadedMethod = pathBuilderToPath instance O.OverloadedMethodInfo PathBuilderToPathMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderToPath", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderToPath" }) #endif -- method PathBuilder::unref -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "self" -- , argType = -- TInterface Name { namespace = "Gsk" , name = "PathBuilder" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a `GskPathBuilder`" , 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_builder_unref" gsk_path_builder_unref :: Ptr PathBuilder -> -- self : TInterface (Name {namespace = "Gsk", name = "PathBuilder"}) IO () -- | Releases a reference on the given builder. -- -- /Since: 4.14/ pathBuilderUnref :: (B.CallStack.HasCallStack, MonadIO m) => PathBuilder -- ^ /@self@/: a @GskPathBuilder@ -> m () pathBuilderUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => PathBuilder -> m () pathBuilderUnref PathBuilder 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 PathBuilder self' <- PathBuilder -> IO (Ptr PathBuilder) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr PathBuilder self Ptr PathBuilder -> IO () gsk_path_builder_unref Ptr PathBuilder self' PathBuilder -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr PathBuilder self () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data PathBuilderUnrefMethodInfo instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PathBuilderUnrefMethodInfo PathBuilder signature where overloadedMethod = pathBuilderUnref instance O.OverloadedMethodInfo PathBuilderUnrefMethodInfo PathBuilder where overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Gsk.Structs.PathBuilder.pathBuilderUnref", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.8/docs/GI-Gsk-Structs-PathBuilder.html#v:pathBuilderUnref" }) #endif #if defined(ENABLE_OVERLOADING) type family ResolvePathBuilderMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where ResolvePathBuilderMethod "addCairoPath" o = PathBuilderAddCairoPathMethodInfo ResolvePathBuilderMethod "addCircle" o = PathBuilderAddCircleMethodInfo ResolvePathBuilderMethod "addLayout" o = PathBuilderAddLayoutMethodInfo ResolvePathBuilderMethod "addPath" o = PathBuilderAddPathMethodInfo ResolvePathBuilderMethod "addRect" o = PathBuilderAddRectMethodInfo ResolvePathBuilderMethod "addReversePath" o = PathBuilderAddReversePathMethodInfo ResolvePathBuilderMethod "addRoundedRect" o = PathBuilderAddRoundedRectMethodInfo ResolvePathBuilderMethod "addSegment" o = PathBuilderAddSegmentMethodInfo ResolvePathBuilderMethod "arcTo" o = PathBuilderArcToMethodInfo ResolvePathBuilderMethod "close" o = PathBuilderCloseMethodInfo ResolvePathBuilderMethod "conicTo" o = PathBuilderConicToMethodInfo ResolvePathBuilderMethod "cubicTo" o = PathBuilderCubicToMethodInfo ResolvePathBuilderMethod "htmlArcTo" o = PathBuilderHtmlArcToMethodInfo ResolvePathBuilderMethod "lineTo" o = PathBuilderLineToMethodInfo ResolvePathBuilderMethod "moveTo" o = PathBuilderMoveToMethodInfo ResolvePathBuilderMethod "quadTo" o = PathBuilderQuadToMethodInfo ResolvePathBuilderMethod "ref" o = PathBuilderRefMethodInfo ResolvePathBuilderMethod "relArcTo" o = PathBuilderRelArcToMethodInfo ResolvePathBuilderMethod "relConicTo" o = PathBuilderRelConicToMethodInfo ResolvePathBuilderMethod "relCubicTo" o = PathBuilderRelCubicToMethodInfo ResolvePathBuilderMethod "relHtmlArcTo" o = PathBuilderRelHtmlArcToMethodInfo ResolvePathBuilderMethod "relLineTo" o = PathBuilderRelLineToMethodInfo ResolvePathBuilderMethod "relMoveTo" o = PathBuilderRelMoveToMethodInfo ResolvePathBuilderMethod "relQuadTo" o = PathBuilderRelQuadToMethodInfo ResolvePathBuilderMethod "relSvgArcTo" o = PathBuilderRelSvgArcToMethodInfo ResolvePathBuilderMethod "svgArcTo" o = PathBuilderSvgArcToMethodInfo ResolvePathBuilderMethod "toPath" o = PathBuilderToPathMethodInfo ResolvePathBuilderMethod "unref" o = PathBuilderUnrefMethodInfo ResolvePathBuilderMethod "getCurrentPoint" o = PathBuilderGetCurrentPointMethodInfo ResolvePathBuilderMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolvePathBuilderMethod t PathBuilder, O.OverloadedMethod info PathBuilder p) => OL.IsLabel t (PathBuilder -> 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 ~ ResolvePathBuilderMethod t PathBuilder, O.OverloadedMethod info PathBuilder p, R.HasField t PathBuilder p) => R.HasField t PathBuilder p where getField = O.overloadedMethod @info #endif instance (info ~ ResolvePathBuilderMethod t PathBuilder, O.OverloadedMethodInfo info PathBuilder) => OL.IsLabel t (O.MethodProxy info PathBuilder) where #if MIN_VERSION_base(4,10,0) fromLabel = O.MethodProxy #else fromLabel _ = O.MethodProxy #endif #endif