{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GdkCursor@ is used to create and destroy cursors.
-- 
-- Cursors are immutable objects, so once you created them, there is no way
-- to modify them later. You should create a new cursor when you want to change
-- something about it.
-- 
-- Cursors by themselves are not very interesting: they must be bound to a
-- window for users to see them. This is done with 'GI.Gdk.Objects.Surface.surfaceSetCursor'
-- or 'GI.Gdk.Objects.Surface.surfaceSetDeviceCursor'. Applications will typically
-- use higher-level GTK functions such as <http://developer.gnome.org/gdk/stable/../gtk4/method.Widget.set_cursor.html gtk_widget_set_cursor()>
-- instead.
-- 
-- Cursors are not bound to a given t'GI.Gdk.Objects.Display.Display', so they can be shared.
-- However, the appearance of cursors may vary when used on different
-- platforms.
-- 
-- == Named and texture cursors
-- 
-- There are multiple ways to create cursors. The platform\'s own cursors
-- can be created with 'GI.Gdk.Objects.Cursor.cursorNewFromName'. That function lists
-- the commonly available names that are shared with the CSS specification.
-- Other names may be available, depending on the platform in use. On some
-- platforms, what images are used for named cursors may be influenced by
-- the cursor theme.
-- 
-- Another option to create a cursor is to use 'GI.Gdk.Objects.Cursor.cursorNewFromTexture'
-- and provide an image to use for the cursor.
-- 
-- To ease work with unsupported cursors, a fallback cursor can be provided.
-- If a t'GI.Gdk.Objects.Surface.Surface' cannot use a cursor because of the reasons mentioned
-- above, it will try the fallback cursor. Fallback cursors can themselves have
-- fallback cursors again, so it is possible to provide a chain of progressively
-- easier to support cursors. If none of the provided cursors can be supported,
-- the default cursor will be the ultimate fallback.

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

module GI.Gdk.Objects.Cursor
    ( 

-- * Exported types
    Cursor(..)                              ,
    IsCursor                                ,
    toCursor                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFallback]("GI.Gdk.Objects.Cursor#g:method:getFallback"), [getHotspotX]("GI.Gdk.Objects.Cursor#g:method:getHotspotX"), [getHotspotY]("GI.Gdk.Objects.Cursor#g:method:getHotspotY"), [getName]("GI.Gdk.Objects.Cursor#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTexture]("GI.Gdk.Objects.Cursor#g:method:getTexture").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveCursorMethod                     ,
#endif

-- ** getFallback #method:getFallback#

#if defined(ENABLE_OVERLOADING)
    CursorGetFallbackMethodInfo             ,
#endif
    cursorGetFallback                       ,


-- ** getHotspotX #method:getHotspotX#

#if defined(ENABLE_OVERLOADING)
    CursorGetHotspotXMethodInfo             ,
#endif
    cursorGetHotspotX                       ,


-- ** getHotspotY #method:getHotspotY#

#if defined(ENABLE_OVERLOADING)
    CursorGetHotspotYMethodInfo             ,
#endif
    cursorGetHotspotY                       ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    CursorGetNameMethodInfo                 ,
#endif
    cursorGetName                           ,


-- ** getTexture #method:getTexture#

#if defined(ENABLE_OVERLOADING)
    CursorGetTextureMethodInfo              ,
#endif
    cursorGetTexture                        ,


-- ** newFromName #method:newFromName#

    cursorNewFromName                       ,


-- ** newFromTexture #method:newFromTexture#

    cursorNewFromTexture                    ,




 -- * Properties


-- ** fallback #attr:fallback#
-- | Cursor to fall back to if this cursor cannot be displayed.

#if defined(ENABLE_OVERLOADING)
    CursorFallbackPropertyInfo              ,
#endif
    constructCursorFallback                 ,
#if defined(ENABLE_OVERLOADING)
    cursorFallback                          ,
#endif
    getCursorFallback                       ,


-- ** hotspotX #attr:hotspotX#
-- | X position of the cursor hotspot in the cursor image.

#if defined(ENABLE_OVERLOADING)
    CursorHotspotXPropertyInfo              ,
#endif
    constructCursorHotspotX                 ,
#if defined(ENABLE_OVERLOADING)
    cursorHotspotX                          ,
#endif
    getCursorHotspotX                       ,


-- ** hotspotY #attr:hotspotY#
-- | Y position of the cursor hotspot in the cursor image.

#if defined(ENABLE_OVERLOADING)
    CursorHotspotYPropertyInfo              ,
#endif
    constructCursorHotspotY                 ,
#if defined(ENABLE_OVERLOADING)
    cursorHotspotY                          ,
#endif
    getCursorHotspotY                       ,


-- ** name #attr:name#
-- | Name of this this cursor.
-- 
-- The name will be 'P.Nothing' if the cursor was created from a texture.

#if defined(ENABLE_OVERLOADING)
    CursorNamePropertyInfo                  ,
#endif
    constructCursorName                     ,
#if defined(ENABLE_OVERLOADING)
    cursorName                              ,
#endif
    getCursorName                           ,


-- ** texture #attr:texture#
-- | The texture displayed by this cursor.
-- 
-- The texture will be 'P.Nothing' if the cursor was created from a name.

#if defined(ENABLE_OVERLOADING)
    CursorTexturePropertyInfo               ,
#endif
    constructCursorTexture                  ,
#if defined(ENABLE_OVERLOADING)
    cursorTexture                           ,
#endif
    getCursorTexture                        ,




    ) 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.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture

#endif

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

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

foreign import ccall "gdk_cursor_get_type"
    c_gdk_cursor_get_type :: IO B.Types.GType

instance B.Types.TypedObject Cursor where
    glibType :: IO GType
glibType = IO GType
c_gdk_cursor_get_type

instance B.Types.GObject Cursor

-- | Type class for types which can be safely cast to `Cursor`, for instance with `toCursor`.
class (SP.GObject o, O.IsDescendantOf Cursor o) => IsCursor o
instance (SP.GObject o, O.IsDescendantOf Cursor o) => IsCursor o

instance O.HasParentTypes Cursor
type instance O.ParentTypes Cursor = '[GObject.Object.Object]

-- | Cast to `Cursor`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toCursor :: (MIO.MonadIO m, IsCursor o) => o -> m Cursor
toCursor :: forall (m :: * -> *) o. (MonadIO m, IsCursor o) => o -> m Cursor
toCursor = IO Cursor -> m Cursor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Cursor -> m Cursor) -> (o -> IO Cursor) -> o -> m Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Cursor -> Cursor) -> o -> IO Cursor
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Cursor -> Cursor
Cursor

