{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gdk.Objects.Screen.Screen' objects are the GDK representation of the screen on
-- which windows can be displayed and on which the pointer moves.
-- X originally identified screens with physical screens, but
-- nowadays it is more common to have a single t'GI.Gdk.Objects.Screen.Screen' which
-- combines several physical monitors (see 'GI.Gdk.Objects.Screen.screenGetNMonitors').
-- 
-- GdkScreen is used throughout GDK and GTK+ to specify which screen
-- the top level windows are to be displayed on. it is also used to
-- query the screen specification and default settings such as
-- the default visual ('GI.Gdk.Objects.Screen.screenGetSystemVisual'), the dimensions
-- of the physical monitors ('GI.Gdk.Objects.Screen.screenGetMonitorGeometry'), etc.

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

module GI.Gdk.Objects.Screen
    ( 

-- * Exported types
    Screen(..)                              ,
    IsScreen                                ,
    toScreen                                ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveScreenMethod                     ,
#endif


-- ** getActiveWindow #method:getActiveWindow#

#if defined(ENABLE_OVERLOADING)
    ScreenGetActiveWindowMethodInfo         ,
#endif
    screenGetActiveWindow                   ,


-- ** getDefault #method:getDefault#

    screenGetDefault                        ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    ScreenGetDisplayMethodInfo              ,
#endif
    screenGetDisplay                        ,


-- ** getFontOptions #method:getFontOptions#

#if defined(ENABLE_OVERLOADING)
    ScreenGetFontOptionsMethodInfo          ,
#endif
    screenGetFontOptions                    ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    ScreenGetHeightMethodInfo               ,
#endif
    screenGetHeight                         ,


-- ** getHeightMm #method:getHeightMm#

#if defined(ENABLE_OVERLOADING)
    ScreenGetHeightMmMethodInfo             ,
#endif
    screenGetHeightMm                       ,


-- ** getMonitorAtPoint #method:getMonitorAtPoint#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorAtPointMethodInfo       ,
#endif
    screenGetMonitorAtPoint                 ,


-- ** getMonitorAtWindow #method:getMonitorAtWindow#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorAtWindowMethodInfo      ,
#endif
    screenGetMonitorAtWindow                ,


-- ** getMonitorGeometry #method:getMonitorGeometry#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorGeometryMethodInfo      ,
#endif
    screenGetMonitorGeometry                ,


-- ** getMonitorHeightMm #method:getMonitorHeightMm#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorHeightMmMethodInfo      ,
#endif
    screenGetMonitorHeightMm                ,


-- ** getMonitorPlugName #method:getMonitorPlugName#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorPlugNameMethodInfo      ,
#endif
    screenGetMonitorPlugName                ,


-- ** getMonitorScaleFactor #method:getMonitorScaleFactor#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorScaleFactorMethodInfo   ,
#endif
    screenGetMonitorScaleFactor             ,


-- ** getMonitorWidthMm #method:getMonitorWidthMm#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorWidthMmMethodInfo       ,
#endif
    screenGetMonitorWidthMm                 ,


-- ** getMonitorWorkarea #method:getMonitorWorkarea#

#if defined(ENABLE_OVERLOADING)
    ScreenGetMonitorWorkareaMethodInfo      ,
#endif
    screenGetMonitorWorkarea                ,


-- ** getNMonitors #method:getNMonitors#

#if defined(ENABLE_OVERLOADING)
    ScreenGetNMonitorsMethodInfo            ,
#endif
    screenGetNMonitors                      ,


-- ** getNumber #method:getNumber#

#if defined(ENABLE_OVERLOADING)
    ScreenGetNumberMethodInfo               ,
#endif
    screenGetNumber                         ,


-- ** getPrimaryMonitor #method:getPrimaryMonitor#

#if defined(ENABLE_OVERLOADING)
    ScreenGetPrimaryMonitorMethodInfo       ,
#endif
    screenGetPrimaryMonitor                 ,


-- ** getResolution #method:getResolution#

#if defined(ENABLE_OVERLOADING)
    ScreenGetResolutionMethodInfo           ,
#endif
    screenGetResolution                     ,


-- ** getRgbaVisual #method:getRgbaVisual#

#if defined(ENABLE_OVERLOADING)
    ScreenGetRgbaVisualMethodInfo           ,
#endif
    screenGetRgbaVisual                     ,


-- ** getRootWindow #method:getRootWindow#

#if defined(ENABLE_OVERLOADING)
    ScreenGetRootWindowMethodInfo           ,
#endif
    screenGetRootWindow                     ,


-- ** getSetting #method:getSetting#

#if defined(ENABLE_OVERLOADING)
    ScreenGetSettingMethodInfo              ,
#endif
    screenGetSetting                        ,


-- ** getSystemVisual #method:getSystemVisual#

#if defined(ENABLE_OVERLOADING)
    ScreenGetSystemVisualMethodInfo         ,
#endif
    screenGetSystemVisual                   ,


-- ** getToplevelWindows #method:getToplevelWindows#

#if defined(ENABLE_OVERLOADING)
    ScreenGetToplevelWindowsMethodInfo      ,
#endif
    screenGetToplevelWindows                ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWidthMethodInfo                ,
#endif
    screenGetWidth                          ,


-- ** getWidthMm #method:getWidthMm#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWidthMmMethodInfo              ,
#endif
    screenGetWidthMm                        ,


-- ** getWindowStack #method:getWindowStack#

#if defined(ENABLE_OVERLOADING)
    ScreenGetWindowStackMethodInfo          ,
#endif
    screenGetWindowStack                    ,


-- ** height #method:height#

    screenHeight                            ,


-- ** heightMm #method:heightMm#

    screenHeightMm                          ,


-- ** isComposited #method:isComposited#

#if defined(ENABLE_OVERLOADING)
    ScreenIsCompositedMethodInfo            ,
#endif
    screenIsComposited                      ,


-- ** listVisuals #method:listVisuals#

#if defined(ENABLE_OVERLOADING)
    ScreenListVisualsMethodInfo             ,
#endif
    screenListVisuals                       ,


-- ** makeDisplayName #method:makeDisplayName#

#if defined(ENABLE_OVERLOADING)
    ScreenMakeDisplayNameMethodInfo         ,
#endif
    screenMakeDisplayName                   ,


-- ** setFontOptions #method:setFontOptions#

#if defined(ENABLE_OVERLOADING)
    ScreenSetFontOptionsMethodInfo          ,
#endif
    screenSetFontOptions                    ,


-- ** setResolution #method:setResolution#

#if defined(ENABLE_OVERLOADING)
    ScreenSetResolutionMethodInfo           ,
#endif
    screenSetResolution                     ,


-- ** width #method:width#

    screenWidth                             ,


-- ** widthMm #method:widthMm#

    screenWidthMm                           ,




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

#if defined(ENABLE_OVERLOADING)
    ScreenFontOptionsPropertyInfo           ,
#endif
    constructScreenFontOptions              ,
    getScreenFontOptions                    ,
#if defined(ENABLE_OVERLOADING)
    screenFontOptions                       ,
#endif
    setScreenFontOptions                    ,


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

#if defined(ENABLE_OVERLOADING)
    ScreenResolutionPropertyInfo            ,
#endif
    constructScreenResolution               ,
    getScreenResolution                     ,
#if defined(ENABLE_OVERLOADING)
    screenResolution                        ,
#endif
    setScreenResolution                     ,




 -- * Signals
-- ** compositedChanged #signal:compositedChanged#

    C_ScreenCompositedChangedCallback       ,
    ScreenCompositedChangedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ScreenCompositedChangedSignalInfo       ,
#endif
    afterScreenCompositedChanged            ,
    genClosure_ScreenCompositedChanged      ,
    mk_ScreenCompositedChangedCallback      ,
    noScreenCompositedChangedCallback       ,
    onScreenCompositedChanged               ,
    wrap_ScreenCompositedChangedCallback    ,


-- ** monitorsChanged #signal:monitorsChanged#

    C_ScreenMonitorsChangedCallback         ,
    ScreenMonitorsChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ScreenMonitorsChangedSignalInfo         ,
#endif
    afterScreenMonitorsChanged              ,
    genClosure_ScreenMonitorsChanged        ,
    mk_ScreenMonitorsChangedCallback        ,
    noScreenMonitorsChangedCallback         ,
    onScreenMonitorsChanged                 ,
    wrap_ScreenMonitorsChangedCallback      ,


-- ** sizeChanged #signal:sizeChanged#

    C_ScreenSizeChangedCallback             ,
    ScreenSizeChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ScreenSizeChangedSignalInfo             ,
#endif
    afterScreenSizeChanged                  ,
    genClosure_ScreenSizeChanged            ,
    mk_ScreenSizeChangedCallback            ,
    noScreenSizeChangedCallback             ,
    onScreenSizeChanged                     ,
    wrap_ScreenSizeChangedCallback          ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Visual as Gdk.Visual
import {-# SOURCE #-} qualified GI.Gdk.Objects.Window as Gdk.Window
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle

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

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

foreign import ccall "gdk_screen_get_type"
    c_gdk_screen_get_type :: IO B.Types.GType

instance B.Types.TypedObject Screen where
    glibType :: IO GType
glibType = IO GType
c_gdk_screen_get_type

instance B.Types.GObject Screen

-- | Convert 'Screen' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Screen where
    toGValue :: Screen -> IO GValue
toGValue Screen
o = do
        GType
gtype <- IO GType
c_gdk_screen_get_type
        Screen -> (Ptr Screen -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Screen
o (GType -> (GValue -> Ptr Screen -> IO ()) -> Ptr Screen -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Screen -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Screen
fromGValue GValue
gv = do
        Ptr Screen
ptr <- GValue -> IO (Ptr Screen)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Screen)
        (ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Screen -> Screen
Screen Ptr Screen
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveScreenMethod (t :: Symbol) (o :: *) :: * where
    ResolveScreenMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveScreenMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveScreenMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveScreenMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveScreenMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveScreenMethod "isComposited" o = ScreenIsCompositedMethodInfo
    ResolveScreenMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveScreenMethod "listVisuals" o = ScreenListVisualsMethodInfo
    ResolveScreenMethod "makeDisplayName" o = ScreenMakeDisplayNameMethodInfo
    ResolveScreenMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveScreenMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveScreenMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveScreenMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveScreenMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveScreenMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveScreenMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveScreenMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveScreenMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveScreenMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveScreenMethod "getActiveWindow" o = ScreenGetActiveWindowMethodInfo
    ResolveScreenMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveScreenMethod "getDisplay" o = ScreenGetDisplayMethodInfo
    ResolveScreenMethod "getFontOptions" o = ScreenGetFontOptionsMethodInfo
    ResolveScreenMethod "getHeight" o = ScreenGetHeightMethodInfo
    ResolveScreenMethod "getHeightMm" o = ScreenGetHeightMmMethodInfo
    ResolveScreenMethod "getMonitorAtPoint" o = ScreenGetMonitorAtPointMethodInfo
    ResolveScreenMethod "getMonitorAtWindow" o = ScreenGetMonitorAtWindowMethodInfo
    ResolveScreenMethod "getMonitorGeometry" o = ScreenGetMonitorGeometryMethodInfo
    ResolveScreenMethod "getMonitorHeightMm" o = ScreenGetMonitorHeightMmMethodInfo
    ResolveScreenMethod "getMonitorPlugName" o = ScreenGetMonitorPlugNameMethodInfo
    ResolveScreenMethod "getMonitorScaleFactor" o = ScreenGetMonitorScaleFactorMethodInfo
    ResolveScreenMethod "getMonitorWidthMm" o = ScreenGetMonitorWidthMmMethodInfo
    ResolveScreenMethod "getMonitorWorkarea" o = ScreenGetMonitorWorkareaMethodInfo
    ResolveScreenMethod "getNMonitors" o = ScreenGetNMonitorsMethodInfo
    ResolveScreenMethod "getNumber" o = ScreenGetNumberMethodInfo
    ResolveScreenMethod "getPrimaryMonitor" o = ScreenGetPrimaryMonitorMethodInfo
    ResolveScreenMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveScreenMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveScreenMethod "getResolution" o = ScreenGetResolutionMethodInfo
    ResolveScreenMethod "getRgbaVisual" o = ScreenGetRgbaVisualMethodInfo
    ResolveScreenMethod "getRootWindow" o = ScreenGetRootWindowMethodInfo
    ResolveScreenMethod "getSetting" o = ScreenGetSettingMethodInfo
    ResolveScreenMethod "getSystemVisual" o = ScreenGetSystemVisualMethodInfo
    ResolveScreenMethod "getToplevelWindows" o = ScreenGetToplevelWindowsMethodInfo
    ResolveScreenMethod "getWidth" o = ScreenGetWidthMethodInfo
    ResolveScreenMethod "getWidthMm" o = ScreenGetWidthMmMethodInfo
    ResolveScreenMethod "getWindowStack" o = ScreenGetWindowStackMethodInfo
    ResolveScreenMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveScreenMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveScreenMethod "setFontOptions" o = ScreenSetFontOptionsMethodInfo
    ResolveScreenMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveScreenMethod "setResolution" o = ScreenSetResolutionMethodInfo
    ResolveScreenMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveScreenMethod t Screen, O.MethodInfo info Screen p) => OL.IsLabel t (Screen -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal Screen::composited-changed
-- | The [compositedChanged](#g:signal:compositedChanged) signal is emitted when the composited
-- status of the screen changes
-- 
-- /Since: 2.10/
type ScreenCompositedChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ScreenCompositedChangedCallback`@.
noScreenCompositedChangedCallback :: Maybe ScreenCompositedChangedCallback
noScreenCompositedChangedCallback :: Maybe (IO ())
noScreenCompositedChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ScreenCompositedChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_ScreenCompositedChanged :: MonadIO m => ScreenCompositedChangedCallback -> m (GClosure C_ScreenCompositedChangedCallback)
genClosure_ScreenCompositedChanged :: IO () -> m (GClosure C_ScreenCompositedChangedCallback)
genClosure_ScreenCompositedChanged IO ()
cb = IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ScreenCompositedChangedCallback)
 -> m (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenCompositedChangedCallback IO ()
cb
    C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenCompositedChangedCallback C_ScreenCompositedChangedCallback
cb' IO (FunPtr C_ScreenCompositedChangedCallback)
-> (FunPtr C_ScreenCompositedChangedCallback
    -> IO (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ScreenCompositedChangedCallback
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ScreenCompositedChangedCallback` into a `C_ScreenCompositedChangedCallback`.
wrap_ScreenCompositedChangedCallback ::
    ScreenCompositedChangedCallback ->
    C_ScreenCompositedChangedCallback
wrap_ScreenCompositedChangedCallback :: IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenCompositedChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [compositedChanged](#signal:compositedChanged) 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' screen #compositedChanged callback
-- @
-- 
-- 
onScreenCompositedChanged :: (IsScreen a, MonadIO m) => a -> ScreenCompositedChangedCallback -> m SignalHandlerId
onScreenCompositedChanged :: a -> IO () -> m SignalHandlerId
onScreenCompositedChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenCompositedChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenCompositedChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"composited-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [compositedChanged](#signal:compositedChanged) 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' screen #compositedChanged callback
-- @
-- 
-- 
afterScreenCompositedChanged :: (IsScreen a, MonadIO m) => a -> ScreenCompositedChangedCallback -> m SignalHandlerId
afterScreenCompositedChanged :: a -> IO () -> m SignalHandlerId
afterScreenCompositedChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenCompositedChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenCompositedChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"composited-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenCompositedChangedSignalInfo
instance SignalInfo ScreenCompositedChangedSignalInfo where
    type HaskellCallbackType ScreenCompositedChangedSignalInfo = ScreenCompositedChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenCompositedChangedCallback cb
        cb'' <- mk_ScreenCompositedChangedCallback cb'
        connectSignalFunPtr obj "composited-changed" cb'' connectMode detail

#endif

-- signal Screen::monitors-changed
-- | The [monitorsChanged](#g:signal:monitorsChanged) signal is emitted when the number, size
-- or position of the monitors attached to the screen change.
-- 
-- Only for X11 and OS X for now. A future implementation for Win32
-- may be a possibility.
-- 
-- /Since: 2.14/
type ScreenMonitorsChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ScreenMonitorsChangedCallback`@.
noScreenMonitorsChangedCallback :: Maybe ScreenMonitorsChangedCallback
noScreenMonitorsChangedCallback :: Maybe (IO ())
noScreenMonitorsChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ScreenMonitorsChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_ScreenMonitorsChanged :: MonadIO m => ScreenMonitorsChangedCallback -> m (GClosure C_ScreenMonitorsChangedCallback)
genClosure_ScreenMonitorsChanged :: IO () -> m (GClosure C_ScreenCompositedChangedCallback)
genClosure_ScreenMonitorsChanged IO ()
cb = IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ScreenCompositedChangedCallback)
 -> m (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenMonitorsChangedCallback IO ()
cb
    C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenMonitorsChangedCallback C_ScreenCompositedChangedCallback
cb' IO (FunPtr C_ScreenCompositedChangedCallback)
-> (FunPtr C_ScreenCompositedChangedCallback
    -> IO (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ScreenCompositedChangedCallback
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ScreenMonitorsChangedCallback` into a `C_ScreenMonitorsChangedCallback`.
wrap_ScreenMonitorsChangedCallback ::
    ScreenMonitorsChangedCallback ->
    C_ScreenMonitorsChangedCallback
wrap_ScreenMonitorsChangedCallback :: IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenMonitorsChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [monitorsChanged](#signal:monitorsChanged) 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' screen #monitorsChanged callback
-- @
-- 
-- 
onScreenMonitorsChanged :: (IsScreen a, MonadIO m) => a -> ScreenMonitorsChangedCallback -> m SignalHandlerId
onScreenMonitorsChanged :: a -> IO () -> m SignalHandlerId
onScreenMonitorsChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenMonitorsChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenMonitorsChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"monitors-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [monitorsChanged](#signal:monitorsChanged) 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' screen #monitorsChanged callback
-- @
-- 
-- 
afterScreenMonitorsChanged :: (IsScreen a, MonadIO m) => a -> ScreenMonitorsChangedCallback -> m SignalHandlerId
afterScreenMonitorsChanged :: a -> IO () -> m SignalHandlerId
afterScreenMonitorsChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenMonitorsChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenMonitorsChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"monitors-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenMonitorsChangedSignalInfo
instance SignalInfo ScreenMonitorsChangedSignalInfo where
    type HaskellCallbackType ScreenMonitorsChangedSignalInfo = ScreenMonitorsChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenMonitorsChangedCallback cb
        cb'' <- mk_ScreenMonitorsChangedCallback cb'
        connectSignalFunPtr obj "monitors-changed" cb'' connectMode detail

#endif

-- signal Screen::size-changed
-- | The [sizeChanged](#g:signal:sizeChanged) signal is emitted when the pixel width or
-- height of a screen changes.
-- 
-- /Since: 2.2/
type ScreenSizeChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ScreenSizeChangedCallback`@.
noScreenSizeChangedCallback :: Maybe ScreenSizeChangedCallback
noScreenSizeChangedCallback :: Maybe (IO ())
noScreenSizeChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ScreenSizeChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_ScreenSizeChanged :: MonadIO m => ScreenSizeChangedCallback -> m (GClosure C_ScreenSizeChangedCallback)
genClosure_ScreenSizeChanged :: IO () -> m (GClosure C_ScreenCompositedChangedCallback)
genClosure_ScreenSizeChanged IO ()
cb = IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ScreenCompositedChangedCallback)
 -> m (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
-> m (GClosure C_ScreenCompositedChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenSizeChangedCallback IO ()
cb
    C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenSizeChangedCallback C_ScreenCompositedChangedCallback
cb' IO (FunPtr C_ScreenCompositedChangedCallback)
-> (FunPtr C_ScreenCompositedChangedCallback
    -> IO (GClosure C_ScreenCompositedChangedCallback))
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ScreenCompositedChangedCallback
-> IO (GClosure C_ScreenCompositedChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ScreenSizeChangedCallback` into a `C_ScreenSizeChangedCallback`.
wrap_ScreenSizeChangedCallback ::
    ScreenSizeChangedCallback ->
    C_ScreenSizeChangedCallback
wrap_ScreenSizeChangedCallback :: IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenSizeChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [sizeChanged](#signal:sizeChanged) 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' screen #sizeChanged callback
-- @
-- 
-- 
onScreenSizeChanged :: (IsScreen a, MonadIO m) => a -> ScreenSizeChangedCallback -> m SignalHandlerId
onScreenSizeChanged :: a -> IO () -> m SignalHandlerId
onScreenSizeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenSizeChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenSizeChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"size-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [sizeChanged](#signal:sizeChanged) 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' screen #sizeChanged callback
-- @
-- 
-- 
afterScreenSizeChanged :: (IsScreen a, MonadIO m) => a -> ScreenSizeChangedCallback -> m SignalHandlerId
afterScreenSizeChanged :: a -> IO () -> m SignalHandlerId
afterScreenSizeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ScreenCompositedChangedCallback
cb' = IO () -> C_ScreenCompositedChangedCallback
wrap_ScreenSizeChangedCallback IO ()
cb
    FunPtr C_ScreenCompositedChangedCallback
cb'' <- C_ScreenCompositedChangedCallback
-> IO (FunPtr C_ScreenCompositedChangedCallback)
mk_ScreenSizeChangedCallback C_ScreenCompositedChangedCallback
cb'
    a
-> Text
-> FunPtr C_ScreenCompositedChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"size-changed" FunPtr C_ScreenCompositedChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ScreenSizeChangedSignalInfo
instance SignalInfo ScreenSizeChangedSignalInfo where
    type HaskellCallbackType ScreenSizeChangedSignalInfo = ScreenSizeChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ScreenSizeChangedCallback cb
        cb'' <- mk_ScreenSizeChangedCallback cb'
        connectSignalFunPtr obj "size-changed" cb'' connectMode detail

#endif

-- VVV Prop "font-options"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@font-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' screen #fontOptions
-- @
getScreenFontOptions :: (MonadIO m, IsScreen o) => o -> m (Ptr ())
getScreenFontOptions :: o -> m (Ptr ())
getScreenFontOptions o
obj = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"font-options"

-- | Set the value of the “@font-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' screen [ #fontOptions 'Data.GI.Base.Attributes.:=' value ]
-- @
setScreenFontOptions :: (MonadIO m, IsScreen o) => o -> Ptr () -> m ()
setScreenFontOptions :: o -> Ptr () -> m ()
setScreenFontOptions o
obj Ptr ()
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Ptr () -> IO ()
forall a b. GObject a => a -> String -> Ptr b -> IO ()
B.Properties.setObjectPropertyPtr o
obj String
"font-options" Ptr ()
val

-- | Construct a `GValueConstruct` with valid value for the “@font-options@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructScreenFontOptions :: (IsScreen o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructScreenFontOptions :: Ptr () -> m (GValueConstruct o)
constructScreenFontOptions Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"font-options" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data ScreenFontOptionsPropertyInfo
instance AttrInfo ScreenFontOptionsPropertyInfo where
    type AttrAllowedOps ScreenFontOptionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ScreenFontOptionsPropertyInfo = IsScreen
    type AttrSetTypeConstraint ScreenFontOptionsPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint ScreenFontOptionsPropertyInfo = (~) (Ptr ())
    type AttrTransferType ScreenFontOptionsPropertyInfo = Ptr ()
    type AttrGetType ScreenFontOptionsPropertyInfo = (Ptr ())
    type AttrLabel ScreenFontOptionsPropertyInfo = "font-options"
    type AttrOrigin ScreenFontOptionsPropertyInfo = Screen
    attrGet = getScreenFontOptions
    attrSet = setScreenFontOptions
    attrTransfer _ v = do
        return v
    attrConstruct = constructScreenFontOptions
    attrClear = undefined
#endif

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

-- | Get the value of the “@resolution@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' screen #resolution
-- @
getScreenResolution :: (MonadIO m, IsScreen o) => o -> m Double
getScreenResolution :: o -> m Double
getScreenResolution o
obj = IO Double -> m Double
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
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"resolution"

-- | Set the value of the “@resolution@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' screen [ #resolution 'Data.GI.Base.Attributes.:=' value ]
-- @
setScreenResolution :: (MonadIO m, IsScreen o) => o -> Double -> m ()
setScreenResolution :: o -> Double -> m ()
setScreenResolution o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"resolution" Double
val

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

#if defined(ENABLE_OVERLOADING)
data ScreenResolutionPropertyInfo
instance AttrInfo ScreenResolutionPropertyInfo where
    type AttrAllowedOps ScreenResolutionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ScreenResolutionPropertyInfo = IsScreen
    type AttrSetTypeConstraint ScreenResolutionPropertyInfo = (~) Double
    type AttrTransferTypeConstraint ScreenResolutionPropertyInfo = (~) Double
    type AttrTransferType ScreenResolutionPropertyInfo = Double
    type AttrGetType ScreenResolutionPropertyInfo = Double
    type AttrLabel ScreenResolutionPropertyInfo = "resolution"
    type AttrOrigin ScreenResolutionPropertyInfo = Screen
    attrGet = getScreenResolution
    attrSet = setScreenResolution
    attrTransfer _ v = do
        return v
    attrConstruct = constructScreenResolution
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Screen
type instance O.AttributeList Screen = ScreenAttributeList
type ScreenAttributeList = ('[ '("fontOptions", ScreenFontOptionsPropertyInfo), '("resolution", ScreenResolutionPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
screenFontOptions :: AttrLabelProxy "fontOptions"
screenFontOptions = AttrLabelProxy

screenResolution :: AttrLabelProxy "resolution"
screenResolution = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Screen = ScreenSignalList
type ScreenSignalList = ('[ '("compositedChanged", ScreenCompositedChangedSignalInfo), '("monitorsChanged", ScreenMonitorsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("sizeChanged", ScreenSizeChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Screen::get_active_window
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Window" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_active_window" gdk_screen_get_active_window :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Gdk.Window.Window)

{-# DEPRECATED screenGetActiveWindow ["(Since version 3.22)"] #-}
-- | Returns the screen’s currently active window.
-- 
-- On X11, this is done by inspecting the _NET_ACTIVE_WINDOW property
-- on the root window, as described in the
-- <http://www.freedesktop.org/Standards/wm-spec Extended Window Manager Hints>.
-- If there is no currently currently active
-- window, or the window manager does not support the
-- _NET_ACTIVE_WINDOW hint, this function returns 'P.Nothing'.
-- 
-- On other platforms, this function may return 'P.Nothing', depending on whether
-- it is implementable on that platform.
-- 
-- The returned window should be unrefed using 'GI.GObject.Objects.Object.objectUnref' when
-- no longer needed.
-- 
-- /Since: 2.10/
screenGetActiveWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m (Maybe Gdk.Window.Window)
    -- ^ __Returns:__ the currently active window,
    --   or 'P.Nothing'.
screenGetActiveWindow :: a -> m (Maybe Window)
screenGetActiveWindow a
screen = IO (Maybe Window) -> m (Maybe Window)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Window) -> m (Maybe Window))
-> IO (Maybe Window) -> m (Maybe Window)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Window
result <- Ptr Screen -> IO (Ptr Window)
gdk_screen_get_active_window Ptr Screen
screen'
    Maybe Window
maybeResult <- Ptr Window -> (Ptr Window -> IO Window) -> IO (Maybe Window)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Window
result ((Ptr Window -> IO Window) -> IO (Maybe Window))
-> (Ptr Window -> IO Window) -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$ \Ptr Window
result' -> do
        Window
result'' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Window -> Window
Gdk.Window.Window) Ptr Window
result'
        Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe Window -> IO (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetActiveWindowMethodInfo
instance (signature ~ (m (Maybe Gdk.Window.Window)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetActiveWindowMethodInfo a signature where
    overloadedMethod = screenGetActiveWindow

#endif

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

foreign import ccall "gdk_screen_get_display" gdk_screen_get_display :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the display to which the /@screen@/ belongs.
-- 
-- /Since: 2.2/
screenGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Gdk.Display.Display
    -- ^ __Returns:__ the display to which /@screen@/ belongs
screenGetDisplay :: a -> m Display
screenGetDisplay a
screen = IO Display -> m Display
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
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Display
result <- Ptr Screen -> IO (Ptr Display)
gdk_screen_get_display Ptr Screen
screen'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetDisplay" Ptr Display
result
    Display
result' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetDisplayMethodInfo a signature where
    overloadedMethod = screenGetDisplay

#endif

-- method Screen::get_font_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "cairo" , name = "FontOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_font_options" gdk_screen_get_font_options :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Cairo.FontOptions.FontOptions)

-- | Gets any options previously set with 'GI.Gdk.Objects.Screen.screenSetFontOptions'.
-- 
-- /Since: 2.10/
screenGetFontOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m (Maybe Cairo.FontOptions.FontOptions)
    -- ^ __Returns:__ the current font options, or 'P.Nothing' if no
    --  default font options have been set.
screenGetFontOptions :: a -> m (Maybe FontOptions)
screenGetFontOptions a
screen = IO (Maybe FontOptions) -> m (Maybe FontOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FontOptions) -> m (Maybe FontOptions))
-> IO (Maybe FontOptions) -> m (Maybe FontOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr FontOptions
result <- Ptr Screen -> IO (Ptr FontOptions)
gdk_screen_get_font_options Ptr Screen
screen'
    Maybe FontOptions
maybeResult <- Ptr FontOptions
-> (Ptr FontOptions -> IO FontOptions) -> IO (Maybe FontOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FontOptions
result ((Ptr FontOptions -> IO FontOptions) -> IO (Maybe FontOptions))
-> (Ptr FontOptions -> IO FontOptions) -> IO (Maybe FontOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr FontOptions
result' -> do
        FontOptions
result'' <- ((ManagedPtr FontOptions -> FontOptions)
-> Ptr FontOptions -> IO FontOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr FontOptions -> FontOptions
Cairo.FontOptions.FontOptions) Ptr FontOptions
result'
        FontOptions -> IO FontOptions
forall (m :: * -> *) a. Monad m => a -> m a
return FontOptions
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe FontOptions -> IO (Maybe FontOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetFontOptionsMethodInfo
instance (signature ~ (m (Maybe Cairo.FontOptions.FontOptions)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetFontOptionsMethodInfo a signature where
    overloadedMethod = screenGetFontOptions

#endif

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

foreign import ccall "gdk_screen_get_height" gdk_screen_get_height :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetHeight ["(Since version 3.22)","Use per-monitor information instead"] #-}
-- | Gets the height of /@screen@/ in pixels. The returned size is in
-- ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
-- 
-- /Since: 2.2/
screenGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ the height of /@screen@/ in pixels.
screenGetHeight :: a -> m Int32
screenGetHeight a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_height Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetHeightMethodInfo a signature where
    overloadedMethod = screenGetHeight

#endif

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

foreign import ccall "gdk_screen_get_height_mm" gdk_screen_get_height_mm :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetHeightMm ["(Since version 3.22)","Use per-monitor information instead"] #-}
-- | Returns the height of /@screen@/ in millimeters.
-- 
-- Note that this value is somewhat ill-defined when the screen
-- has multiple monitors of different resolution. It is recommended
-- to use the monitor dimensions instead.
-- 
-- /Since: 2.2/
screenGetHeightMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ the heigth of /@screen@/ in millimeters.
screenGetHeightMm :: a -> m Int32
screenGetHeightMm a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_height_mm Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetHeightMmMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetHeightMmMethodInfo a signature where
    overloadedMethod = screenGetHeightMm

#endif

-- method Screen::get_monitor_at_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate in the virtual screen."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate in the virtual screen."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_at_point" gdk_screen_get_monitor_at_point :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO Int32

{-# DEPRECATED screenGetMonitorAtPoint ["(Since version 3.22)","Use 'GI.Gdk.Objects.Display.displayGetMonitorAtPoint' instead"] #-}
-- | Returns the monitor number in which the point (/@x@/,/@y@/) is located.
-- 
-- /Since: 2.2/
screenGetMonitorAtPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'.
    -> Int32
    -- ^ /@x@/: the x coordinate in the virtual screen.
    -> Int32
    -- ^ /@y@/: the y coordinate in the virtual screen.
    -> m Int32
    -- ^ __Returns:__ the monitor number in which the point (/@x@/,/@y@/) lies, or
    --   a monitor close to (/@x@/,/@y@/) if the point is not in any monitor.
screenGetMonitorAtPoint :: a -> Int32 -> Int32 -> m Int32
screenGetMonitorAtPoint a
screen Int32
x Int32
y = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> Int32 -> Int32 -> IO Int32
gdk_screen_get_monitor_at_point Ptr Screen
screen' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorAtPointMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorAtPointMethodInfo a signature where
    overloadedMethod = screenGetMonitorAtPoint

#endif

-- method Screen::get_monitor_at_window
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkWindow" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_at_window" gdk_screen_get_monitor_at_window :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Ptr Gdk.Window.Window ->                -- window : TInterface (Name {namespace = "Gdk", name = "Window"})
    IO Int32

{-# DEPRECATED screenGetMonitorAtWindow ["(Since version 3.22)","Use 'GI.Gdk.Objects.Display.displayGetMonitorAtWindow' instead"] #-}
-- | Returns the number of the monitor in which the largest area of the
-- bounding rectangle of /@window@/ resides.
-- 
-- /Since: 2.2/
screenGetMonitorAtWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a, Gdk.Window.IsWindow b) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'.
    -> b
    -- ^ /@window@/: a t'GI.Gdk.Objects.Window.Window'
    -> m Int32
    -- ^ __Returns:__ the monitor number in which most of /@window@/ is located,
    --     or if /@window@/ does not intersect any monitors, a monitor,
    --     close to /@window@/.
screenGetMonitorAtWindow :: a -> b -> m Int32
screenGetMonitorAtWindow a
screen b
window = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Window
window' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
window
    Int32
result <- Ptr Screen -> Ptr Window -> IO Int32
gdk_screen_get_monitor_at_window Ptr Screen
screen' Ptr Window
window'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
window
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorAtWindowMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsScreen a, Gdk.Window.IsWindow b) => O.MethodInfo ScreenGetMonitorAtWindowMethodInfo a signature where
    overloadedMethod = screenGetMonitorAtWindow

#endif

-- method Screen::get_monitor_geometry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the monitor number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkRectangle to be filled with\n    the monitor geometry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_geometry" gdk_screen_get_monitor_geometry :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    Ptr Gdk.Rectangle.Rectangle ->          -- dest : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

{-# DEPRECATED screenGetMonitorGeometry ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetGeometry' instead"] #-}
-- | Retrieves the t'GI.Gdk.Structs.Rectangle.Rectangle' representing the size and position of
-- the individual monitor within the entire screen area. The returned
-- geometry is in ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
-- 
-- Monitor numbers start at 0. To obtain the number of monitors of
-- /@screen@/, use 'GI.Gdk.Objects.Screen.screenGetNMonitors'.
-- 
-- Note that the size of the entire screen area can be retrieved via
-- 'GI.Gdk.Objects.Screen.screenGetWidth' and 'GI.Gdk.Objects.Screen.screenGetHeight'.
-- 
-- /Since: 2.2/
screenGetMonitorGeometry ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Int32
    -- ^ /@monitorNum@/: the monitor number
    -> m (Gdk.Rectangle.Rectangle)
screenGetMonitorGeometry :: a -> Int32 -> m Rectangle
screenGetMonitorGeometry a
screen Int32
monitorNum = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Rectangle
dest <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Screen -> Int32 -> Ptr Rectangle -> IO ()
gdk_screen_get_monitor_geometry Ptr Screen
screen' Int32
monitorNum Ptr Rectangle
dest
    Rectangle
dest' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
dest'

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorGeometryMethodInfo
instance (signature ~ (Int32 -> m (Gdk.Rectangle.Rectangle)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorGeometryMethodInfo a signature where
    overloadedMethod = screenGetMonitorGeometry

#endif

-- method Screen::get_monitor_height_mm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_height_mm" gdk_screen_get_monitor_height_mm :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    IO Int32

{-# DEPRECATED screenGetMonitorHeightMm ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetHeightMm' instead"] #-}
-- | Gets the height in millimeters of the specified monitor.
-- 
-- /Since: 2.14/
screenGetMonitorHeightMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Int32
    -- ^ /@monitorNum@/: number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)
    -> m Int32
    -- ^ __Returns:__ the height of the monitor, or -1 if not available
screenGetMonitorHeightMm :: a -> Int32 -> m Int32
screenGetMonitorHeightMm a
screen Int32
monitorNum = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> Int32 -> IO Int32
gdk_screen_get_monitor_height_mm Ptr Screen
screen' Int32
monitorNum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorHeightMmMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorHeightMmMethodInfo a signature where
    overloadedMethod = screenGetMonitorHeightMm

#endif

-- method Screen::get_monitor_plug_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_plug_name" gdk_screen_get_monitor_plug_name :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    IO CString

{-# DEPRECATED screenGetMonitorPlugName ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetModel' instead"] #-}
-- | Returns the output name of the specified monitor.
-- Usually something like VGA, DVI, or TV, not the actual
-- product name of the display device.
-- 
-- /Since: 2.14/
screenGetMonitorPlugName ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Int32
    -- ^ /@monitorNum@/: number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly-allocated string containing the name
    --   of the monitor, or 'P.Nothing' if the name cannot be determined
screenGetMonitorPlugName :: a -> Int32 -> m (Maybe Text)
screenGetMonitorPlugName a
screen Int32
monitorNum = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CString
result <- Ptr Screen -> Int32 -> IO CString
gdk_screen_get_monitor_plug_name Ptr Screen
screen' Int32
monitorNum
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorPlugNameMethodInfo
instance (signature ~ (Int32 -> m (Maybe T.Text)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorPlugNameMethodInfo a signature where
    overloadedMethod = screenGetMonitorPlugName

#endif

-- method Screen::get_monitor_scale_factor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "screen to get scale factor for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_scale_factor" gdk_screen_get_monitor_scale_factor :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    IO Int32

{-# DEPRECATED screenGetMonitorScaleFactor ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetScaleFactor' instead"] #-}
-- | Returns the internal scale factor that maps from monitor 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).
-- 
-- This can be used if you want to create pixel based data for a
-- particular monitor, but most of the time you’re drawing to a window
-- where it is better to use 'GI.Gdk.Objects.Window.windowGetScaleFactor' instead.
-- 
-- /Since: 3.10/
screenGetMonitorScaleFactor ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: screen to get scale factor for
    -> Int32
    -- ^ /@monitorNum@/: number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)
    -> m Int32
    -- ^ __Returns:__ the scale factor
screenGetMonitorScaleFactor :: a -> Int32 -> m Int32
screenGetMonitorScaleFactor a
screen Int32
monitorNum = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> Int32 -> IO Int32
gdk_screen_get_monitor_scale_factor Ptr Screen
screen' Int32
monitorNum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorScaleFactorMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorScaleFactorMethodInfo a signature where
    overloadedMethod = screenGetMonitorScaleFactor

#endif

-- method Screen::get_monitor_width_mm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_width_mm" gdk_screen_get_monitor_width_mm :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    IO Int32

{-# DEPRECATED screenGetMonitorWidthMm ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetWidthMm' instead"] #-}
-- | Gets the width in millimeters of the specified monitor, if available.
-- 
-- /Since: 2.14/
screenGetMonitorWidthMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Int32
    -- ^ /@monitorNum@/: number of the monitor, between 0 and gdk_screen_get_n_monitors (screen)
    -> m Int32
    -- ^ __Returns:__ the width of the monitor, or -1 if not available
screenGetMonitorWidthMm :: a -> Int32 -> m Int32
screenGetMonitorWidthMm a
screen Int32
monitorNum = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> Int32 -> IO Int32
gdk_screen_get_monitor_width_mm Ptr Screen
screen' Int32
monitorNum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorWidthMmMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorWidthMmMethodInfo a signature where
    overloadedMethod = screenGetMonitorWidthMm

#endif

-- method Screen::get_monitor_workarea
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "monitor_num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the monitor number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkRectangle to be filled with\n    the monitor workarea"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_workarea" gdk_screen_get_monitor_workarea :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Int32 ->                                -- monitor_num : TBasicType TInt
    Ptr Gdk.Rectangle.Rectangle ->          -- dest : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

{-# DEPRECATED screenGetMonitorWorkarea ["(Since version 3.22)","Use 'GI.Gdk.Objects.Monitor.monitorGetWorkarea' instead"] #-}
-- | Retrieves the t'GI.Gdk.Structs.Rectangle.Rectangle' representing the size and position of
-- the “work area” on a monitor within the entire screen area. The returned
-- geometry is in ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
-- 
-- The work area should be considered when positioning menus and
-- similar popups, to avoid placing them below panels, docks or other
-- desktop components.
-- 
-- Note that not all backends may have a concept of workarea. This
-- function will return the monitor geometry if a workarea is not
-- available, or does not apply.
-- 
-- Monitor numbers start at 0. To obtain the number of monitors of
-- /@screen@/, use 'GI.Gdk.Objects.Screen.screenGetNMonitors'.
-- 
-- /Since: 3.4/
screenGetMonitorWorkarea ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Int32
    -- ^ /@monitorNum@/: the monitor number
    -> m (Gdk.Rectangle.Rectangle)
screenGetMonitorWorkarea :: a -> Int32 -> m Rectangle
screenGetMonitorWorkarea a
screen Int32
monitorNum = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Rectangle
dest <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Screen -> Int32 -> Ptr Rectangle -> IO ()
gdk_screen_get_monitor_workarea Ptr Screen
screen' Int32
monitorNum Ptr Rectangle
dest
    Rectangle
dest' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
dest'

#if defined(ENABLE_OVERLOADING)
data ScreenGetMonitorWorkareaMethodInfo
instance (signature ~ (Int32 -> m (Gdk.Rectangle.Rectangle)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetMonitorWorkareaMethodInfo a signature where
    overloadedMethod = screenGetMonitorWorkarea

#endif

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

foreign import ccall "gdk_screen_get_n_monitors" gdk_screen_get_n_monitors :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetNMonitors ["(Since version 3.22)","Use 'GI.Gdk.Objects.Display.displayGetNMonitors' instead"] #-}
-- | Returns the number of monitors which /@screen@/ consists of.
-- 
-- /Since: 2.2/
screenGetNMonitors ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ number of monitors which /@screen@/ consists of
screenGetNMonitors :: a -> m Int32
screenGetNMonitors a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_n_monitors Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetNMonitorsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetNMonitorsMethodInfo a signature where
    overloadedMethod = screenGetNMonitors

#endif

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

foreign import ccall "gdk_screen_get_number" gdk_screen_get_number :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetNumber ["(Since version 3.22)"] #-}
-- | Gets the index of /@screen@/ among the screens in the display
-- to which it belongs. (See 'GI.Gdk.Objects.Screen.screenGetDisplay')
-- 
-- /Since: 2.2/
screenGetNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ the index
screenGetNumber :: a -> m Int32
screenGetNumber a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_number Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetNumberMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetNumberMethodInfo a signature where
    overloadedMethod = screenGetNumber

#endif

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

foreign import ccall "gdk_screen_get_primary_monitor" gdk_screen_get_primary_monitor :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetPrimaryMonitor ["(Since version 3.22)","Use 'GI.Gdk.Objects.Display.displayGetPrimaryMonitor' instead"] #-}
-- | Gets the primary monitor for /@screen@/.  The primary monitor
-- is considered the monitor where the “main desktop” lives.
-- While normal application windows typically allow the window
-- manager to place the windows, specialized desktop applications
-- such as panels should place themselves on the primary monitor.
-- 
-- If no primary monitor is configured by the user, the return value
-- will be 0, defaulting to the first monitor.
-- 
-- /Since: 2.20/
screenGetPrimaryMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'.
    -> m Int32
    -- ^ __Returns:__ An integer index for the primary monitor, or 0 if none is configured.
screenGetPrimaryMonitor :: a -> m Int32
screenGetPrimaryMonitor a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_primary_monitor Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetPrimaryMonitorMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetPrimaryMonitorMethodInfo a signature where
    overloadedMethod = screenGetPrimaryMonitor

#endif

-- method Screen::get_resolution
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_resolution" gdk_screen_get_resolution :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO CDouble

-- | Gets the resolution for font handling on the screen; see
-- 'GI.Gdk.Objects.Screen.screenSetResolution' for full details.
-- 
-- /Since: 2.10/
screenGetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Double
    -- ^ __Returns:__ the current resolution, or -1 if no resolution
    -- has been set.
screenGetResolution :: a -> m Double
screenGetResolution a
screen = IO Double -> m Double
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
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CDouble
result <- Ptr Screen -> IO CDouble
gdk_screen_get_resolution Ptr Screen
screen'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetResolutionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetResolutionMethodInfo a signature where
    overloadedMethod = screenGetResolution

#endif

-- method Screen::get_rgba_visual
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Visual" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_rgba_visual" gdk_screen_get_rgba_visual :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Gdk.Visual.Visual)

-- | Gets a visual to use for creating windows with an alpha channel.
-- The windowing system on which GTK+ is running
-- may not support this capability, in which case 'P.Nothing' will
-- be returned. Even if a non-'P.Nothing' value is returned, its
-- possible that the window’s alpha channel won’t be honored
-- when displaying the window on the screen: in particular, for
-- X an appropriate windowing manager and compositing manager
-- must be running to provide appropriate display.
-- 
-- This functionality is not implemented in the Windows backend.
-- 
-- For setting an overall opacity for a top-level window, see
-- 'GI.Gdk.Objects.Window.windowSetOpacity'.
-- 
-- /Since: 2.8/
screenGetRgbaVisual ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m (Maybe Gdk.Visual.Visual)
    -- ^ __Returns:__ a visual to use for windows
    --     with an alpha channel or 'P.Nothing' if the capability is not
    --     available.
screenGetRgbaVisual :: a -> m (Maybe Visual)
screenGetRgbaVisual a
screen = IO (Maybe Visual) -> m (Maybe Visual)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Visual) -> m (Maybe Visual))
-> IO (Maybe Visual) -> m (Maybe Visual)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Visual
result <- Ptr Screen -> IO (Ptr Visual)
gdk_screen_get_rgba_visual Ptr Screen
screen'
    Maybe Visual
maybeResult <- Ptr Visual -> (Ptr Visual -> IO Visual) -> IO (Maybe Visual)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Visual
result ((Ptr Visual -> IO Visual) -> IO (Maybe Visual))
-> (Ptr Visual -> IO Visual) -> IO (Maybe Visual)
forall a b. (a -> b) -> a -> b
$ \Ptr Visual
result' -> do
        Visual
result'' <- ((ManagedPtr Visual -> Visual) -> Ptr Visual -> IO Visual
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Visual -> Visual
Gdk.Visual.Visual) Ptr Visual
result'
        Visual -> IO Visual
forall (m :: * -> *) a. Monad m => a -> m a
return Visual
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe Visual -> IO (Maybe Visual)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Visual
maybeResult

#if defined(ENABLE_OVERLOADING)
data ScreenGetRgbaVisualMethodInfo
instance (signature ~ (m (Maybe Gdk.Visual.Visual)), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetRgbaVisualMethodInfo a signature where
    overloadedMethod = screenGetRgbaVisual

#endif

-- method Screen::get_root_window
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Window" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_root_window" gdk_screen_get_root_window :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Gdk.Window.Window)

-- | Gets the root window of /@screen@/.
-- 
-- /Since: 2.2/
screenGetRootWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Gdk.Window.Window
    -- ^ __Returns:__ the root window
screenGetRootWindow :: a -> m Window
screenGetRootWindow a
screen = IO Window -> m Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Window
result <- Ptr Screen -> IO (Ptr Window)
gdk_screen_get_root_window Ptr Screen
screen'
    Text -> Ptr Window -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetRootWindow" Ptr Window
result
    Window
result' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Gdk.Window.Window) Ptr Window
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Window -> IO Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetRootWindowMethodInfo
instance (signature ~ (m Gdk.Window.Window), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetRootWindowMethodInfo a signature where
    overloadedMethod = screenGetRootWindow

#endif

-- method Screen::get_setting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkScreen where the setting is located"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the value of the setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_setting" gdk_screen_get_setting :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Retrieves a desktop-wide setting such as double-click time
-- for the t'GI.Gdk.Objects.Screen.Screen' /@screen@/.
-- 
-- FIXME needs a list of valid settings here, or a link to
-- more information.
-- 
-- /Since: 2.2/
screenGetSetting ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: the t'GI.Gdk.Objects.Screen.Screen' where the setting is located
    -> T.Text
    -- ^ /@name@/: the name of the setting
    -> GValue
    -- ^ /@value@/: location to store the value of the setting
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the setting existed and a value was stored
    --   in /@value@/, 'P.False' otherwise.
screenGetSetting :: a -> Text -> GValue -> m Bool
screenGetSetting a
screen Text
name GValue
value = IO Bool -> m Bool
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
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr Screen -> CString -> Ptr GValue -> IO CInt
gdk_screen_get_setting Ptr Screen
screen' CString
name' Ptr GValue
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetSettingMethodInfo
instance (signature ~ (T.Text -> GValue -> m Bool), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetSettingMethodInfo a signature where
    overloadedMethod = screenGetSetting

#endif

-- method Screen::get_system_visual
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Visual" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_system_visual" gdk_screen_get_system_visual :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr Gdk.Visual.Visual)

-- | Get the system’s default visual for /@screen@/.
-- This is the visual for the root window of the display.
-- The return value should not be freed.
-- 
-- /Since: 2.2/
screenGetSystemVisual ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'.
    -> m Gdk.Visual.Visual
    -- ^ __Returns:__ the system visual
screenGetSystemVisual :: a -> m Visual
screenGetSystemVisual a
screen = IO Visual -> m Visual
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Visual -> m Visual) -> IO Visual -> m Visual
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr Visual
result <- Ptr Screen -> IO (Ptr Visual)
gdk_screen_get_system_visual Ptr Screen
screen'
    Text -> Ptr Visual -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenGetSystemVisual" Ptr Visual
result
    Visual
result' <- ((ManagedPtr Visual -> Visual) -> Ptr Visual -> IO Visual
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Visual -> Visual
Gdk.Visual.Visual) Ptr Visual
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Visual -> IO Visual
forall (m :: * -> *) a. Monad m => a -> m a
return Visual
result'

#if defined(ENABLE_OVERLOADING)
data ScreenGetSystemVisualMethodInfo
instance (signature ~ (m Gdk.Visual.Visual), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetSystemVisualMethodInfo a signature where
    overloadedMethod = screenGetSystemVisual

#endif

-- method Screen::get_toplevel_windows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #GdkScreen where the toplevels are located."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gdk" , name = "Window" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_toplevel_windows" gdk_screen_get_toplevel_windows :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr (GList (Ptr Gdk.Window.Window)))

-- | Obtains a list of all toplevel windows known to GDK on the screen /@screen@/.
-- A toplevel window is a child of the root window (see
-- 'GI.Gdk.Functions.getDefaultRootWindow').
-- 
-- The returned list should be freed with @/g_list_free()/@, but
-- its elements need not be freed.
-- 
-- /Since: 2.2/
screenGetToplevelWindows ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: The t'GI.Gdk.Objects.Screen.Screen' where the toplevels are located.
    -> m [Gdk.Window.Window]
    -- ^ __Returns:__ 
    --     list of toplevel windows, free with @/g_list_free()/@
screenGetToplevelWindows :: a -> m [Window]
screenGetToplevelWindows a
screen = IO [Window] -> m [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Window] -> m [Window]) -> IO [Window] -> m [Window]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Window))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Window)))
gdk_screen_get_toplevel_windows Ptr Screen
screen'
    [Ptr Window]
result' <- Ptr (GList (Ptr Window)) -> IO [Ptr Window]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Window))
result
    [Window]
result'' <- (Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Gdk.Window.Window) [Ptr Window]
result'
    Ptr (GList (Ptr Window)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Window))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Window] -> IO [Window]
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenGetToplevelWindowsMethodInfo
instance (signature ~ (m [Gdk.Window.Window]), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetToplevelWindowsMethodInfo a signature where
    overloadedMethod = screenGetToplevelWindows

#endif

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

foreign import ccall "gdk_screen_get_width" gdk_screen_get_width :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetWidth ["(Since version 3.22)","Use per-monitor information instead"] #-}
-- | Gets the width of /@screen@/ in pixels. The returned size is in
-- ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
-- 
-- /Since: 2.2/
screenGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ the width of /@screen@/ in pixels.
screenGetWidth :: a -> m Int32
screenGetWidth a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_width Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetWidthMethodInfo a signature where
    overloadedMethod = screenGetWidth

#endif

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

foreign import ccall "gdk_screen_get_width_mm" gdk_screen_get_width_mm :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO Int32

{-# DEPRECATED screenGetWidthMm ["(Since version 3.22)","Use per-monitor information instead"] #-}
-- | Gets the width of /@screen@/ in millimeters.
-- 
-- Note that this value is somewhat ill-defined when the screen
-- has multiple monitors of different resolution. It is recommended
-- to use the monitor dimensions instead.
-- 
-- /Since: 2.2/
screenGetWidthMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Int32
    -- ^ __Returns:__ the width of /@screen@/ in millimeters.
screenGetWidthMm :: a -> m Int32
screenGetWidthMm a
screen = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Int32
result <- Ptr Screen -> IO Int32
gdk_screen_get_width_mm Ptr Screen
screen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ScreenGetWidthMmMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetWidthMmMethodInfo a signature where
    overloadedMethod = screenGetWidthMm

#endif

-- method Screen::get_window_stack
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gdk" , name = "Window" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_window_stack" gdk_screen_get_window_stack :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr (GList (Ptr Gdk.Window.Window)))

-- | Returns a t'GI.GLib.Structs.List.List' of @/GdkWindows/@ representing the current
-- window stack.
-- 
-- On X11, this is done by inspecting the _NET_CLIENT_LIST_STACKING
-- property on the root window, as described in the
-- <http://www.freedesktop.org/Standards/wm-spec Extended Window Manager Hints>.
-- If the window manager does not support the
-- _NET_CLIENT_LIST_STACKING hint, this function returns 'P.Nothing'.
-- 
-- On other platforms, this function may return 'P.Nothing', depending on whether
-- it is implementable on that platform.
-- 
-- The returned list is newly allocated and owns references to the
-- windows it contains, so it should be freed using @/g_list_free()/@ and
-- its windows unrefed using 'GI.GObject.Objects.Object.objectUnref' when no longer needed.
-- 
-- /Since: 2.10/
screenGetWindowStack ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m [Gdk.Window.Window]
    -- ^ __Returns:__ a
    --     list of @/GdkWindows/@ for the current window stack, or 'P.Nothing'.
screenGetWindowStack :: a -> m [Window]
screenGetWindowStack a
screen = IO [Window] -> m [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Window] -> m [Window]) -> IO [Window] -> m [Window]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Window))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Window)))
gdk_screen_get_window_stack Ptr Screen
screen'
    [Ptr Window]
result' <- Ptr (GList (Ptr Window)) -> IO [Ptr Window]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Window))
result
    [Window]
result'' <- (Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Window -> Window
Gdk.Window.Window) [Ptr Window]
result'
    Ptr (GList (Ptr Window)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Window))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Window] -> IO [Window]
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenGetWindowStackMethodInfo
instance (signature ~ (m [Gdk.Window.Window]), MonadIO m, IsScreen a) => O.MethodInfo ScreenGetWindowStackMethodInfo a signature where
    overloadedMethod = screenGetWindowStack

#endif

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

foreign import ccall "gdk_screen_is_composited" gdk_screen_is_composited :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO CInt

-- | Returns whether windows with an RGBA visual can reasonably
-- be expected to have their alpha channel drawn correctly on
-- the screen.
-- 
-- On X11 this function returns whether a compositing manager is
-- compositing /@screen@/.
-- 
-- /Since: 2.10/
screenIsComposited ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m Bool
    -- ^ __Returns:__ Whether windows with RGBA visuals can reasonably be
    -- expected to have their alpha channels drawn correctly on the screen.
screenIsComposited :: a -> m Bool
screenIsComposited a
screen = IO Bool -> m Bool
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
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CInt
result <- Ptr Screen -> IO CInt
gdk_screen_is_composited Ptr Screen
screen'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScreenIsCompositedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsScreen a) => O.MethodInfo ScreenIsCompositedMethodInfo a signature where
    overloadedMethod = screenIsComposited

#endif

-- method Screen::list_visuals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the relevant #GdkScreen."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gdk" , name = "Visual" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_list_visuals" gdk_screen_list_visuals :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO (Ptr (GList (Ptr Gdk.Visual.Visual)))

-- | Lists the available visuals for the specified /@screen@/.
-- A visual describes a hardware image data format.
-- For example, a visual might support 24-bit color, or 8-bit color,
-- and might expect pixels to be in a certain format.
-- 
-- Call @/g_list_free()/@ on the return value when you’re finished with it.
-- 
-- /Since: 2.2/
screenListVisuals ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: the relevant t'GI.Gdk.Objects.Screen.Screen'.
    -> m [Gdk.Visual.Visual]
    -- ^ __Returns:__ 
    --     a list of visuals; the list must be freed, but not its contents
screenListVisuals :: a -> m [Visual]
screenListVisuals a
screen = IO [Visual] -> m [Visual]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Visual] -> m [Visual]) -> IO [Visual] -> m [Visual]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr (GList (Ptr Visual))
result <- Ptr Screen -> IO (Ptr (GList (Ptr Visual)))
gdk_screen_list_visuals Ptr Screen
screen'
    [Ptr Visual]
result' <- Ptr (GList (Ptr Visual)) -> IO [Ptr Visual]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Visual))
result
    [Visual]
result'' <- (Ptr Visual -> IO Visual) -> [Ptr Visual] -> IO [Visual]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Visual -> Visual) -> Ptr Visual -> IO Visual
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Visual -> Visual
Gdk.Visual.Visual) [Ptr Visual]
result'
    Ptr (GList (Ptr Visual)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Visual))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    [Visual] -> IO [Visual]
forall (m :: * -> *) a. Monad m => a -> m a
return [Visual]
result''

#if defined(ENABLE_OVERLOADING)
data ScreenListVisualsMethodInfo
instance (signature ~ (m [Gdk.Visual.Visual]), MonadIO m, IsScreen a) => O.MethodInfo ScreenListVisualsMethodInfo a signature where
    overloadedMethod = screenListVisuals

#endif

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

foreign import ccall "gdk_screen_make_display_name" gdk_screen_make_display_name :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    IO CString

{-# DEPRECATED screenMakeDisplayName ["(Since version 3.22)"] #-}
-- | Determines the name to pass to 'GI.Gdk.Objects.Display.displayOpen' to get
-- a t'GI.Gdk.Objects.Display.Display' with this screen as the default screen.
-- 
-- /Since: 2.2/
screenMakeDisplayName ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> m T.Text
    -- ^ __Returns:__ a newly allocated string, free with 'GI.GLib.Functions.free'
screenMakeDisplayName :: a -> m Text
screenMakeDisplayName a
screen = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    CString
result <- Ptr Screen -> IO CString
gdk_screen_make_display_name Ptr Screen
screen'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"screenMakeDisplayName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ScreenMakeDisplayNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsScreen a) => O.MethodInfo ScreenMakeDisplayNameMethodInfo a signature where
    overloadedMethod = screenMakeDisplayName

#endif

-- method Screen::set_font_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "FontOptions" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #cairo_font_options_t, or %NULL to unset any\n  previously set default font options."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_set_font_options" gdk_screen_set_font_options :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    Ptr Cairo.FontOptions.FontOptions ->    -- options : TInterface (Name {namespace = "cairo", name = "FontOptions"})
    IO ()

-- | Sets the default font options for the screen. These
-- options will be set on any t'GI.Pango.Objects.Context.Context'’s newly created
-- with 'GI.Gdk.Functions.pangoContextGetForScreen'. Changing the
-- default set of font options does not affect contexts that
-- have already been created.
-- 
-- /Since: 2.10/
screenSetFontOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Maybe (Cairo.FontOptions.FontOptions)
    -- ^ /@options@/: a t'GI.Cairo.Structs.FontOptions.FontOptions', or 'P.Nothing' to unset any
    --   previously set default font options.
    -> m ()
screenSetFontOptions :: a -> Maybe FontOptions -> m ()
screenSetFontOptions a
screen Maybe FontOptions
options = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    Ptr FontOptions
maybeOptions <- case Maybe FontOptions
options of
        Maybe FontOptions
Nothing -> Ptr FontOptions -> IO (Ptr FontOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontOptions
forall a. Ptr a
nullPtr
        Just FontOptions
jOptions -> do
            Ptr FontOptions
jOptions' <- FontOptions -> IO (Ptr FontOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontOptions
jOptions
            Ptr FontOptions -> IO (Ptr FontOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FontOptions
jOptions'
    Ptr Screen -> Ptr FontOptions -> IO ()
gdk_screen_set_font_options Ptr Screen
screen' Ptr FontOptions
maybeOptions
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    Maybe FontOptions -> (FontOptions -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FontOptions
options FontOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenSetFontOptionsMethodInfo
instance (signature ~ (Maybe (Cairo.FontOptions.FontOptions) -> m ()), MonadIO m, IsScreen a) => O.MethodInfo ScreenSetFontOptionsMethodInfo a signature where
    overloadedMethod = screenSetFontOptions

#endif

-- method Screen::set_resolution
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "screen"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Screen" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkScreen" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dpi"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the resolution in \8220dots per inch\8221. (Physical inches aren\8217t actually\n  involved; the terminology is conventional.)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_set_resolution" gdk_screen_set_resolution :: 
    Ptr Screen ->                           -- screen : TInterface (Name {namespace = "Gdk", name = "Screen"})
    CDouble ->                              -- dpi : TBasicType TDouble
    IO ()

-- | Sets the resolution for font handling on the screen. This is a
-- scale factor between points specified in a t'GI.Pango.Structs.FontDescription.FontDescription'
-- and cairo units. The default value is 96, meaning that a 10 point
-- font will be 13 units high. (10 * 96. \/ 72. = 13.3).
-- 
-- /Since: 2.10/
screenSetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsScreen a) =>
    a
    -- ^ /@screen@/: a t'GI.Gdk.Objects.Screen.Screen'
    -> Double
    -- ^ /@dpi@/: the resolution in “dots per inch”. (Physical inches aren’t actually
    --   involved; the terminology is conventional.)
    -> m ()
screenSetResolution :: a -> Double -> m ()
screenSetResolution a
screen Double
dpi = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
screen' <- a -> IO (Ptr Screen)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
screen
    let dpi' :: CDouble
dpi' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dpi
    Ptr Screen -> CDouble -> IO ()
gdk_screen_set_resolution Ptr Screen
screen' CDouble
dpi'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
screen
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScreenSetResolutionMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsScreen a) => O.MethodInfo ScreenSetResolutionMethodInfo a signature where
    overloadedMethod = screenSetResolution

#endif

-- method Screen::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Screen" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_default" gdk_screen_get_default :: 
    IO (Ptr Screen)

-- | Gets the default screen for the default display. (See
-- gdk_display_get_default ()).
-- 
-- /Since: 2.2/
screenGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe Screen)
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Screen.Screen', or 'P.Nothing' if
    --     there is no default display.
screenGetDefault :: m (Maybe Screen)
screenGetDefault  = IO (Maybe Screen) -> m (Maybe Screen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Screen) -> m (Maybe Screen))
-> IO (Maybe Screen) -> m (Maybe Screen)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Screen
result <- IO (Ptr Screen)
gdk_screen_get_default
    Maybe Screen
maybeResult <- Ptr Screen -> (Ptr Screen -> IO Screen) -> IO (Maybe Screen)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Screen
result ((Ptr Screen -> IO Screen) -> IO (Maybe Screen))
-> (Ptr Screen -> IO Screen) -> IO (Maybe Screen)
forall a b. (a -> b) -> a -> b
$ \Ptr Screen
result' -> do
        Screen
result'' <- ((ManagedPtr Screen -> Screen) -> Ptr Screen -> IO Screen
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Screen -> Screen
Screen) Ptr Screen
result'
        Screen -> IO Screen
forall (m :: * -> *) a. Monad m => a -> m a
return Screen
result''
    Maybe Screen -> IO (Maybe Screen)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Screen
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::height
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_height" gdk_screen_height :: 
    IO Int32

{-# DEPRECATED screenHeight ["(Since version 3.22)","Use per-monitor information"] #-}
-- | Gets the height of the default screen in pixels. The returned
-- size is in ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
screenHeight ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ the height of the default screen in pixels.
screenHeight :: m Int32
screenHeight  = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
gdk_screen_height
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::height_mm
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_height_mm" gdk_screen_height_mm :: 
    IO Int32

{-# DEPRECATED screenHeightMm ["(Since version 3.22)","Use per-monitor information"] #-}
-- | Returns the height of the default screen in millimeters.
-- Note that on many X servers this value will not be correct.
screenHeightMm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ the height of the default screen in millimeters,
    -- though it is not always correct.
screenHeightMm :: m Int32
screenHeightMm  = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
gdk_screen_height_mm
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::width
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_width" gdk_screen_width :: 
    IO Int32

{-# DEPRECATED screenWidth ["(Since version 3.22)","Use per-monitor information"] #-}
-- | Gets the width of the default screen in pixels. The returned
-- size is in ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Screen.screenGetMonitorScaleFactor').
screenWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ the width of the default screen in pixels.
screenWidth :: m Int32
screenWidth  = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
gdk_screen_width
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Screen::width_mm
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_width_mm" gdk_screen_width_mm :: 
    IO Int32

{-# DEPRECATED screenWidthMm ["(Since version 3.22)","Use per-monitor information"] #-}
-- | Returns the width of the default screen in millimeters.
-- Note that on many X servers this value will not be correct.
screenWidthMm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ the width of the default screen in millimeters,
    -- though it is not always correct.
screenWidthMm :: m Int32
screenWidthMm  = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
gdk_screen_width_mm
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif