{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GdkSurface@ is a rectangular region on the screen.
-- 
-- It’s a low-level object, used to implement high-level objects
-- such as <http://developer.gnome.org/gdk/stable/../gtk4/class.Window.html GtkWindow>.
-- 
-- The surfaces you see in practice are either t'GI.Gdk.Interfaces.Toplevel.Toplevel' or
-- t'GI.Gdk.Interfaces.Popup.Popup', and those interfaces provide much of the required
-- API to interact with these surfaces. Other, more specialized surface
-- types exist, but you will rarely interact with them directly.

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

module GI.Gdk.Objects.Surface
    ( 

-- * Exported types
    Surface(..)                             ,
    IsSurface                               ,
    toSurface                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [beep]("GI.Gdk.Objects.Surface#g:method:beep"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [createCairoContext]("GI.Gdk.Objects.Surface#g:method:createCairoContext"), [createGlContext]("GI.Gdk.Objects.Surface#g:method:createGlContext"), [createSimilarSurface]("GI.Gdk.Objects.Surface#g:method:createSimilarSurface"), [createVulkanContext]("GI.Gdk.Objects.Surface#g:method:createVulkanContext"), [destroy]("GI.Gdk.Objects.Surface#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hide]("GI.Gdk.Objects.Surface#g:method:hide"), [isDestroyed]("GI.Gdk.Objects.Surface#g:method:isDestroyed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queueRender]("GI.Gdk.Objects.Surface#g:method:queueRender"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [requestLayout]("GI.Gdk.Objects.Surface#g:method:requestLayout"), [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"), [translateCoordinates]("GI.Gdk.Objects.Surface#g:method:translateCoordinates"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCursor]("GI.Gdk.Objects.Surface#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeviceCursor]("GI.Gdk.Objects.Surface#g:method:getDeviceCursor"), [getDevicePosition]("GI.Gdk.Objects.Surface#g:method:getDevicePosition"), [getDisplay]("GI.Gdk.Objects.Surface#g:method:getDisplay"), [getFrameClock]("GI.Gdk.Objects.Surface#g:method:getFrameClock"), [getHeight]("GI.Gdk.Objects.Surface#g:method:getHeight"), [getMapped]("GI.Gdk.Objects.Surface#g:method:getMapped"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScale]("GI.Gdk.Objects.Surface#g:method:getScale"), [getScaleFactor]("GI.Gdk.Objects.Surface#g:method:getScaleFactor"), [getWidth]("GI.Gdk.Objects.Surface#g:method:getWidth").
-- 
-- ==== Setters
-- [setCursor]("GI.Gdk.Objects.Surface#g:method:setCursor"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDeviceCursor]("GI.Gdk.Objects.Surface#g:method:setDeviceCursor"), [setInputRegion]("GI.Gdk.Objects.Surface#g:method:setInputRegion"), [setOpaqueRegion]("GI.Gdk.Objects.Surface#g:method:setOpaqueRegion"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSurfaceMethod                    ,
#endif

-- ** beep #method:beep#

#if defined(ENABLE_OVERLOADING)
    SurfaceBeepMethodInfo                   ,
#endif
    surfaceBeep                             ,


-- ** createCairoContext #method:createCairoContext#

#if defined(ENABLE_OVERLOADING)
    SurfaceCreateCairoContextMethodInfo     ,
#endif
    surfaceCreateCairoContext               ,


-- ** createGlContext #method:createGlContext#

#if defined(ENABLE_OVERLOADING)
    SurfaceCreateGlContextMethodInfo        ,
#endif
    surfaceCreateGlContext                  ,


-- ** createSimilarSurface #method:createSimilarSurface#

#if defined(ENABLE_OVERLOADING)
    SurfaceCreateSimilarSurfaceMethodInfo   ,
#endif
    surfaceCreateSimilarSurface             ,


-- ** createVulkanContext #method:createVulkanContext#

#if defined(ENABLE_OVERLOADING)
    SurfaceCreateVulkanContextMethodInfo    ,
#endif
    surfaceCreateVulkanContext              ,


-- ** destroy #method:destroy#

#if defined(ENABLE_OVERLOADING)
    SurfaceDestroyMethodInfo                ,
#endif
    surfaceDestroy                          ,


-- ** getCursor #method:getCursor#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetCursorMethodInfo              ,
#endif
    surfaceGetCursor                        ,


-- ** getDeviceCursor #method:getDeviceCursor#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetDeviceCursorMethodInfo        ,
#endif
    surfaceGetDeviceCursor                  ,


-- ** getDevicePosition #method:getDevicePosition#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetDevicePositionMethodInfo      ,
#endif
    surfaceGetDevicePosition                ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetDisplayMethodInfo             ,
#endif
    surfaceGetDisplay                       ,


-- ** getFrameClock #method:getFrameClock#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetFrameClockMethodInfo          ,
#endif
    surfaceGetFrameClock                    ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetHeightMethodInfo              ,
#endif
    surfaceGetHeight                        ,


-- ** getMapped #method:getMapped#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetMappedMethodInfo              ,
#endif
    surfaceGetMapped                        ,


-- ** getScale #method:getScale#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetScaleMethodInfo               ,
#endif
    surfaceGetScale                         ,


-- ** getScaleFactor #method:getScaleFactor#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetScaleFactorMethodInfo         ,
#endif
    surfaceGetScaleFactor                   ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    SurfaceGetWidthMethodInfo               ,
#endif
    surfaceGetWidth                         ,


-- ** hide #method:hide#

#if defined(ENABLE_OVERLOADING)
    SurfaceHideMethodInfo                   ,
#endif
    surfaceHide                             ,


-- ** isDestroyed #method:isDestroyed#

#if defined(ENABLE_OVERLOADING)
    SurfaceIsDestroyedMethodInfo            ,
#endif
    surfaceIsDestroyed                      ,


-- ** newPopup #method:newPopup#

    surfaceNewPopup                         ,


-- ** newToplevel #method:newToplevel#

    surfaceNewToplevel                      ,


-- ** queueRender #method:queueRender#

#if defined(ENABLE_OVERLOADING)
    SurfaceQueueRenderMethodInfo            ,
#endif
    surfaceQueueRender                      ,


-- ** requestLayout #method:requestLayout#

#if defined(ENABLE_OVERLOADING)
    SurfaceRequestLayoutMethodInfo          ,
#endif
    surfaceRequestLayout                    ,


-- ** setCursor #method:setCursor#

#if defined(ENABLE_OVERLOADING)
    SurfaceSetCursorMethodInfo              ,
#endif
    surfaceSetCursor                        ,


-- ** setDeviceCursor #method:setDeviceCursor#

#if defined(ENABLE_OVERLOADING)
    SurfaceSetDeviceCursorMethodInfo        ,
#endif
    surfaceSetDeviceCursor                  ,


-- ** setInputRegion #method:setInputRegion#

#if defined(ENABLE_OVERLOADING)
    SurfaceSetInputRegionMethodInfo         ,
#endif
    surfaceSetInputRegion                   ,


-- ** setOpaqueRegion #method:setOpaqueRegion#

#if defined(ENABLE_OVERLOADING)
    SurfaceSetOpaqueRegionMethodInfo        ,
#endif
    surfaceSetOpaqueRegion                  ,


-- ** translateCoordinates #method:translateCoordinates#

#if defined(ENABLE_OVERLOADING)
    SurfaceTranslateCoordinatesMethodInfo   ,
#endif
    surfaceTranslateCoordinates             ,




 -- * Properties


-- ** cursor #attr:cursor#
-- | The mouse pointer for the @GdkSurface@.

#if defined(ENABLE_OVERLOADING)
    SurfaceCursorPropertyInfo               ,
#endif
    clearSurfaceCursor                      ,
    constructSurfaceCursor                  ,
    getSurfaceCursor                        ,
    setSurfaceCursor                        ,
#if defined(ENABLE_OVERLOADING)
    surfaceCursor                           ,
#endif


-- ** display #attr:display#
-- | The @GdkDisplay@ connection of the surface.

#if defined(ENABLE_OVERLOADING)
    SurfaceDisplayPropertyInfo              ,
#endif
    constructSurfaceDisplay                 ,
    getSurfaceDisplay                       ,
#if defined(ENABLE_OVERLOADING)
    surfaceDisplay                          ,
#endif


-- ** frameClock #attr:frameClock#
-- | The @GdkFrameClock@ of the surface.

#if defined(ENABLE_OVERLOADING)
    SurfaceFrameClockPropertyInfo           ,
#endif
    constructSurfaceFrameClock              ,
    getSurfaceFrameClock                    ,
#if defined(ENABLE_OVERLOADING)
    surfaceFrameClock                       ,
#endif


-- ** height #attr:height#
-- | The height of the surface, in pixels.

#if defined(ENABLE_OVERLOADING)
    SurfaceHeightPropertyInfo               ,
#endif
    getSurfaceHeight                        ,
#if defined(ENABLE_OVERLOADING)
    surfaceHeight                           ,
#endif


-- ** mapped #attr:mapped#
-- | Whether the surface is mapped.

#if defined(ENABLE_OVERLOADING)
    SurfaceMappedPropertyInfo               ,
#endif
    getSurfaceMapped                        ,
#if defined(ENABLE_OVERLOADING)
    surfaceMapped                           ,
#endif


-- ** scale #attr:scale#
-- | The scale of the surface.
-- 
-- /Since: 4.12/

#if defined(ENABLE_OVERLOADING)
    SurfaceScalePropertyInfo                ,
#endif
    getSurfaceScale                         ,
#if defined(ENABLE_OVERLOADING)
    surfaceScale                            ,
#endif


-- ** scaleFactor #attr:scaleFactor#
-- | The scale factor of the surface.
-- 
-- The scale factor is the next larger integer,
-- compared to [Surface:scale]("GI.Gdk.Objects.Surface#g:attr:scale").

#if defined(ENABLE_OVERLOADING)
    SurfaceScaleFactorPropertyInfo          ,
#endif
    getSurfaceScaleFactor                   ,
#if defined(ENABLE_OVERLOADING)
    surfaceScaleFactor                      ,
#endif


-- ** width #attr:width#
-- | The width of the surface in pixels.

#if defined(ENABLE_OVERLOADING)
    SurfaceWidthPropertyInfo                ,
#endif
    getSurfaceWidth                         ,
#if defined(ENABLE_OVERLOADING)
    surfaceWidth                            ,
#endif




 -- * Signals


-- ** enterMonitor #signal:enterMonitor#

    SurfaceEnterMonitorCallback             ,
#if defined(ENABLE_OVERLOADING)
    SurfaceEnterMonitorSignalInfo           ,
#endif
    afterSurfaceEnterMonitor                ,
    onSurfaceEnterMonitor                   ,


-- ** event #signal:event#

    SurfaceEventCallback                    ,
#if defined(ENABLE_OVERLOADING)
    SurfaceEventSignalInfo                  ,
#endif
    afterSurfaceEvent                       ,
    onSurfaceEvent                          ,


-- ** layout #signal:layout#

    SurfaceLayoutCallback                   ,
#if defined(ENABLE_OVERLOADING)
    SurfaceLayoutSignalInfo                 ,
#endif
    afterSurfaceLayout                      ,
    onSurfaceLayout                         ,


-- ** leaveMonitor #signal:leaveMonitor#

    SurfaceLeaveMonitorCallback             ,
#if defined(ENABLE_OVERLOADING)
    SurfaceLeaveMonitorSignalInfo           ,
#endif
    afterSurfaceLeaveMonitor                ,
    onSurfaceLeaveMonitor                   ,


-- ** render #signal:render#

    SurfaceRenderCallback                   ,
#if defined(ENABLE_OVERLOADING)
    SurfaceRenderSignalInfo                 ,
#endif
    afterSurfaceRender                      ,
    onSurfaceRender                         ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Enums as Cairo.Enums
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
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.AppLaunchContext as Gdk.AppLaunchContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.CairoContext as Gdk.CairoContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import {-# SOURCE #-} qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import {-# SOURCE #-} qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.DeviceTool as Gdk.DeviceTool
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.DrawContext as Gdk.DrawContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import {-# SOURCE #-} qualified GI.Gdk.Objects.GLContext as Gdk.GLContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Seat as Gdk.Seat
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import {-# SOURCE #-} qualified GI.Gdk.Objects.VulkanContext as Gdk.VulkanContext
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.DmabufFormats as Gdk.DmabufFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.EventSequence as Gdk.EventSequence
import {-# SOURCE #-} qualified GI.Gdk.Structs.FrameTimings as Gdk.FrameTimings
import {-# SOURCE #-} qualified GI.Gdk.Structs.KeymapKey as Gdk.KeymapKey
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import {-# SOURCE #-} qualified GI.Gdk.Structs.TimeCoord as Gdk.TimeCoord
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon
import qualified GI.Gio.Objects.AppLaunchContext as Gio.AppLaunchContext
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Pango.Enums as Pango.Enums

#else
import qualified GI.Cairo.Enums as Cairo.Enums
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.CairoContext as Gdk.CairoContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import {-# SOURCE #-} qualified GI.Gdk.Objects.GLContext as Gdk.GLContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import {-# SOURCE #-} qualified GI.Gdk.Objects.VulkanContext as Gdk.VulkanContext

#endif

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

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

foreign import ccall "gdk_surface_get_type"
    c_gdk_surface_get_type :: IO B.Types.GType

instance B.Types.TypedObject Surface where
    glibType :: IO GType
glibType = IO GType
c_gdk_surface_get_type

instance B.Types.GObject Surface

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSurfaceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSurfaceMethod "beep" o = SurfaceBeepMethodInfo
    ResolveSurfaceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSurfaceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSurfaceMethod "createCairoContext" o = SurfaceCreateCairoContextMethodInfo
    ResolveSurfaceMethod "createGlContext" o = SurfaceCreateGlContextMethodInfo
    ResolveSurfaceMethod "createSimilarSurface" o = SurfaceCreateSimilarSurfaceMethodInfo
    ResolveSurfaceMethod "createVulkanContext" o = SurfaceCreateVulkanContextMethodInfo
    ResolveSurfaceMethod "destroy" o = SurfaceDestroyMethodInfo
    ResolveSurfaceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSurfaceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSurfaceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSurfaceMethod "hide" o = SurfaceHideMethodInfo
    ResolveSurfaceMethod "isDestroyed" o = SurfaceIsDestroyedMethodInfo
    ResolveSurfaceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSurfaceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSurfaceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSurfaceMethod "queueRender" o = SurfaceQueueRenderMethodInfo
    ResolveSurfaceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSurfaceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSurfaceMethod "requestLayout" o = SurfaceRequestLayoutMethodInfo
    ResolveSurfaceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSurfaceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSurfaceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSurfaceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSurfaceMethod "translateCoordinates" o = SurfaceTranslateCoordinatesMethodInfo
    ResolveSurfaceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSurfaceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSurfaceMethod "getCursor" o = SurfaceGetCursorMethodInfo
    ResolveSurfaceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSurfaceMethod "getDeviceCursor" o = SurfaceGetDeviceCursorMethodInfo
    ResolveSurfaceMethod "getDevicePosition" o = SurfaceGetDevicePositionMethodInfo
    ResolveSurfaceMethod "getDisplay" o = SurfaceGetDisplayMethodInfo
    ResolveSurfaceMethod "getFrameClock" o = SurfaceGetFrameClockMethodInfo
    ResolveSurfaceMethod "getHeight" o = SurfaceGetHeightMethodInfo
    ResolveSurfaceMethod "getMapped" o = SurfaceGetMappedMethodInfo
    ResolveSurfaceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSurfaceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSurfaceMethod "getScale" o = SurfaceGetScaleMethodInfo
    ResolveSurfaceMethod "getScaleFactor" o = SurfaceGetScaleFactorMethodInfo
    ResolveSurfaceMethod "getWidth" o = SurfaceGetWidthMethodInfo
    ResolveSurfaceMethod "setCursor" o = SurfaceSetCursorMethodInfo
    ResolveSurfaceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSurfaceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSurfaceMethod "setDeviceCursor" o = SurfaceSetDeviceCursorMethodInfo
    ResolveSurfaceMethod "setInputRegion" o = SurfaceSetInputRegionMethodInfo
    ResolveSurfaceMethod "setOpaqueRegion" o = SurfaceSetOpaqueRegionMethodInfo
    ResolveSurfaceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSurfaceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Surface::enter-monitor
-- | Emitted when /@surface@/ starts being present on the monitor.
type SurfaceEnterMonitorCallback =
    Gdk.Monitor.Monitor
    -- ^ /@monitor@/: the monitor
    -> IO ()

type C_SurfaceEnterMonitorCallback =
    Ptr Surface ->                          -- object
    Ptr Gdk.Monitor.Monitor ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SurfaceEnterMonitorCallback`.
foreign import ccall "wrapper"
    mk_SurfaceEnterMonitorCallback :: C_SurfaceEnterMonitorCallback -> IO (FunPtr C_SurfaceEnterMonitorCallback)

wrap_SurfaceEnterMonitorCallback :: 
    GObject a => (a -> SurfaceEnterMonitorCallback) ->
    C_SurfaceEnterMonitorCallback
wrap_SurfaceEnterMonitorCallback :: forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceEnterMonitorCallback a -> SurfaceEnterMonitorCallback
gi'cb Ptr Surface
gi'selfPtr Ptr Monitor
monitor Ptr ()
_ = do
    monitor' <- ((ManagedPtr Monitor -> Monitor) -> Ptr Monitor -> IO Monitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Monitor -> Monitor
Gdk.Monitor.Monitor) Ptr Monitor
monitor
    B.ManagedPtr.withNewObject gi'selfPtr $ \Surface
gi'self -> a -> SurfaceEnterMonitorCallback
gi'cb (Surface -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Surface
gi'self)  Monitor
monitor'


-- | Connect a signal handler for the [enterMonitor](#signal:enterMonitor) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' surface #enterMonitor callback
-- @
-- 
-- 
onSurfaceEnterMonitor :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
onSurfaceEnterMonitor :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a
-> ((?self::a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
onSurfaceEnterMonitor a
obj (?self::a) => SurfaceEnterMonitorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEnterMonitorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEnterMonitorCallback
SurfaceEnterMonitorCallback
cb
    let wrapped' :: C_SurfaceEnterMonitorCallback
wrapped' = (a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceEnterMonitorCallback a -> SurfaceEnterMonitorCallback
wrapped
    wrapped'' <- C_SurfaceEnterMonitorCallback
-> IO (FunPtr C_SurfaceEnterMonitorCallback)
mk_SurfaceEnterMonitorCallback C_SurfaceEnterMonitorCallback
wrapped'
    connectSignalFunPtr obj "enter-monitor" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [enterMonitor](#signal:enterMonitor) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' surface #enterMonitor callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSurfaceEnterMonitor :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
afterSurfaceEnterMonitor :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a
-> ((?self::a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
afterSurfaceEnterMonitor a
obj (?self::a) => SurfaceEnterMonitorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEnterMonitorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEnterMonitorCallback
SurfaceEnterMonitorCallback
cb
    let wrapped' :: C_SurfaceEnterMonitorCallback
wrapped' = (a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceEnterMonitorCallback a -> SurfaceEnterMonitorCallback
wrapped
    wrapped'' <- C_SurfaceEnterMonitorCallback
-> IO (FunPtr C_SurfaceEnterMonitorCallback)
mk_SurfaceEnterMonitorCallback C_SurfaceEnterMonitorCallback
wrapped'
    connectSignalFunPtr obj "enter-monitor" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data SurfaceEnterMonitorSignalInfo
instance SignalInfo SurfaceEnterMonitorSignalInfo where
    type HaskellCallbackType SurfaceEnterMonitorSignalInfo = SurfaceEnterMonitorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SurfaceEnterMonitorCallback cb
        cb'' <- mk_SurfaceEnterMonitorCallback cb'
        connectSignalFunPtr obj "enter-monitor" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface::enter-monitor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:signal:enterMonitor"})

#endif

-- signal Surface::event
-- | Emitted when GDK receives an input event for /@surface@/.
type SurfaceEventCallback =
    Gdk.Event.Event
    -- ^ /@event@/: an input event
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to indicate that the event has been handled

type C_SurfaceEventCallback =
    Ptr Surface ->                          -- object
    Ptr Gdk.Event.Event ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_SurfaceEventCallback`.
foreign import ccall "wrapper"
    mk_SurfaceEventCallback :: C_SurfaceEventCallback -> IO (FunPtr C_SurfaceEventCallback)

wrap_SurfaceEventCallback :: 
    GObject a => (a -> SurfaceEventCallback) ->
    C_SurfaceEventCallback
wrap_SurfaceEventCallback :: forall a.
GObject a =>
(a -> SurfaceEventCallback) -> C_SurfaceEventCallback
wrap_SurfaceEventCallback a -> SurfaceEventCallback
gi'cb Ptr Surface
gi'selfPtr Ptr Event
event Ptr ()
_ = do
    event' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Event -> Event
Gdk.Event.Event) Ptr Event
event
    result <- B.ManagedPtr.withNewObject gi'selfPtr $ \Surface
gi'self -> a -> SurfaceEventCallback
gi'cb (Surface -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Surface
gi'self)  Event
event'
    let result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
    return result'


-- | Connect a signal handler for the [event](#signal:event) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' surface #event callback
-- @
-- 
-- 
onSurfaceEvent :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceEventCallback) -> m SignalHandlerId
onSurfaceEvent :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceEventCallback) -> m SignalHandlerId
onSurfaceEvent a
obj (?self::a) => SurfaceEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEventCallback
SurfaceEventCallback
cb
    let wrapped' :: C_SurfaceEventCallback
wrapped' = (a -> SurfaceEventCallback) -> C_SurfaceEventCallback
forall a.
GObject a =>
(a -> SurfaceEventCallback) -> C_SurfaceEventCallback
wrap_SurfaceEventCallback a -> SurfaceEventCallback
wrapped
    wrapped'' <- C_SurfaceEventCallback -> IO (FunPtr C_SurfaceEventCallback)
mk_SurfaceEventCallback C_SurfaceEventCallback
wrapped'
    connectSignalFunPtr obj "event" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [event](#signal:event) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' surface #event callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSurfaceEvent :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceEventCallback) -> m SignalHandlerId
afterSurfaceEvent :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceEventCallback) -> m SignalHandlerId
afterSurfaceEvent a
obj (?self::a) => SurfaceEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEventCallback
SurfaceEventCallback
cb
    let wrapped' :: C_SurfaceEventCallback
wrapped' = (a -> SurfaceEventCallback) -> C_SurfaceEventCallback
forall a.
GObject a =>
(a -> SurfaceEventCallback) -> C_SurfaceEventCallback
wrap_SurfaceEventCallback a -> SurfaceEventCallback
wrapped
    wrapped'' <- C_SurfaceEventCallback -> IO (FunPtr C_SurfaceEventCallback)
mk_SurfaceEventCallback C_SurfaceEventCallback
wrapped'
    connectSignalFunPtr obj "event" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data SurfaceEventSignalInfo
instance SignalInfo SurfaceEventSignalInfo where
    type HaskellCallbackType SurfaceEventSignalInfo = SurfaceEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SurfaceEventCallback cb
        cb'' <- mk_SurfaceEventCallback cb'
        connectSignalFunPtr obj "event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface::event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:signal:event"})

#endif

-- signal Surface::layout
-- | Emitted when the size of /@surface@/ is changed, or when relayout should
-- be performed.
-- 
-- Surface size is reported in ”application pixels”, not
-- ”device pixels” (see 'GI.Gdk.Objects.Surface.surfaceGetScaleFactor').
type SurfaceLayoutCallback =
    Int32
    -- ^ /@width@/: the current width
    -> Int32
    -- ^ /@height@/: the current height
    -> IO ()

type C_SurfaceLayoutCallback =
    Ptr Surface ->                          -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SurfaceLayoutCallback`.
foreign import ccall "wrapper"
    mk_SurfaceLayoutCallback :: C_SurfaceLayoutCallback -> IO (FunPtr C_SurfaceLayoutCallback)

wrap_SurfaceLayoutCallback :: 
    GObject a => (a -> SurfaceLayoutCallback) ->
    C_SurfaceLayoutCallback
wrap_SurfaceLayoutCallback :: forall a.
GObject a =>
(a -> SurfaceLayoutCallback) -> C_SurfaceLayoutCallback
wrap_SurfaceLayoutCallback a -> SurfaceLayoutCallback
gi'cb Ptr Surface
gi'selfPtr Int32
width Int32
height Ptr ()
_ = do
    Ptr Surface -> (Surface -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Surface
gi'selfPtr ((Surface -> IO ()) -> IO ()) -> (Surface -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Surface
gi'self -> a -> SurfaceLayoutCallback
gi'cb (Surface -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Surface
gi'self)  Int32
width Int32
height


-- | Connect a signal handler for the [layout](#signal:layout) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' surface #layout callback
-- @
-- 
-- 
onSurfaceLayout :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceLayoutCallback) -> m SignalHandlerId
onSurfaceLayout :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceLayoutCallback) -> m SignalHandlerId
onSurfaceLayout a
obj (?self::a) => SurfaceLayoutCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceLayoutCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceLayoutCallback
SurfaceLayoutCallback
cb
    let wrapped' :: C_SurfaceLayoutCallback
wrapped' = (a -> SurfaceLayoutCallback) -> C_SurfaceLayoutCallback
forall a.
GObject a =>
(a -> SurfaceLayoutCallback) -> C_SurfaceLayoutCallback
wrap_SurfaceLayoutCallback a -> SurfaceLayoutCallback
wrapped
    wrapped'' <- C_SurfaceLayoutCallback -> IO (FunPtr C_SurfaceLayoutCallback)
mk_SurfaceLayoutCallback C_SurfaceLayoutCallback
wrapped'
    connectSignalFunPtr obj "layout" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [layout](#signal:layout) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' surface #layout callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSurfaceLayout :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceLayoutCallback) -> m SignalHandlerId
afterSurfaceLayout :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceLayoutCallback) -> m SignalHandlerId
afterSurfaceLayout a
obj (?self::a) => SurfaceLayoutCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceLayoutCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceLayoutCallback
SurfaceLayoutCallback
cb
    let wrapped' :: C_SurfaceLayoutCallback
wrapped' = (a -> SurfaceLayoutCallback) -> C_SurfaceLayoutCallback
forall a.
GObject a =>
(a -> SurfaceLayoutCallback) -> C_SurfaceLayoutCallback
wrap_SurfaceLayoutCallback a -> SurfaceLayoutCallback
wrapped
    wrapped'' <- C_SurfaceLayoutCallback -> IO (FunPtr C_SurfaceLayoutCallback)
mk_SurfaceLayoutCallback C_SurfaceLayoutCallback
wrapped'
    connectSignalFunPtr obj "layout" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data SurfaceLayoutSignalInfo
instance SignalInfo SurfaceLayoutSignalInfo where
    type HaskellCallbackType SurfaceLayoutSignalInfo = SurfaceLayoutCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SurfaceLayoutCallback cb
        cb'' <- mk_SurfaceLayoutCallback cb'
        connectSignalFunPtr obj "layout" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface::layout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:signal:layout"})

#endif

-- signal Surface::leave-monitor
-- | Emitted when /@surface@/ stops being present on the monitor.
type SurfaceLeaveMonitorCallback =
    Gdk.Monitor.Monitor
    -- ^ /@monitor@/: the monitor
    -> IO ()

type C_SurfaceLeaveMonitorCallback =
    Ptr Surface ->                          -- object
    Ptr Gdk.Monitor.Monitor ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_SurfaceLeaveMonitorCallback`.
foreign import ccall "wrapper"
    mk_SurfaceLeaveMonitorCallback :: C_SurfaceLeaveMonitorCallback -> IO (FunPtr C_SurfaceLeaveMonitorCallback)

wrap_SurfaceLeaveMonitorCallback :: 
    GObject a => (a -> SurfaceLeaveMonitorCallback) ->
    C_SurfaceLeaveMonitorCallback
wrap_SurfaceLeaveMonitorCallback :: forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceLeaveMonitorCallback a -> SurfaceEnterMonitorCallback
gi'cb Ptr Surface
gi'selfPtr Ptr Monitor
monitor Ptr ()
_ = do
    monitor' <- ((ManagedPtr Monitor -> Monitor) -> Ptr Monitor -> IO Monitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Monitor -> Monitor
Gdk.Monitor.Monitor) Ptr Monitor
monitor
    B.ManagedPtr.withNewObject gi'selfPtr $ \Surface
gi'self -> a -> SurfaceEnterMonitorCallback
gi'cb (Surface -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Surface
gi'self)  Monitor
monitor'


-- | Connect a signal handler for the [leaveMonitor](#signal:leaveMonitor) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' surface #leaveMonitor callback
-- @
-- 
-- 
onSurfaceLeaveMonitor :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceLeaveMonitorCallback) -> m SignalHandlerId
onSurfaceLeaveMonitor :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a
-> ((?self::a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
onSurfaceLeaveMonitor a
obj (?self::a) => SurfaceEnterMonitorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEnterMonitorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEnterMonitorCallback
SurfaceEnterMonitorCallback
cb
    let wrapped' :: C_SurfaceEnterMonitorCallback
wrapped' = (a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceLeaveMonitorCallback a -> SurfaceEnterMonitorCallback
wrapped
    wrapped'' <- C_SurfaceEnterMonitorCallback
-> IO (FunPtr C_SurfaceEnterMonitorCallback)
mk_SurfaceLeaveMonitorCallback C_SurfaceEnterMonitorCallback
wrapped'
    connectSignalFunPtr obj "leave-monitor" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [leaveMonitor](#signal:leaveMonitor) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' surface #leaveMonitor callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSurfaceLeaveMonitor :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceLeaveMonitorCallback) -> m SignalHandlerId
afterSurfaceLeaveMonitor :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a
-> ((?self::a) => SurfaceEnterMonitorCallback) -> m SignalHandlerId
afterSurfaceLeaveMonitor a
obj (?self::a) => SurfaceEnterMonitorCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceEnterMonitorCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceEnterMonitorCallback
SurfaceEnterMonitorCallback
cb
    let wrapped' :: C_SurfaceEnterMonitorCallback
wrapped' = (a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
forall a.
GObject a =>
(a -> SurfaceEnterMonitorCallback) -> C_SurfaceEnterMonitorCallback
wrap_SurfaceLeaveMonitorCallback a -> SurfaceEnterMonitorCallback
wrapped
    wrapped'' <- C_SurfaceEnterMonitorCallback
-> IO (FunPtr C_SurfaceEnterMonitorCallback)
mk_SurfaceLeaveMonitorCallback C_SurfaceEnterMonitorCallback
wrapped'
    connectSignalFunPtr obj "leave-monitor" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data SurfaceLeaveMonitorSignalInfo
instance SignalInfo SurfaceLeaveMonitorSignalInfo where
    type HaskellCallbackType SurfaceLeaveMonitorSignalInfo = SurfaceLeaveMonitorCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SurfaceLeaveMonitorCallback cb
        cb'' <- mk_SurfaceLeaveMonitorCallback cb'
        connectSignalFunPtr obj "leave-monitor" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface::leave-monitor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:signal:leaveMonitor"})

#endif

-- signal Surface::render
-- | Emitted when part of the surface needs to be redrawn.
type SurfaceRenderCallback =
    Cairo.Region.Region
    -- ^ /@region@/: the region that needs to be redrawn
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to indicate that the signal has been handled

type C_SurfaceRenderCallback =
    Ptr Surface ->                          -- object
    Ptr Cairo.Region.Region ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_SurfaceRenderCallback`.
foreign import ccall "wrapper"
    mk_SurfaceRenderCallback :: C_SurfaceRenderCallback -> IO (FunPtr C_SurfaceRenderCallback)

wrap_SurfaceRenderCallback :: 
    GObject a => (a -> SurfaceRenderCallback) ->
    C_SurfaceRenderCallback
wrap_SurfaceRenderCallback :: forall a.
GObject a =>
(a -> SurfaceRenderCallback) -> C_SurfaceRenderCallback
wrap_SurfaceRenderCallback a -> SurfaceRenderCallback
gi'cb Ptr Surface
gi'selfPtr Ptr Region
region Ptr ()
_ = do
    Ptr Region -> (Region -> IO CInt) -> IO CInt
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Region
region ((Region -> IO CInt) -> IO CInt) -> (Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Region
region' -> do
        result <- Ptr Surface -> (Surface -> IO Bool) -> IO Bool
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Surface
gi'selfPtr ((Surface -> IO Bool) -> IO Bool)
-> (Surface -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Surface
gi'self -> a -> SurfaceRenderCallback
gi'cb (Surface -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Surface
gi'self)  Region
region'
        let result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
        return result'


-- | Connect a signal handler for the [render](#signal:render) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' surface #render callback
-- @
-- 
-- 
onSurfaceRender :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceRenderCallback) -> m SignalHandlerId
onSurfaceRender :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceRenderCallback) -> m SignalHandlerId
onSurfaceRender a
obj (?self::a) => SurfaceRenderCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceRenderCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceRenderCallback
SurfaceRenderCallback
cb
    let wrapped' :: C_SurfaceRenderCallback
wrapped' = (a -> SurfaceRenderCallback) -> C_SurfaceRenderCallback
forall a.
GObject a =>
(a -> SurfaceRenderCallback) -> C_SurfaceRenderCallback
wrap_SurfaceRenderCallback a -> SurfaceRenderCallback
wrapped
    wrapped'' <- C_SurfaceRenderCallback -> IO (FunPtr C_SurfaceRenderCallback)
mk_SurfaceRenderCallback C_SurfaceRenderCallback
wrapped'
    connectSignalFunPtr obj "render" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [render](#signal:render) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' surface #render callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSurfaceRender :: (IsSurface a, MonadIO m) => a -> ((?self :: a) => SurfaceRenderCallback) -> m SignalHandlerId
afterSurfaceRender :: forall a (m :: * -> *).
(IsSurface a, MonadIO m) =>
a -> ((?self::a) => SurfaceRenderCallback) -> m SignalHandlerId
afterSurfaceRender a
obj (?self::a) => SurfaceRenderCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SurfaceRenderCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SurfaceRenderCallback
SurfaceRenderCallback
cb
    let wrapped' :: C_SurfaceRenderCallback
wrapped' = (a -> SurfaceRenderCallback) -> C_SurfaceRenderCallback
forall a.
GObject a =>
(a -> SurfaceRenderCallback) -> C_SurfaceRenderCallback
wrap_SurfaceRenderCallback a -> SurfaceRenderCallback
wrapped
    wrapped'' <- C_SurfaceRenderCallback -> IO (FunPtr C_SurfaceRenderCallback)
mk_SurfaceRenderCallback C_SurfaceRenderCallback
wrapped'
    connectSignalFunPtr obj "render" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data SurfaceRenderSignalInfo
instance SignalInfo SurfaceRenderSignalInfo where
    type HaskellCallbackType SurfaceRenderSignalInfo = SurfaceRenderCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SurfaceRenderCallback cb
        cb'' <- mk_SurfaceRenderCallback cb'
        connectSignalFunPtr obj "render" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface::render"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:signal:render"})

#endif

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

-- | Get the value of the “@cursor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' surface #cursor
-- @
getSurfaceCursor :: (MonadIO m, IsSurface o) => o -> m (Maybe Gdk.Cursor.Cursor)
getSurfaceCursor :: forall (m :: * -> *) o.
(MonadIO m, IsSurface o) =>
o -> m (Maybe Cursor)
getSurfaceCursor 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
"cursor" ManagedPtr Cursor -> Cursor
Gdk.Cursor.Cursor

-- | Set the value of the “@cursor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' surface [ #cursor 'Data.GI.Base.Attributes.:=' value ]
-- @
setSurfaceCursor :: (MonadIO m, IsSurface o, Gdk.Cursor.IsCursor a) => o -> a -> m ()
setSurfaceCursor :: forall (m :: * -> *) o a.
(MonadIO m, IsSurface o, IsCursor a) =>
o -> a -> m ()
setSurfaceCursor o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"cursor" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@cursor@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSurfaceCursor :: (IsSurface o, MIO.MonadIO m, Gdk.Cursor.IsCursor a) => a -> m (GValueConstruct o)
constructSurfaceCursor :: forall o (m :: * -> *) a.
(IsSurface o, MonadIO m, IsCursor a) =>
a -> m (GValueConstruct o)
constructSurfaceCursor 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
"cursor" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@cursor@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #cursor
-- @
clearSurfaceCursor :: (MonadIO m, IsSurface o) => o -> m ()
clearSurfaceCursor :: forall (m :: * -> *) o. (MonadIO m, IsSurface o) => o -> m ()
clearSurfaceCursor o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Cursor -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"cursor" (Maybe Cursor
forall a. Maybe a
Nothing :: Maybe Gdk.Cursor.Cursor)

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@display@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSurfaceDisplay :: (IsSurface o, MIO.MonadIO m, Gdk.Display.IsDisplay a) => a -> m (GValueConstruct o)
constructSurfaceDisplay :: forall o (m :: * -> *) a.
(IsSurface o, MonadIO m, IsDisplay a) =>
a -> m (GValueConstruct o)
constructSurfaceDisplay 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
"display" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

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

-- VVV Prop "frame-clock"
   -- Type: TInterface (Name {namespace = "Gdk", name = "FrameClock"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@frame-clock@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSurfaceFrameClock :: (IsSurface o, MIO.MonadIO m, Gdk.FrameClock.IsFrameClock a) => a -> m (GValueConstruct o)
constructSurfaceFrameClock :: forall o (m :: * -> *) a.
(IsSurface o, MonadIO m, IsFrameClock a) =>
a -> m (GValueConstruct o)
constructSurfaceFrameClock 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
"frame-clock" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data SurfaceFrameClockPropertyInfo
instance AttrInfo SurfaceFrameClockPropertyInfo where
    type AttrAllowedOps SurfaceFrameClockPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SurfaceFrameClockPropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceFrameClockPropertyInfo = Gdk.FrameClock.IsFrameClock
    type AttrTransferTypeConstraint SurfaceFrameClockPropertyInfo = Gdk.FrameClock.IsFrameClock
    type AttrTransferType SurfaceFrameClockPropertyInfo = Gdk.FrameClock.FrameClock
    type AttrGetType SurfaceFrameClockPropertyInfo = Gdk.FrameClock.FrameClock
    type AttrLabel SurfaceFrameClockPropertyInfo = "frame-clock"
    type AttrOrigin SurfaceFrameClockPropertyInfo = Surface
    attrGet = getSurfaceFrameClock
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.FrameClock.FrameClock v
    attrConstruct = constructSurfaceFrameClock
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.frameClock"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:frameClock"
        })
#endif

-- VVV Prop "height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' surface #height
-- @
getSurfaceHeight :: (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceHeight :: forall (m :: * -> *) o. (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceHeight 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
"height"

#if defined(ENABLE_OVERLOADING)
data SurfaceHeightPropertyInfo
instance AttrInfo SurfaceHeightPropertyInfo where
    type AttrAllowedOps SurfaceHeightPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SurfaceHeightPropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceHeightPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SurfaceHeightPropertyInfo = (~) ()
    type AttrTransferType SurfaceHeightPropertyInfo = ()
    type AttrGetType SurfaceHeightPropertyInfo = Int32
    type AttrLabel SurfaceHeightPropertyInfo = "height"
    type AttrOrigin SurfaceHeightPropertyInfo = Surface
    attrGet = getSurfaceHeight
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:height"
        })
#endif

-- VVV Prop "mapped"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SurfaceMappedPropertyInfo
instance AttrInfo SurfaceMappedPropertyInfo where
    type AttrAllowedOps SurfaceMappedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SurfaceMappedPropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceMappedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SurfaceMappedPropertyInfo = (~) ()
    type AttrTransferType SurfaceMappedPropertyInfo = ()
    type AttrGetType SurfaceMappedPropertyInfo = Bool
    type AttrLabel SurfaceMappedPropertyInfo = "mapped"
    type AttrOrigin SurfaceMappedPropertyInfo = Surface
    attrGet = getSurfaceMapped
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.mapped"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:mapped"
        })
#endif

-- VVV Prop "scale"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SurfaceScalePropertyInfo
instance AttrInfo SurfaceScalePropertyInfo where
    type AttrAllowedOps SurfaceScalePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SurfaceScalePropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceScalePropertyInfo = (~) ()
    type AttrTransferTypeConstraint SurfaceScalePropertyInfo = (~) ()
    type AttrTransferType SurfaceScalePropertyInfo = ()
    type AttrGetType SurfaceScalePropertyInfo = Double
    type AttrLabel SurfaceScalePropertyInfo = "scale"
    type AttrOrigin SurfaceScalePropertyInfo = Surface
    attrGet = getSurfaceScale
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.scale"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:scale"
        })
#endif

-- VVV Prop "scale-factor"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@scale-factor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' surface #scaleFactor
-- @
getSurfaceScaleFactor :: (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceScaleFactor :: forall (m :: * -> *) o. (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceScaleFactor 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
"scale-factor"

#if defined(ENABLE_OVERLOADING)
data SurfaceScaleFactorPropertyInfo
instance AttrInfo SurfaceScaleFactorPropertyInfo where
    type AttrAllowedOps SurfaceScaleFactorPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SurfaceScaleFactorPropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceScaleFactorPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SurfaceScaleFactorPropertyInfo = (~) ()
    type AttrTransferType SurfaceScaleFactorPropertyInfo = ()
    type AttrGetType SurfaceScaleFactorPropertyInfo = Int32
    type AttrLabel SurfaceScaleFactorPropertyInfo = "scale-factor"
    type AttrOrigin SurfaceScaleFactorPropertyInfo = Surface
    attrGet = getSurfaceScaleFactor
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.scaleFactor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:scaleFactor"
        })
#endif

-- VVV Prop "width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' surface #width
-- @
getSurfaceWidth :: (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceWidth :: forall (m :: * -> *) o. (MonadIO m, IsSurface o) => o -> m Int32
getSurfaceWidth 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
"width"

#if defined(ENABLE_OVERLOADING)
data SurfaceWidthPropertyInfo
instance AttrInfo SurfaceWidthPropertyInfo where
    type AttrAllowedOps SurfaceWidthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SurfaceWidthPropertyInfo = IsSurface
    type AttrSetTypeConstraint SurfaceWidthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SurfaceWidthPropertyInfo = (~) ()
    type AttrTransferType SurfaceWidthPropertyInfo = ()
    type AttrGetType SurfaceWidthPropertyInfo = Int32
    type AttrLabel SurfaceWidthPropertyInfo = "width"
    type AttrOrigin SurfaceWidthPropertyInfo = Surface
    attrGet = getSurfaceWidth
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Surface.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Surface.html#g:attr:width"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Surface
type instance O.AttributeList Surface = SurfaceAttributeList
type SurfaceAttributeList = ('[ '("cursor", SurfaceCursorPropertyInfo), '("display", SurfaceDisplayPropertyInfo), '("frameClock", SurfaceFrameClockPropertyInfo), '("height", SurfaceHeightPropertyInfo), '("mapped", SurfaceMappedPropertyInfo), '("scale", SurfaceScalePropertyInfo), '("scaleFactor", SurfaceScaleFactorPropertyInfo), '("width", SurfaceWidthPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
surfaceCursor :: AttrLabelProxy "cursor"
surfaceCursor = AttrLabelProxy

surfaceDisplay :: AttrLabelProxy "display"
surfaceDisplay = AttrLabelProxy

surfaceFrameClock :: AttrLabelProxy "frameClock"
surfaceFrameClock = AttrLabelProxy

surfaceHeight :: AttrLabelProxy "height"
surfaceHeight = AttrLabelProxy

surfaceMapped :: AttrLabelProxy "mapped"
surfaceMapped = AttrLabelProxy

surfaceScale :: AttrLabelProxy "scale"
surfaceScale = AttrLabelProxy

surfaceScaleFactor :: AttrLabelProxy "scaleFactor"
surfaceScaleFactor = AttrLabelProxy

surfaceWidth :: AttrLabelProxy "width"
surfaceWidth = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Surface = SurfaceSignalList
type SurfaceSignalList = ('[ '("enterMonitor", SurfaceEnterMonitorSignalInfo), '("event", SurfaceEventSignalInfo), '("layout", SurfaceLayoutSignalInfo), '("leaveMonitor", SurfaceLeaveMonitorSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("render", SurfaceRenderSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Surface::new_popup
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent surface to attach the surface to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "autohide"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to hide the surface on outside clicks"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_new_popup" gdk_surface_new_popup :: 
    Ptr Surface ->                          -- parent : TInterface (Name {namespace = "Gdk", name = "Surface"})
    CInt ->                                 -- autohide : TBasicType TBoolean
    IO (Ptr Surface)

-- | Create a new popup surface.
-- 
-- The surface will be attached to /@parent@/ and can be positioned
-- relative to it using 'GI.Gdk.Interfaces.Popup.popupPresent'.
surfaceNewPopup ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@parent@/: the parent surface to attach the surface to
    -> Bool
    -- ^ /@autohide@/: whether to hide the surface on outside clicks
    -> m Surface
    -- ^ __Returns:__ a new @GdkSurface@
surfaceNewPopup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> Bool -> m Surface
surfaceNewPopup a
parent Bool
autohide = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    parent' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parent
    let autohide' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
autohide
    result <- gdk_surface_new_popup parent' autohide'
    checkUnexpectedReturnNULL "surfaceNewPopup" result
    result' <- (wrapObject Surface) result
    touchManagedPtr parent
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Surface::new_toplevel
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the display to create the surface on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_new_toplevel" gdk_surface_new_toplevel :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO (Ptr Surface)

-- | Creates a new toplevel surface.
surfaceNewToplevel ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: the display to create the surface on
    -> m Surface
    -- ^ __Returns:__ the new @GdkSurface@
surfaceNewToplevel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m Surface
surfaceNewToplevel a
display = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    result <- gdk_surface_new_toplevel display'
    checkUnexpectedReturnNULL "surfaceNewToplevel" result
    result' <- (wrapObject Surface) result
    touchManagedPtr display
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gdk_surface_beep" gdk_surface_beep :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Emits a short beep associated to /@surface@/.
-- 
-- If the display of /@surface@/ does not support per-surface beeps,
-- emits a short beep on the display just as 'GI.Gdk.Objects.Display.displayBeep'.
surfaceBeep ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a toplevel @GdkSurface@
    -> m ()
surfaceBeep :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m ()
surfaceBeep a
surface = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    gdk_surface_beep surface'
    touchManagedPtr surface
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceBeepMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceBeepMethodInfo a signature where
    overloadedMethod = surfaceBeep

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


#endif

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

foreign import ccall "gdk_surface_create_cairo_context" gdk_surface_create_cairo_context :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO (Ptr Gdk.CairoContext.CairoContext)

-- | Creates a new @GdkCairoContext@ for rendering on /@surface@/.
surfaceCreateCairoContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Gdk.CairoContext.CairoContext
    -- ^ __Returns:__ the newly created @GdkCairoContext@
surfaceCreateCairoContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m CairoContext
surfaceCreateCairoContext a
surface = IO CairoContext -> m CairoContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CairoContext -> m CairoContext)
-> IO CairoContext -> m CairoContext
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_create_cairo_context surface'
    checkUnexpectedReturnNULL "surfaceCreateCairoContext" result
    result' <- (wrapObject Gdk.CairoContext.CairoContext) result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceCreateCairoContextMethodInfo
instance (signature ~ (m Gdk.CairoContext.CairoContext), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceCreateCairoContextMethodInfo a signature where
    overloadedMethod = surfaceCreateCairoContext

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


#endif

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

foreign import ccall "gdk_surface_create_gl_context" gdk_surface_create_gl_context :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gdk.GLContext.GLContext)

-- | Creates a new @GdkGLContext@ for the @GdkSurface@.
-- 
-- The context is disconnected from any particular surface or surface.
-- If the creation of the @GdkGLContext@ failed, /@error@/ will be set.
-- Before using the returned @GdkGLContext@, you will need to
-- call 'GI.Gdk.Objects.GLContext.gLContextMakeCurrent' or 'GI.Gdk.Objects.GLContext.gLContextRealize'.
surfaceCreateGlContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Gdk.GLContext.GLContext
    -- ^ __Returns:__ the newly created @GdkGLContext@ /(Can throw 'Data.GI.Base.GError.GError')/
surfaceCreateGlContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m GLContext
surfaceCreateGlContext a
surface = IO GLContext -> m GLContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GLContext -> m GLContext) -> IO GLContext -> m GLContext
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    onException (do
        result <- propagateGError $ gdk_surface_create_gl_context surface'
        checkUnexpectedReturnNULL "surfaceCreateGlContext" result
        result' <- (wrapObject Gdk.GLContext.GLContext) result
        touchManagedPtr surface
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data SurfaceCreateGlContextMethodInfo
instance (signature ~ (m Gdk.GLContext.GLContext), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceCreateGlContextMethodInfo a signature where
    overloadedMethod = surfaceCreateGlContext

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


#endif

-- method Surface::create_similar_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "surface to make new surface similar to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Content" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content for the new surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the new surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of the new surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_create_similar_surface" gdk_surface_create_similar_surface :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    CUInt ->                                -- content : TInterface (Name {namespace = "cairo", name = "Content"})
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO (Ptr Cairo.Surface.Surface)

{-# DEPRECATED surfaceCreateSimilarSurface ["(Since version 4.12)","Create a suitable cairo image surface yourself"] #-}
-- | Create a new Cairo surface that is as compatible as possible with the
-- given /@surface@/.
-- 
-- For example the new surface will have the same fallback resolution
-- and font options as /@surface@/. Generally, the new surface will also
-- use the same backend as /@surface@/, unless that is not possible for
-- some reason. The type of the returned surface may be examined with
-- @/cairo_surface_get_type()/@.
-- 
-- Initially the surface contents are all 0 (transparent if contents
-- have transparency, black otherwise.)
-- 
-- This function always returns a valid pointer, but it will return a
-- pointer to a “nil” surface if /@other@/ is already in an error state
-- or any other error occurs.
surfaceCreateSimilarSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: surface to make new surface similar to
    -> Cairo.Enums.Content
    -- ^ /@content@/: the content for the new surface
    -> Int32
    -- ^ /@width@/: width of the new surface
    -> Int32
    -- ^ /@height@/: height of the new surface
    -> m Cairo.Surface.Surface
    -- ^ __Returns:__ a pointer to the newly allocated surface. The caller
    --   owns the surface and should call @/cairo_surface_destroy()/@ when done
    --   with it.
surfaceCreateSimilarSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> Content -> Int32 -> Int32 -> m Surface
surfaceCreateSimilarSurface a
surface Content
content Int32
width Int32
height = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    let content' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Content -> Int) -> Content -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Int
forall a. Enum a => a -> Int
fromEnum) Content
content
    result <- gdk_surface_create_similar_surface surface' content' width height
    checkUnexpectedReturnNULL "surfaceCreateSimilarSurface" result
    result' <- (wrapBoxed Cairo.Surface.Surface) result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceCreateSimilarSurfaceMethodInfo
instance (signature ~ (Cairo.Enums.Content -> Int32 -> Int32 -> m Cairo.Surface.Surface), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceCreateSimilarSurfaceMethodInfo a signature where
    overloadedMethod = surfaceCreateSimilarSurface

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


#endif

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

foreign import ccall "gdk_surface_create_vulkan_context" gdk_surface_create_vulkan_context :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gdk.VulkanContext.VulkanContext)

{-# DEPRECATED surfaceCreateVulkanContext ["(Since version 4.14)","GTK does not expose any Vulkan internals. This","  function is a leftover that was accidentally exposed."] #-}
-- | Sets an error and returns 'P.Nothing'.
surfaceCreateVulkanContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Gdk.VulkanContext.VulkanContext
    -- ^ __Returns:__ 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
surfaceCreateVulkanContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m VulkanContext
surfaceCreateVulkanContext a
surface = IO VulkanContext -> m VulkanContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VulkanContext -> m VulkanContext)
-> IO VulkanContext -> m VulkanContext
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    onException (do
        result <- propagateGError $ gdk_surface_create_vulkan_context surface'
        checkUnexpectedReturnNULL "surfaceCreateVulkanContext" result
        result' <- (wrapObject Gdk.VulkanContext.VulkanContext) result
        touchManagedPtr surface
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data SurfaceCreateVulkanContextMethodInfo
instance (signature ~ (m Gdk.VulkanContext.VulkanContext), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceCreateVulkanContextMethodInfo a signature where
    overloadedMethod = surfaceCreateVulkanContext

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


#endif

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

foreign import ccall "gdk_surface_destroy" gdk_surface_destroy :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Destroys the window system resources associated with /@surface@/ and
-- decrements /@surface@/\'s reference count.
-- 
-- The window system resources for all children of /@surface@/ are also
-- destroyed, but the children’s reference counts are not decremented.
-- 
-- Note that a surface will not be destroyed automatically when its
-- reference count reaches zero. You must call this function yourself
-- before that happens.
surfaceDestroy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m ()
surfaceDestroy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m ()
surfaceDestroy a
surface = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    gdk_surface_destroy surface'
    touchManagedPtr surface
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceDestroyMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceDestroyMethodInfo a signature where
    overloadedMethod = surfaceDestroy

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


#endif

-- method Surface::get_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , 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_surface_get_cursor" gdk_surface_get_cursor :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO (Ptr Gdk.Cursor.Cursor)

-- | Retrieves a @GdkCursor@ pointer for the cursor currently set on the
-- @GdkSurface@.
-- 
-- If the return value is 'P.Nothing' then there is no custom cursor set on
-- the surface, and it is using the cursor for its parent surface.
-- 
-- Use 'GI.Gdk.Objects.Surface.surfaceSetCursor' to unset the cursor of the surface.
surfaceGetCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m (Maybe Gdk.Cursor.Cursor)
    -- ^ __Returns:__ a @GdkCursor@
surfaceGetCursor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m (Maybe Cursor)
surfaceGetCursor a
surface = 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
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_cursor surface'
    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
Gdk.Cursor.Cursor) Ptr Cursor
result'
        return result''
    touchManagedPtr surface
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data SurfaceGetCursorMethodInfo
instance (signature ~ (m (Maybe Gdk.Cursor.Cursor)), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetCursorMethodInfo a signature where
    overloadedMethod = surfaceGetCursor

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


#endif

-- method Surface::get_device_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer `GdkDevice`"
--                 , 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_surface_get_device_cursor" gdk_surface_get_device_cursor :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO (Ptr Gdk.Cursor.Cursor)

-- | Retrieves a @GdkCursor@ pointer for the /@device@/ currently set on the
-- specified @GdkSurface@.
-- 
-- If the return value is 'P.Nothing' then there is no custom cursor set on the
-- specified surface, and it is using the cursor for its parent surface.
-- 
-- Use 'GI.Gdk.Objects.Surface.surfaceSetCursor' to unset the cursor of the surface.
surfaceGetDeviceCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> b
    -- ^ /@device@/: a pointer @GdkDevice@
    -> m (Maybe Gdk.Cursor.Cursor)
    -- ^ __Returns:__ a @GdkCursor@
surfaceGetDeviceCursor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSurface a, IsDevice b) =>
a -> b -> m (Maybe Cursor)
surfaceGetDeviceCursor a
surface b
device = 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
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    device' <- unsafeManagedPtrCastPtr device
    result <- gdk_surface_get_device_cursor surface' device'
    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
Gdk.Cursor.Cursor) Ptr Cursor
result'
        return result''
    touchManagedPtr surface
    touchManagedPtr device
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data SurfaceGetDeviceCursorMethodInfo
instance (signature ~ (b -> m (Maybe Gdk.Cursor.Cursor)), MonadIO m, IsSurface a, Gdk.Device.IsDevice b) => O.OverloadedMethod SurfaceGetDeviceCursorMethodInfo a signature where
    overloadedMethod = surfaceGetDeviceCursor

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


#endif

-- method Surface::get_device_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer `GdkDevice` to query to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the X coordinate of @device"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the Y coordinate of @device"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "mask"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the modifier mask"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_get_device_position" gdk_surface_get_device_position :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    Ptr CUInt ->                            -- mask : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    IO CInt

-- | Obtains the current device position and modifier state.
-- 
-- The position is given in coordinates relative to the upper
-- left corner of /@surface@/.
surfaceGetDevicePosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> b
    -- ^ /@device@/: pointer @GdkDevice@ to query to
    -> m ((Bool, Double, Double, [Gdk.Flags.ModifierType]))
    -- ^ __Returns:__ 'P.True' if the device is over the surface
surfaceGetDevicePosition :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSurface a, IsDevice b) =>
a -> b -> m (Bool, Double, Double, [ModifierType])
surfaceGetDevicePosition a
surface b
device = IO (Bool, Double, Double, [ModifierType])
-> m (Bool, Double, Double, [ModifierType])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double, [ModifierType])
 -> m (Bool, Double, Double, [ModifierType]))
-> IO (Bool, Double, Double, [ModifierType])
-> m (Bool, Double, Double, [ModifierType])
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    device' <- unsafeManagedPtrCastPtr device
    x <- allocMem :: IO (Ptr CDouble)
    y <- allocMem :: IO (Ptr CDouble)
    mask <- allocMem :: IO (Ptr CUInt)
    result <- gdk_surface_get_device_position surface' device' x y mask
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    x' <- peek x
    let x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    y' <- peek y
    let y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    mask' <- peek mask
    let mask'' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
mask'
    touchManagedPtr surface
    touchManagedPtr device
    freeMem x
    freeMem y
    freeMem mask
    return (result', x'', y'', mask'')

#if defined(ENABLE_OVERLOADING)
data SurfaceGetDevicePositionMethodInfo
instance (signature ~ (b -> m ((Bool, Double, Double, [Gdk.Flags.ModifierType]))), MonadIO m, IsSurface a, Gdk.Device.IsDevice b) => O.OverloadedMethod SurfaceGetDevicePositionMethodInfo a signature where
    overloadedMethod = surfaceGetDevicePosition

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


#endif

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

foreign import ccall "gdk_surface_get_display" gdk_surface_get_display :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the @GdkDisplay@ associated with a @GdkSurface@.
surfaceGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Gdk.Display.Display
    -- ^ __Returns:__ the @GdkDisplay@ associated with /@surface@/
surfaceGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Display
surfaceGetDisplay a
surface = IO Display -> m Display
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Display -> m Display) -> IO Display -> m Display
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_display surface'
    checkUnexpectedReturnNULL "surfaceGetDisplay" result
    result' <- (newObject Gdk.Display.Display) result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetDisplayMethodInfo a signature where
    overloadedMethod = surfaceGetDisplay

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


#endif

-- method Surface::get_frame_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "surface to get frame clock for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "FrameClock" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_get_frame_clock" gdk_surface_get_frame_clock :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO (Ptr Gdk.FrameClock.FrameClock)

-- | Gets the frame clock for the surface.
-- 
-- The frame clock for a surface never changes unless the surface is
-- reparented to a new toplevel surface.
surfaceGetFrameClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: surface to get frame clock for
    -> m Gdk.FrameClock.FrameClock
    -- ^ __Returns:__ the frame clock
surfaceGetFrameClock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m FrameClock
surfaceGetFrameClock a
surface = IO FrameClock -> m FrameClock
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FrameClock -> m FrameClock) -> IO FrameClock -> m FrameClock
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_frame_clock surface'
    checkUnexpectedReturnNULL "surfaceGetFrameClock" result
    result' <- (newObject Gdk.FrameClock.FrameClock) result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceGetFrameClockMethodInfo
instance (signature ~ (m Gdk.FrameClock.FrameClock), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetFrameClockMethodInfo a signature where
    overloadedMethod = surfaceGetFrameClock

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


#endif

-- method Surface::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , 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_surface_get_height" gdk_surface_get_height :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO Int32

-- | Returns the height of the given /@surface@/.
-- 
-- Surface size is reported in ”application pixels”, not
-- ”device pixels” (see 'GI.Gdk.Objects.Surface.surfaceGetScaleFactor').
surfaceGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Int32
    -- ^ __Returns:__ The height of /@surface@/
surfaceGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Int32
surfaceGetHeight a
surface = 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
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_height surface'
    touchManagedPtr surface
    return result

#if defined(ENABLE_OVERLOADING)
data SurfaceGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetHeightMethodInfo a signature where
    overloadedMethod = surfaceGetHeight

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


#endif

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

foreign import ccall "gdk_surface_get_mapped" gdk_surface_get_mapped :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO CInt

-- | Checks whether the surface has been mapped.
-- 
-- A surface is mapped with 'GI.Gdk.Interfaces.Toplevel.toplevelPresent'
-- or 'GI.Gdk.Interfaces.Popup.popupPresent'.
surfaceGetMapped ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the surface is mapped
surfaceGetMapped :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Bool
surfaceGetMapped a
surface = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_mapped surface'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceGetMappedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetMappedMethodInfo a signature where
    overloadedMethod = surfaceGetMapped

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


#endif

-- method Surface::get_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "surface to get scale for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_get_scale" gdk_surface_get_scale :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO CDouble

-- | Returns the internal scale that maps from surface coordinates
-- to the actual device pixels.
-- 
-- When the scale is bigger than 1, the windowing system prefers to get
-- buffers with a resolution that is bigger than the surface size (e.g.
-- to show the surface on a high-resolution display, or in a magnifier).
-- 
-- Compare with 'GI.Gdk.Objects.Surface.surfaceGetScaleFactor', which returns the
-- next larger integer.
-- 
-- The scale may change during the lifetime of the surface.
-- 
-- /Since: 4.12/
surfaceGetScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: surface to get scale for
    -> m Double
    -- ^ __Returns:__ the scale
surfaceGetScale :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Double
surfaceGetScale a
surface = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_scale surface'
    let result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceGetScaleMethodInfo
instance (signature ~ (m Double), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetScaleMethodInfo a signature where
    overloadedMethod = surfaceGetScale

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


#endif

-- method Surface::get_scale_factor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "surface to get scale factor for"
--                 , 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_surface_get_scale_factor" gdk_surface_get_scale_factor :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO Int32

-- | Returns the internal scale factor that maps from surface coordinates
-- to the actual device pixels.
-- 
-- On traditional systems this is 1, but on very high density outputs
-- this can be a higher value (often 2). A higher value means that drawing
-- is automatically scaled up to a higher resolution, so any code doing
-- drawing will automatically look nicer. However, if you are supplying
-- pixel-based data the scale value can be used to determine whether to
-- use a pixel resource with higher resolution data.
-- 
-- The scale factor may change during the lifetime of the surface.
surfaceGetScaleFactor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: surface to get scale factor for
    -> m Int32
    -- ^ __Returns:__ the scale factor
surfaceGetScaleFactor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Int32
surfaceGetScaleFactor a
surface = 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
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_scale_factor surface'
    touchManagedPtr surface
    return result

#if defined(ENABLE_OVERLOADING)
data SurfaceGetScaleFactorMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetScaleFactorMethodInfo a signature where
    overloadedMethod = surfaceGetScaleFactor

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


#endif

-- method Surface::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , 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_surface_get_width" gdk_surface_get_width :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO Int32

-- | Returns the width of the given /@surface@/.
-- 
-- Surface size is reported in ”application pixels”, not
-- ”device pixels” (see 'GI.Gdk.Objects.Surface.surfaceGetScaleFactor').
surfaceGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Int32
    -- ^ __Returns:__ The width of /@surface@/
surfaceGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Int32
surfaceGetWidth a
surface = 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
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_get_width surface'
    touchManagedPtr surface
    return result

#if defined(ENABLE_OVERLOADING)
data SurfaceGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceGetWidthMethodInfo a signature where
    overloadedMethod = surfaceGetWidth

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


#endif

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

foreign import ccall "gdk_surface_hide" gdk_surface_hide :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Hide the surface.
-- 
-- For toplevel surfaces, withdraws them, so they will no longer be
-- known to the window manager; for all surfaces, unmaps them, so
-- they won’t be displayed. Normally done automatically as
-- part of <http://developer.gnome.org/gdk/stable/../gtk4/method.Widget.hide.html gtk_widget_hide()>.
surfaceHide ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m ()
surfaceHide :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m ()
surfaceHide a
surface = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    gdk_surface_hide surface'
    touchManagedPtr surface
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceHideMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceHideMethodInfo a signature where
    overloadedMethod = surfaceHide

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


#endif

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

foreign import ccall "gdk_surface_is_destroyed" gdk_surface_is_destroyed :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO CInt

-- | Check to see if a surface is destroyed.
surfaceIsDestroyed ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the surface is destroyed
surfaceIsDestroyed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m Bool
surfaceIsDestroyed a
surface = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    result <- gdk_surface_is_destroyed surface'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr surface
    return result'

#if defined(ENABLE_OVERLOADING)
data SurfaceIsDestroyedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceIsDestroyedMethodInfo a signature where
    overloadedMethod = surfaceIsDestroyed

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


#endif

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

foreign import ccall "gdk_surface_queue_render" gdk_surface_queue_render :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Forces a [Surface::render]("GI.Gdk.Objects.Surface#g:signal:render") signal emission for /@surface@/
-- to be scheduled.
-- 
-- This function is useful for implementations that track invalid
-- regions on their own.
surfaceQueueRender ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m ()
surfaceQueueRender :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m ()
surfaceQueueRender a
surface = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    gdk_surface_queue_render surface'
    touchManagedPtr surface
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceQueueRenderMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceQueueRenderMethodInfo a signature where
    overloadedMethod = surfaceQueueRender

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


#endif

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

foreign import ccall "gdk_surface_request_layout" gdk_surface_request_layout :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO ()

-- | Request a layout phase from the surface\'s frame clock.
-- 
-- See 'GI.Gdk.Objects.FrameClock.frameClockRequestPhase'.
surfaceRequestLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> m ()
surfaceRequestLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> m ()
surfaceRequestLayout a
surface = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    gdk_surface_request_layout surface'
    touchManagedPtr surface
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceRequestLayoutMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceRequestLayoutMethodInfo a signature where
    overloadedMethod = surfaceRequestLayout

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


#endif

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

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

-- | Sets the default mouse pointer for a @GdkSurface@.
-- 
-- Passing 'P.Nothing' for the /@cursor@/ argument means that /@surface@/ will use
-- the cursor of its parent surface. Most surfaces should use this default.
-- Note that /@cursor@/ must be for the same display as /@surface@/.
-- 
-- Use 'GI.Gdk.Objects.Cursor.cursorNewFromName' or 'GI.Gdk.Objects.Cursor.cursorNewFromTexture'
-- to create the cursor. To make the cursor invisible, use @/GDK_BLANK_CURSOR/@.
surfaceSetCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a, Gdk.Cursor.IsCursor b) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> Maybe (b)
    -- ^ /@cursor@/: a @GdkCursor@
    -> m ()
surfaceSetCursor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSurface a, IsCursor b) =>
a -> Maybe b -> m ()
surfaceSetCursor a
surface Maybe b
cursor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    maybeCursor <- case cursor 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
jCursor -> do
            jCursor' <- b -> IO (Ptr Cursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCursor
            return jCursor'
    gdk_surface_set_cursor surface' maybeCursor
    touchManagedPtr surface
    whenJust cursor touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceSetCursorMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSurface a, Gdk.Cursor.IsCursor b) => O.OverloadedMethod SurfaceSetCursorMethodInfo a signature where
    overloadedMethod = surfaceSetCursor

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


#endif

-- method Surface::set_device_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer `GdkDevice`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_set_device_cursor" gdk_surface_set_device_cursor :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Ptr Gdk.Cursor.Cursor ->                -- cursor : TInterface (Name {namespace = "Gdk", name = "Cursor"})
    IO ()

-- | Sets a specific @GdkCursor@ for a given device when it gets inside /@surface@/.
-- 
-- Passing 'P.Nothing' for the /@cursor@/ argument means that /@surface@/ will use the
-- cursor of its parent surface. Most surfaces should use this default.
-- 
-- Use 'GI.Gdk.Objects.Cursor.cursorNewFromName' or 'GI.Gdk.Objects.Cursor.cursorNewFromTexture'
-- to create the cursor. To make the cursor invisible, use @/GDK_BLANK_CURSOR/@.
surfaceSetDeviceCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a, Gdk.Device.IsDevice b, Gdk.Cursor.IsCursor c) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> b
    -- ^ /@device@/: a pointer @GdkDevice@
    -> c
    -- ^ /@cursor@/: a @GdkCursor@
    -> m ()
surfaceSetDeviceCursor :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSurface a, IsDevice b, IsCursor c) =>
a -> b -> c -> m ()
surfaceSetDeviceCursor a
surface b
device c
cursor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    device' <- unsafeManagedPtrCastPtr device
    cursor' <- unsafeManagedPtrCastPtr cursor
    gdk_surface_set_device_cursor surface' device' cursor'
    touchManagedPtr surface
    touchManagedPtr device
    touchManagedPtr cursor
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceSetDeviceCursorMethodInfo
instance (signature ~ (b -> c -> m ()), MonadIO m, IsSurface a, Gdk.Device.IsDevice b, Gdk.Cursor.IsCursor c) => O.OverloadedMethod SurfaceSetDeviceCursorMethodInfo a signature where
    overloadedMethod = surfaceSetDeviceCursor

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


#endif

-- method Surface::set_input_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkSurface`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region of surface to be reactive"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_set_input_region" gdk_surface_set_input_region :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Cairo.Region.Region ->              -- region : TInterface (Name {namespace = "cairo", name = "Region"})
    IO ()

-- | Apply the region to the surface for the purpose of event
-- handling.
-- 
-- Mouse events which happen while the pointer position corresponds
-- to an unset bit in the mask will be passed on the surface below
-- /@surface@/.
-- 
-- An input region is typically used with RGBA surfaces. The alpha
-- channel of the surface defines which pixels are invisible and
-- allows for nicely antialiased borders, and the input region
-- controls where the surface is “clickable”.
-- 
-- Use 'GI.Gdk.Objects.Display.displaySupportsInputShapes' to find out if
-- a particular backend supports input regions.
surfaceSetInputRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a @GdkSurface@
    -> Cairo.Region.Region
    -- ^ /@region@/: region of surface to be reactive
    -> m ()
surfaceSetInputRegion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> Region -> m ()
surfaceSetInputRegion a
surface Region
region = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    region' <- unsafeManagedPtrGetPtr region
    gdk_surface_set_input_region surface' region'
    touchManagedPtr surface
    touchManagedPtr region
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceSetInputRegionMethodInfo
instance (signature ~ (Cairo.Region.Region -> m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceSetInputRegionMethodInfo a signature where
    overloadedMethod = surfaceSetInputRegion

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


#endif

-- method Surface::set_opaque_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a top-level `GdkSurface`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a region, or %NULL to make the entire\n  surface opaque"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_set_opaque_region" gdk_surface_set_opaque_region :: 
    Ptr Surface ->                          -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Cairo.Region.Region ->              -- region : TInterface (Name {namespace = "cairo", name = "Region"})
    IO ()

-- | Marks a region of the @GdkSurface@ as opaque.
-- 
-- For optimisation purposes, compositing window managers may
-- like to not draw obscured regions of surfaces, or turn off blending
-- during for these regions. With RGB windows with no transparency,
-- this is just the shape of the window, but with ARGB32 windows, the
-- compositor does not know what regions of the window are transparent
-- or not.
-- 
-- This function only works for toplevel surfaces.
-- 
-- GTK will update this property automatically if the /@surface@/ background
-- is opaque, as we know where the opaque regions are. If your surface
-- background is not opaque, please update this property in your
-- <http://developer.gnome.org/gdk/stable/../gtk4/vfunc.Widget.css_changed.html GtkWidgetClass.css_changed> handler.
surfaceSetOpaqueRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a) =>
    a
    -- ^ /@surface@/: a top-level @GdkSurface@
    -> Maybe (Cairo.Region.Region)
    -- ^ /@region@/: a region, or 'P.Nothing' to make the entire
    --   surface opaque
    -> m ()
surfaceSetOpaqueRegion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
a -> Maybe Region -> m ()
surfaceSetOpaqueRegion a
surface Maybe Region
region = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    maybeRegion <- case region of
        Maybe Region
Nothing -> Ptr Region -> IO (Ptr Region)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Region
forall a. Ptr a
FP.nullPtr
        Just Region
jRegion -> do
            jRegion' <- Region -> IO (Ptr Region)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Region
jRegion
            return jRegion'
    gdk_surface_set_opaque_region surface' maybeRegion
    touchManagedPtr surface
    whenJust region touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data SurfaceSetOpaqueRegionMethodInfo
instance (signature ~ (Maybe (Cairo.Region.Region) -> m ()), MonadIO m, IsSurface a) => O.OverloadedMethod SurfaceSetOpaqueRegionMethodInfo a signature where
    overloadedMethod = surfaceSetOpaqueRegion

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


#endif

-- method Surface::translate_coordinates
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "from"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the origin surface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target surface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "coordinates to translate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "coordinates to translate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_surface_translate_coordinates" gdk_surface_translate_coordinates :: 
    Ptr Surface ->                          -- from : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Surface ->                          -- to : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO CInt

-- | Translates coordinates between two surfaces.
-- 
-- Note that this only works if /@to@/ and /@from@/ are popups or
-- transient-for to the same toplevel (directly or indirectly).
surfaceTranslateCoordinates ::
    (B.CallStack.HasCallStack, MonadIO m, IsSurface a, IsSurface b) =>
    a
    -- ^ /@from@/: the origin surface
    -> b
    -- ^ /@to@/: the target surface
    -> Double
    -- ^ /@x@/: coordinates to translate
    -> Double
    -- ^ /@y@/: coordinates to translate
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the coordinates were successfully translated
surfaceTranslateCoordinates :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSurface a, IsSurface b) =>
a -> b -> Double -> Double -> m (Bool, Double, Double)
surfaceTranslateCoordinates a
from b
to Double
x Double
y = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    from' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
from
    to' <- unsafeManagedPtrCastPtr to
    let x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    x'' <- allocMem :: IO (Ptr CDouble)
    poke x'' x'
    let y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    y'' <- allocMem :: IO (Ptr CDouble)
    poke y'' y'
    result <- gdk_surface_translate_coordinates from' to' x'' y''
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    x''' <- peek x''
    let x'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'''
    y''' <- peek y''
    let y'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'''
    touchManagedPtr from
    touchManagedPtr to
    freeMem x''
    freeMem y''
    return (result', x'''', y'''')

#if defined(ENABLE_OVERLOADING)
data SurfaceTranslateCoordinatesMethodInfo
instance (signature ~ (b -> Double -> Double -> m ((Bool, Double, Double))), MonadIO m, IsSurface a, IsSurface b) => O.OverloadedMethod SurfaceTranslateCoordinatesMethodInfo a signature where
    overloadedMethod = surfaceTranslateCoordinates

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


#endif