-- | Convert 'Cursor' 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 Cursor) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_cursor_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Cursor -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Cursor
P.Nothing = Ptr GValue -> Ptr Cursor -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Cursor
forall a. Ptr a
FP.nullPtr :: FP.Ptr Cursor)
    gvalueSet_ Ptr GValue
gv (P.Just Cursor
obj) = Cursor -> (Ptr Cursor -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Cursor
obj (Ptr GValue -> Ptr Cursor -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Cursor)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Cursor)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Cursor)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Cursor ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveCursorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCursorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCursorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCursorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCursorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCursorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCursorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCursorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCursorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCursorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCursorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCursorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCursorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCursorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCursorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCursorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCursorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCursorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCursorMethod "getFallback" o = CursorGetFallbackMethodInfo
    ResolveCursorMethod "getHotspotX" o = CursorGetHotspotXMethodInfo
    ResolveCursorMethod "getHotspotY" o = CursorGetHotspotYMethodInfo
    ResolveCursorMethod "getName" o = CursorGetNameMethodInfo
    ResolveCursorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCursorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCursorMethod "getTexture" o = CursorGetTextureMethodInfo
    ResolveCursorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCursorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCursorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCursorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "fallback"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Cursor"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@fallback@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cursor #fallback
-- @
getCursorFallback :: (MonadIO m, IsCursor o) => o -> m (Maybe Cursor)
getCursorFallback :: forall (m :: * -> *) o.
(MonadIO m, IsCursor o) =>
o -> m (Maybe Cursor)
getCursorFallback o
obj = IO (Maybe Cursor) -> m (Maybe Cursor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Cursor) -> m (Maybe Cursor))
-> IO (Maybe Cursor) -> m (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Cursor -> Cursor) -> IO (Maybe Cursor)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"fallback" ManagedPtr Cursor -> Cursor
Cursor

