{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gdk.Objects.Cursor.Cursor' represents a cursor. Its contents are private.
-- 
-- Cursors are immutable objects, so they can not change after
-- they have been constructed.

#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#
-- | /No description available in the introspection data./

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


-- ** hotspotX #attr:hotspotX#
-- | /No description available in the introspection data./

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


-- ** hotspotY #attr:hotspotY#
-- | /No description available in the introspection data./

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


-- ** name #attr:name#
-- | /No description available in the introspection data./

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


-- ** texture #attr:texture#
-- | /No description available in the introspection data./

#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.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.Text as T
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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture

-- | 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
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: 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 (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 Cursor
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 Cursor
ptr Ptr Cursor -> Ptr Cursor -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Cursor
forall a. Ptr a
FP.nullPtr
        then Cursor -> Maybe Cursor
forall a. a -> Maybe a
P.Just (Cursor -> Maybe Cursor) -> IO Cursor -> IO (Maybe Cursor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Cursor -> Cursor) -> Ptr Cursor -> IO Cursor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Cursor -> Cursor
Cursor Ptr Cursor
ptr
        else Maybe Cursor -> IO (Maybe Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cursor
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveCursorMethod (t :: Symbol) (o :: *) :: * 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 (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 (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 (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
#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 (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 (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 (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
#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 (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 (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 (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
#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 (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 (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 (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
#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 (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 (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 (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
#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, *)])
#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, *)])

#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
--           , 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
--           , 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 t'GI.Gdk.Objects.Cursor.Cursor' to fall back to when
    --     this one cannot be supported
    -> m (Maybe Cursor)
    -- ^ __Returns:__ a new t'GI.Gdk.Objects.Cursor.Cursor', 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 (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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cursor
maybeFallback <- case Maybe a
fallback of
        Maybe a
Nothing -> Ptr Cursor -> IO (Ptr Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
forall a. Ptr a
nullPtr
        Just a
jFallback -> do
            Ptr Cursor
jFallback' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFallback
            Ptr Cursor -> IO (Ptr Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
jFallback'
    Ptr Cursor
result <- CString -> Ptr Cursor -> IO (Ptr Cursor)
gdk_cursor_new_from_name CString
name' Ptr Cursor
maybeFallback
    Maybe Cursor
maybeResult <- Ptr Cursor -> (Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Cursor
result ((Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor))
-> (Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ \Ptr Cursor
result' -> do
        Cursor
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'
        Cursor -> IO Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
fallback a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe Cursor -> IO (Maybe Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cursor
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
--           , 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
--           , 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
--           , 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
--           , 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 t'GI.Gdk.Objects.Texture.Texture'.
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@/: 'P.Nothing' or the t'GI.Gdk.Objects.Cursor.Cursor' to fall back to when
    --     this one cannot be supported
    -> m Cursor
    -- ^ __Returns:__ a new t'GI.Gdk.Objects.Cursor.Cursor'.
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 (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
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Ptr Cursor
maybeFallback <- case Maybe b
fallback of
        Maybe b
Nothing -> Ptr Cursor -> IO (Ptr Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
forall a. Ptr a
nullPtr
        Just b
jFallback -> do
            Ptr Cursor
jFallback' <- b -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFallback
            Ptr Cursor -> IO (Ptr Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cursor
jFallback'
    Ptr Cursor
result <- Ptr Texture -> Int32 -> Int32 -> Ptr Cursor -> IO (Ptr Cursor)
gdk_cursor_new_from_texture Ptr Texture
texture' Int32
hotspotX Int32
hotspotY Ptr Cursor
maybeFallback
    Text -> Ptr Cursor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cursorNewFromTexture" Ptr Cursor
result
    Cursor
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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
fallback b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Cursor -> IO Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
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
--           , 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 t'GI.Gdk.Objects.Display.Display'.
-- 
-- 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 t'GI.Gdk.Objects.Display.Display' it is used on does not support textured cursors.
cursorGetFallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsCursor a) =>
    a
    -- ^ /@cursor@/: a t'GI.Gdk.Objects.Cursor.Cursor'.
    -> 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 (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
    Ptr Cursor
cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    Ptr Cursor
result <- Ptr Cursor -> IO (Ptr Cursor)
gdk_cursor_get_fallback Ptr Cursor
cursor'
    Maybe Cursor
maybeResult <- Ptr Cursor -> (Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Cursor
result ((Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor))
-> (Ptr Cursor -> IO Cursor) -> IO (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ \Ptr Cursor
result' -> do
        Cursor
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'
        Cursor -> IO Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cursor
    Maybe Cursor -> IO (Maybe Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cursor
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 = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Cursor.cursorGetFallback",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/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
--           , 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 t'GI.Gdk.Objects.Cursor.Cursor'.
    -> 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cursor
cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    Int32
result <- Ptr Cursor -> IO Int32
gdk_cursor_get_hotspot_x Ptr Cursor
cursor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cursor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
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 = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Cursor.cursorGetHotspotX",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/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
--           , 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 t'GI.Gdk.Objects.Cursor.Cursor'.
    -> 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cursor
cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    Int32
result <- Ptr Cursor -> IO Int32
gdk_cursor_get_hotspot_y Ptr Cursor
cursor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cursor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
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 = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Cursor.cursorGetHotspotY",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/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
--           , 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 t'GI.Gdk.Objects.Cursor.Cursor'.
    -> 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 (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
    Ptr Cursor
cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    CString
result <- Ptr Cursor -> IO CString
gdk_cursor_get_name Ptr Cursor
cursor'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cursor
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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 = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Cursor.cursorGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/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
--           , 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 t'GI.Gdk.Objects.Cursor.Cursor'.
    -> 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 (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
    Ptr Cursor
cursor' <- a -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cursor
    Ptr Texture
result <- Ptr Cursor -> IO (Ptr Texture)
gdk_cursor_get_texture Ptr Cursor
cursor'
    Maybe Texture
maybeResult <- Ptr Texture -> (Ptr Texture -> IO Texture) -> IO (Maybe Texture)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Texture
result ((Ptr Texture -> IO Texture) -> IO (Maybe Texture))
-> (Ptr Texture -> IO Texture) -> IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \Ptr Texture
result' -> do
        Texture
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'
        Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cursor
    Maybe Texture -> IO (Maybe Texture)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Texture
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 = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Cursor.cursorGetTexture",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Cursor.html#v:cursorGetTexture"
        }


#endif