-- | Construct a `GValueConstruct` with valid value for the “@fallback@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCursorFallback :: (IsCursor o, MIO.MonadIO m, IsCursor a) => a -> m (GValueConstruct o)
constructCursorFallback :: forall o (m :: * -> *) a.
(IsCursor o, MonadIO m, IsCursor a) =>
a -> m (GValueConstruct o)
constructCursorFallback a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"fallback" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data CursorFallbackPropertyInfo
instance AttrInfo CursorFallbackPropertyInfo where
    type AttrAllowedOps CursorFallbackPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CursorFallbackPropertyInfo = IsCursor
    type AttrSetTypeConstraint CursorFallbackPropertyInfo = IsCursor
    type AttrTransferTypeConstraint CursorFallbackPropertyInfo = IsCursor
    type AttrTransferType CursorFallbackPropertyInfo = Cursor
    type AttrGetType CursorFallbackPropertyInfo = (Maybe Cursor)
    type AttrLabel CursorFallbackPropertyInfo = "fallback"
    type AttrOrigin CursorFallbackPropertyInfo = Cursor
    attrGet = getCursorFallback
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Cursor v
    attrConstruct = constructCursorFallback
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.fallback"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#g:attr:fallback"
        })
#endif

-- VVV Prop "hotspot-x"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@hotspot-x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cursor #hotspotX
-- @
getCursorHotspotX :: (MonadIO m, IsCursor o) => o -> m Int32
getCursorHotspotX :: forall (m :: * -> *) o. (MonadIO m, IsCursor o) => o -> m Int32
getCursorHotspotX o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"hotspot-x"

-- | Construct a `GValueConstruct` with valid value for the “@hotspot-x@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCursorHotspotX :: (IsCursor o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructCursorHotspotX :: forall o (m :: * -> *).
(IsCursor o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructCursorHotspotX Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"hotspot-x" Int32
val

#if defined(ENABLE_OVERLOADING)
data CursorHotspotXPropertyInfo
instance AttrInfo CursorHotspotXPropertyInfo where
    type AttrAllowedOps CursorHotspotXPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CursorHotspotXPropertyInfo = IsCursor
    type AttrSetTypeConstraint CursorHotspotXPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint CursorHotspotXPropertyInfo = (~) Int32
    type AttrTransferType CursorHotspotXPropertyInfo = Int32
    type AttrGetType CursorHotspotXPropertyInfo = Int32
    type AttrLabel CursorHotspotXPropertyInfo = "hotspot-x"
    type AttrOrigin CursorHotspotXPropertyInfo = Cursor
    attrGet = getCursorHotspotX
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCursorHotspotX
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.hotspotX"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#g:attr:hotspotX"
        })
#endif

-- VVV Prop "hotspot-y"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@hotspot-y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cursor #hotspotY
-- @
getCursorHotspotY :: (MonadIO m, IsCursor o) => o -> m Int32
getCursorHotspotY :: forall (m :: * -> *) o. (MonadIO m, IsCursor o) => o -> m Int32
getCursorHotspotY o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"hotspot-y"

-- | Construct a `GValueConstruct` with valid value for the “@hotspot-y@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCursorHotspotY :: (IsCursor o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructCursorHotspotY :: forall o (m :: * -> *).
(IsCursor o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructCursorHotspotY Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"hotspot-y" Int32
val

#if defined(ENABLE_OVERLOADING)
data CursorHotspotYPropertyInfo
instance AttrInfo CursorHotspotYPropertyInfo where
    type AttrAllowedOps CursorHotspotYPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CursorHotspotYPropertyInfo = IsCursor
    type AttrSetTypeConstraint CursorHotspotYPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint CursorHotspotYPropertyInfo = (~) Int32
    type AttrTransferType CursorHotspotYPropertyInfo = Int32
    type AttrGetType CursorHotspotYPropertyInfo = Int32
    type AttrLabel CursorHotspotYPropertyInfo = "hotspot-y"
    type AttrOrigin CursorHotspotYPropertyInfo = Cursor
    attrGet = getCursorHotspotY
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCursorHotspotY
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.hotspotY"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#g:attr:hotspotY"
        })
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cursor #name
-- @
getCursorName :: (MonadIO m, IsCursor o) => o -> m (Maybe T.Text)
getCursorName :: forall (m :: * -> *) o.
(MonadIO m, IsCursor o) =>
o -> m (Maybe Text)
getCursorName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCursorName :: (IsCursor o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCursorName :: forall o (m :: * -> *).
(IsCursor o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructCursorName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data CursorNamePropertyInfo
instance AttrInfo CursorNamePropertyInfo where
    type AttrAllowedOps CursorNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CursorNamePropertyInfo = IsCursor
    type AttrSetTypeConstraint CursorNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CursorNamePropertyInfo = (~) T.Text
    type AttrTransferType CursorNamePropertyInfo = T.Text
    type AttrGetType CursorNamePropertyInfo = (Maybe T.Text)
    type AttrLabel CursorNamePropertyInfo = "name"
    type AttrOrigin CursorNamePropertyInfo = Cursor
    attrGet = getCursorName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCursorName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#g:attr:name"
        })
#endif

-- VVV Prop "texture"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Texture"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@texture@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cursor #texture
-- @
getCursorTexture :: (MonadIO m, IsCursor o) => o -> m (Maybe Gdk.Texture.Texture)
getCursorTexture :: forall (m :: * -> *) o.
(MonadIO m, IsCursor o) =>
o -> m (Maybe Texture)
getCursorTexture o
obj = IO (Maybe Texture) -> m (Maybe Texture)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Texture) -> m (Maybe Texture))
-> IO (Maybe Texture) -> m (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Texture -> Texture) -> IO (Maybe Texture)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"texture" ManagedPtr Texture -> Texture
Gdk.Texture.Texture

-- | Construct a `GValueConstruct` with valid value for the “@texture@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCursorTexture :: (IsCursor o, MIO.MonadIO m, Gdk.Texture.IsTexture a) => a -> m (GValueConstruct o)
constructCursorTexture :: forall o (m :: * -> *) a.
(IsCursor o, MonadIO m, IsTexture a) =>
a -> m (GValueConstruct o)
constructCursorTexture a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"texture" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data CursorTexturePropertyInfo
instance AttrInfo CursorTexturePropertyInfo where
    type AttrAllowedOps CursorTexturePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CursorTexturePropertyInfo = IsCursor
    type AttrSetTypeConstraint CursorTexturePropertyInfo = Gdk.Texture.IsTexture
    type AttrTransferTypeConstraint CursorTexturePropertyInfo = Gdk.Texture.IsTexture
    type AttrTransferType CursorTexturePropertyInfo = Gdk.Texture.Texture
    type AttrGetType CursorTexturePropertyInfo = (Maybe Gdk.Texture.Texture)
    type AttrLabel CursorTexturePropertyInfo = "texture"
    type AttrOrigin CursorTexturePropertyInfo = Cursor
    attrGet = getCursorTexture
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Texture.Texture v
    attrConstruct = constructCursorTexture
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.texture"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#g:attr:texture"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Cursor
type instance O.AttributeList Cursor = CursorAttributeList
type CursorAttributeList = ('[ '("fallback", CursorFallbackPropertyInfo), '("hotspotX", CursorHotspotXPropertyInfo), '("hotspotY", CursorHotspotYPropertyInfo), '("name", CursorNamePropertyInfo), '("texture", CursorTexturePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
cursorFallback :: AttrLabelProxy "fallback"
cursorFallback = AttrLabelProxy

cursorHotspotX :: AttrLabelProxy "hotspotX"
cursorHotspotX = AttrLabelProxy

cursorHotspotY :: AttrLabelProxy "hotspotY"
cursorHotspotY = AttrLabelProxy

cursorName :: AttrLabelProxy "name"
cursorName = AttrLabelProxy

cursorTexture :: AttrLabelProxy "texture"
cursorTexture = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Cursor = CursorSignalList
type CursorSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Cursor::new_from_name
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the cursor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fallback"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Cursor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%NULL or the `GdkCursor` to fall back to when\n  this one cannot be supported"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Cursor" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cursor_new_from_name" gdk_cursor_new_from_name :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr Cursor ->                           -- fallback : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO (Ptr Cursor)

-- | Creates a new cursor by looking up /@name@/ in the current cursor
-- theme.
-- 
-- A recommended set of cursor names that will work across different
-- platforms can be found in the CSS specification:
-- 
-- | | | | |
-- | --- | --- | ---- | --- |
-- | \"none\" | <<http://developer.gnome.org/gdk/stable/default_cursor.png>> \"default\" | <<http://developer.gnome.org/gdk/stable/help_cursor.png>> \"help\" | <<http://developer.gnome.org/gdk/stable/pointer_cursor.png>> \"pointer\" |
-- | <<http://developer.gnome.org/gdk/stable/context_menu_cursor.png>> \"context-menu\" | <<http://developer.gnome.org/gdk/stable/progress_cursor.png>> \"progress\" | <<http://developer.gnome.org/gdk/stable/wait_cursor.png>> \"wait\" | <<http://developer.gnome.org/gdk/stable/cell_cursor.png>> \"cell\" |
-- | <<http://developer.gnome.org/gdk/stable/crosshair_cursor.png>> \"crosshair\" | <<http://developer.gnome.org/gdk/stable/text_cursor.png>> \"text\" | <<http://developer.gnome.org/gdk/stable/vertical_text_cursor.png>> \"vertical-text\" | <<http://developer.gnome.org/gdk/stable/alias_cursor.png>> \"alias\" |
-- | <<http://developer.gnome.org/gdk/stable/copy_cursor.png>> \"copy\" | <<http://developer.gnome.org/gdk/stable/no_drop_cursor.png>> \"no-drop\" | <<http://developer.gnome.org/gdk/stable/move_cursor.png>> \"move\" | <<http://developer.gnome.org/gdk/stable/not_allowed_cursor.png>> \"not-allowed\" |
-- | <<http://developer.gnome.org/gdk/stable/grab_cursor.png>> \"grab\" | <<http://developer.gnome.org/gdk/stable/grabbing_cursor.png>> \"grabbing\" | <<http://developer.gnome.org/gdk/stable/all_scroll_cursor.png>> \"all-scroll\" | <<http://developer.gnome.org/gdk/stable/col_resize_cursor.png>> \"col-resize\" |
-- | <<http://developer.gnome.org/gdk/stable/row_resize_cursor.png>> \"row-resize\" | <<http://developer.gnome.org/gdk/stable/n_resize_cursor.png>> \"n-resize\" | <<http://developer.gnome.org/gdk/stable/e_resize_cursor.png>> \"e-resize\" | <<http://developer.gnome.org/gdk/stable/s_resize_cursor.png>> \"s-resize\" |
-- | <<http://developer.gnome.org/gdk/stable/w_resize_cursor.png>> \"w-resize\" | <<http://developer.gnome.org/gdk/stable/ne_resize_cursor.png>> \"ne-resize\" | <<http://developer.gnome.org/gdk/stable/nw_resize_cursor.png>> \"nw-resize\" | <<http://developer.gnome.org/gdk/stable/sw_resize_cursor.png>> \"sw-resize\" |
-- | <<http://developer.gnome.org/gdk/stable/se_resize_cursor.png>> \"se-resize\" | <<http://developer.gnome.org/gdk/stable/ew_resize_cursor.png>> \"ew-resize\" | <<http://developer.gnome.org/gdk/stable/ns_resize_cursor.png>> \"ns-resize\" | <<http://developer.gnome.org/gdk/stable/nesw_resize_cursor.png>> \"nesw-resize\" |
-- | <<http://developer.gnome.org/gdk/stable/nwse_resize_cursor.png>> \"nwse-resize\" | <<http://developer.gnome.org/gdk/stable/zoom_in_cursor.png>> \"zoom-in\" | <<http://developer.gnome.org/gdk/stable/zoom_out_cursor.png>> \"zoom-out\" | |
cursorNewFromName ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    T.Text
    -- ^ /@name@/: the name of the cursor
    -> Maybe (a)
    -- ^ /@fallback@/: 'P.Nothing' or the @GdkCursor@ to fall back to when
    --   this one cannot be supported
    -> m (Maybe Cursor)
    -- ^ __Returns:__ a new @GdkCursor@, or 'P.Nothing' if there is no
    --   cursor with the given name
cursorNewFromName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
Text -> Maybe a -> m (Maybe Cursor)
cursorNewFromName Text
name Maybe a
fallback = IO (Maybe Cursor) -> m (Maybe Cursor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Cursor) -> m (Maybe Cursor))
-> IO (Maybe Cursor) -> m (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ do
    name' <- Text -> IO CString
textToCString Text
name
    maybeFallback <- case fallback of
        Maybe a
Nothing -> Ptr Cursor -> IO (Ptr Cursor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
forall a. Ptr a
FP.nullPtr
        Just a
jFallback -> do
            jFallback' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFallback
            return jFallback'
    result <- gdk_cursor_new_from_name name' maybeFallback
    maybeResult <- convertIfNonNull result $ \Ptr Cursor
result' -> do
        result'' <- ((ManagedPtr Cursor -> Cursor) -> Ptr Cursor -> IO Cursor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Cursor -> Cursor
Cursor) Ptr Cursor
result'
        return result''
    whenJust fallback touchManagedPtr
    freeMem name'
    return maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Cursor::new_from_texture
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the texture providing the pixel data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hotspot_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the horizontal offset of the \8220hotspot\8221 of the cursor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hotspot_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the vertical offset of the \8220hotspot\8221 of the cursor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fallback"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Cursor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the `GdkCursor` to fall back to when\n  this one cannot be supported"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Cursor" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cursor_new_from_texture" gdk_cursor_new_from_texture :: 
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    Int32 ->                                -- hotspot_x : TBasicType TInt
    Int32 ->                                -- hotspot_y : TBasicType TInt
    Ptr Cursor ->                           -- fallback : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO (Ptr Cursor)

-- | Creates a new cursor from a @GdkTexture@.
cursorNewFromTexture ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Texture.IsTexture a, IsCursor b) =>
    a
    -- ^ /@texture@/: the texture providing the pixel data
    -> Int32
    -- ^ /@hotspotX@/: the horizontal offset of the “hotspot” of the cursor
    -> Int32
    -- ^ /@hotspotY@/: the vertical offset of the “hotspot” of the cursor
    -> Maybe (b)
    -- ^ /@fallback@/: the @GdkCursor@ to fall back to when
    --   this one cannot be supported
    -> m Cursor
    -- ^ __Returns:__ a new @GdkCursor@
cursorNewFromTexture :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTexture a, IsCursor b) =>
a -> Int32 -> Int32 -> Maybe b -> m Cursor
cursorNewFromTexture a
texture Int32
hotspotX Int32
hotspotY Maybe b
fallback = IO Cursor -> m Cursor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cursor -> m Cursor) -> IO Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ do
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    maybeFallback <- case fallback of
        Maybe b
Nothing -> Ptr Cursor -> IO (Ptr Cursor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
forall a. Ptr a
FP.nullPtr
        Just b
jFallback -> do
            jFallback' <- b -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFallback
            return jFallback'
    result <- gdk_cursor_new_from_texture texture' hotspotX hotspotY maybeFallback
    checkUnexpectedReturnNULL "cursorNewFromTexture" result
    result' <- (wrapObject Cursor) result
    touchManagedPtr texture
    whenJust fallback touchManagedPtr
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gdk_cursor_get_fallback" gdk_cursor_get_fallback :: 
    Ptr Cursor ->                           -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO (Ptr Cursor)

-- | Returns the fallback for this /@cursor@/.
-- 
-- The fallback will be used if this cursor is not available on a given
-- @GdkDisplay@. For named cursors, this can happen when using nonstandard
-- names or when using an incomplete cursor theme. For textured cursors,
-- this can happen when the texture is too large or when the @GdkDisplay@
-- it is used on does not support textured cursors.
cursorGetFallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a @GdkCursor@
    -> m (Maybe Cursor)
    -- ^ __Returns:__ the fallback of the cursor or 'P.Nothing'
    --   to use the default cursor as fallback
cursorGetFallback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
a -> m (Maybe Cursor)
cursorGetFallback a
cursor = IO (Maybe Cursor) -> m (Maybe Cursor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Cursor) -> m (Maybe Cursor))
-> IO (Maybe Cursor) -> m (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ do
    cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    result <- gdk_cursor_get_fallback cursor'
    maybeResult <- convertIfNonNull result $ \Ptr Cursor
result' -> do
        result'' <- ((ManagedPtr Cursor -> Cursor) -> Ptr Cursor -> IO Cursor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Cursor -> Cursor
Cursor) Ptr Cursor
result'
        return result''
    touchManagedPtr cursor
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CursorGetFallbackMethodInfo
instance (signature ~ (m (Maybe Cursor)), MonadIO m, IsCursor a) => O.OverloadedMethod CursorGetFallbackMethodInfo a signature where
    overloadedMethod = cursorGetFallback

instance O.OverloadedMethodInfo CursorGetFallbackMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.cursorGetFallback",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetFallback"
        })


#endif

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

foreign import ccall "gdk_cursor_get_hotspot_x" gdk_cursor_get_hotspot_x :: 
    Ptr Cursor ->                           -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO Int32

-- | Returns the horizontal offset of the hotspot.
-- 
-- The hotspot indicates the pixel that will be directly above the cursor.
-- 
-- Note that named cursors may have a nonzero hotspot, but this function
-- will only return the hotspot position for cursors created with
-- 'GI.Gdk.Objects.Cursor.cursorNewFromTexture'.
cursorGetHotspotX ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a @GdkCursor@
    -> m Int32
    -- ^ __Returns:__ the horizontal offset of the hotspot or 0 for named cursors
cursorGetHotspotX :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
a -> m Int32
cursorGetHotspotX a
cursor = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    result <- gdk_cursor_get_hotspot_x cursor'
    touchManagedPtr cursor
    return result

#if defined(ENABLE_OVERLOADING)
data CursorGetHotspotXMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsCursor a) => O.OverloadedMethod CursorGetHotspotXMethodInfo a signature where
    overloadedMethod = cursorGetHotspotX

instance O.OverloadedMethodInfo CursorGetHotspotXMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.cursorGetHotspotX",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetHotspotX"
        })


#endif

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

foreign import ccall "gdk_cursor_get_hotspot_y" gdk_cursor_get_hotspot_y :: 
    Ptr Cursor ->                           -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO Int32

-- | Returns the vertical offset of the hotspot.
-- 
-- The hotspot indicates the pixel that will be directly above the cursor.
-- 
-- Note that named cursors may have a nonzero hotspot, but this function
-- will only return the hotspot position for cursors created with
-- 'GI.Gdk.Objects.Cursor.cursorNewFromTexture'.
cursorGetHotspotY ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a @GdkCursor@
    -> m Int32
    -- ^ __Returns:__ the vertical offset of the hotspot or 0 for named cursors
cursorGetHotspotY :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
a -> m Int32
cursorGetHotspotY a
cursor = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    result <- gdk_cursor_get_hotspot_y cursor'
    touchManagedPtr cursor
    return result

#if defined(ENABLE_OVERLOADING)
data CursorGetHotspotYMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsCursor a) => O.OverloadedMethod CursorGetHotspotYMethodInfo a signature where
    overloadedMethod = cursorGetHotspotY

instance O.OverloadedMethodInfo CursorGetHotspotYMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.cursorGetHotspotY",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetHotspotY"
        })


#endif

-- method Cursor::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cursor"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Cursor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkCursor`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cursor_get_name" gdk_cursor_get_name :: 
    Ptr Cursor ->                           -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO CString

-- | Returns the name of the cursor.
-- 
-- If the cursor is not a named cursor, 'P.Nothing' will be returned.
cursorGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a @GdkCursor@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the cursor or 'P.Nothing'
    --   if it is not a named cursor
cursorGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
a -> m (Maybe Text)
cursorGetName a
cursor = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    result <- gdk_cursor_get_name cursor'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr cursor
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CursorGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsCursor a) => O.OverloadedMethod CursorGetNameMethodInfo a signature where
    overloadedMethod = cursorGetName

instance O.OverloadedMethodInfo CursorGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.cursorGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetName"
        })


#endif

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

foreign import ccall "gdk_cursor_get_texture" gdk_cursor_get_texture :: 
    Ptr Cursor ->                           -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO (Ptr Gdk.Texture.Texture)

-- | Returns the texture for the cursor.
-- 
-- If the cursor is a named cursor, 'P.Nothing' will be returned.
cursorGetTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a @GdkCursor@
    -> m (Maybe Gdk.Texture.Texture)
    -- ^ __Returns:__ the texture for cursor or 'P.Nothing'
    --   if it is a named cursor
cursorGetTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCursor a) =>
a -> m (Maybe Texture)
cursorGetTexture a
cursor = IO (Maybe Texture) -> m (Maybe Texture)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Texture) -> m (Maybe Texture))
-> IO (Maybe Texture) -> m (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ do
    cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    result <- gdk_cursor_get_texture cursor'
    maybeResult <- convertIfNonNull result $ \Ptr Texture
result' -> do
        result'' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Texture -> Texture
Gdk.Texture.Texture) Ptr Texture
result'
        return result''
    touchManagedPtr cursor
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data CursorGetTextureMethodInfo
instance (signature ~ (m (Maybe Gdk.Texture.Texture)), MonadIO m, IsCursor a) => O.OverloadedMethod CursorGetTextureMethodInfo a signature where
    overloadedMethod = cursorGetTexture

instance O.OverloadedMethodInfo CursorGetTextureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Cursor.cursorGetTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetTexture"
        })


#endif