{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gdk.Objects.Screen
    ( 

-- * Exported types
    Screen(..)                              ,
    ScreenK                                 ,
    toScreen                                ,
    noScreen                                ,


 -- * Methods
-- ** screenGetActiveWindow
    screenGetActiveWindow                   ,


-- ** screenGetDefault
    screenGetDefault                        ,


-- ** screenGetDisplay
    screenGetDisplay                        ,


-- ** screenGetFontOptions
    screenGetFontOptions                    ,


-- ** screenGetHeight
    screenGetHeight                         ,


-- ** screenGetHeightMm
    screenGetHeightMm                       ,


-- ** screenGetMonitorAtPoint
    screenGetMonitorAtPoint                 ,


-- ** screenGetMonitorAtWindow
    screenGetMonitorAtWindow                ,


-- ** screenGetMonitorGeometry
    screenGetMonitorGeometry                ,


-- ** screenGetMonitorHeightMm
    screenGetMonitorHeightMm                ,


-- ** screenGetMonitorPlugName
    screenGetMonitorPlugName                ,


-- ** screenGetMonitorScaleFactor
    screenGetMonitorScaleFactor             ,


-- ** screenGetMonitorWidthMm
    screenGetMonitorWidthMm                 ,


-- ** screenGetMonitorWorkarea
    screenGetMonitorWorkarea                ,


-- ** screenGetNMonitors
    screenGetNMonitors                      ,


-- ** screenGetNumber
    screenGetNumber                         ,


-- ** screenGetPrimaryMonitor
    screenGetPrimaryMonitor                 ,


-- ** screenGetResolution
    screenGetResolution                     ,


-- ** screenGetRgbaVisual
    screenGetRgbaVisual                     ,


-- ** screenGetRootWindow
    screenGetRootWindow                     ,


-- ** screenGetSetting
    screenGetSetting                        ,


-- ** screenGetSystemVisual
    screenGetSystemVisual                   ,


-- ** screenGetToplevelWindows
    screenGetToplevelWindows                ,


-- ** screenGetWidth
    screenGetWidth                          ,


-- ** screenGetWidthMm
    screenGetWidthMm                        ,


-- ** screenGetWindowStack
    screenGetWindowStack                    ,


-- ** screenHeight
    screenHeight                            ,


-- ** screenHeightMm
    screenHeightMm                          ,


-- ** screenIsComposited
    screenIsComposited                      ,


-- ** screenListVisuals
    screenListVisuals                       ,


-- ** screenMakeDisplayName
    screenMakeDisplayName                   ,


-- ** screenSetFontOptions
    screenSetFontOptions                    ,


-- ** screenSetResolution
    screenSetResolution                     ,


-- ** screenWidth
    screenWidth                             ,


-- ** screenWidthMm
    screenWidthMm                           ,




 -- * Properties
-- ** FontOptions
    ScreenFontOptionsPropertyInfo           ,
    constructScreenFontOptions              ,
    getScreenFontOptions                    ,
    setScreenFontOptions                    ,


-- ** Resolution
    ScreenResolutionPropertyInfo            ,
    constructScreenResolution               ,
    getScreenResolution                     ,
    setScreenResolution                     ,




 -- * Signals
-- ** CompositedChanged
    ScreenCompositedChangedCallback         ,
    ScreenCompositedChangedCallbackC        ,
    ScreenCompositedChangedSignalInfo       ,
    afterScreenCompositedChanged            ,
    mkScreenCompositedChangedCallback       ,
    noScreenCompositedChangedCallback       ,
    onScreenCompositedChanged               ,
    screenCompositedChangedCallbackWrapper  ,
    screenCompositedChangedClosure          ,


-- ** MonitorsChanged
    ScreenMonitorsChangedCallback           ,
    ScreenMonitorsChangedCallbackC          ,
    ScreenMonitorsChangedSignalInfo         ,
    afterScreenMonitorsChanged              ,
    mkScreenMonitorsChangedCallback         ,
    noScreenMonitorsChangedCallback         ,
    onScreenMonitorsChanged                 ,
    screenMonitorsChangedCallbackWrapper    ,
    screenMonitorsChangedClosure            ,


-- ** SizeChanged
    ScreenSizeChangedCallback               ,
    ScreenSizeChangedCallbackC              ,
    ScreenSizeChangedSignalInfo             ,
    afterScreenSizeChanged                  ,
    mkScreenSizeChangedCallback             ,
    noScreenSizeChangedCallback             ,
    onScreenSizeChanged                     ,
    screenSizeChangedCallbackWrapper        ,
    screenSizeChangedClosure                ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gdk.Types
import GI.Gdk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Cairo as Cairo

newtype Screen = Screen (ForeignPtr Screen)
foreign import ccall "gdk_screen_get_type"
    c_gdk_screen_get_type :: IO GType

type instance ParentTypes Screen = ScreenParentTypes
type ScreenParentTypes = '[GObject.Object]

instance GObject Screen where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gdk_screen_get_type
    

class GObject o => ScreenK o
instance (GObject o, IsDescendantOf Screen o) => ScreenK o

toScreen :: ScreenK o => o -> IO Screen
toScreen = unsafeCastTo Screen

noScreen :: Maybe Screen
noScreen = Nothing

-- signal Screen::composited-changed
type ScreenCompositedChangedCallback =
    IO ()

noScreenCompositedChangedCallback :: Maybe ScreenCompositedChangedCallback
noScreenCompositedChangedCallback = Nothing

type ScreenCompositedChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScreenCompositedChangedCallback :: ScreenCompositedChangedCallbackC -> IO (FunPtr ScreenCompositedChangedCallbackC)

screenCompositedChangedClosure :: ScreenCompositedChangedCallback -> IO Closure
screenCompositedChangedClosure cb = newCClosure =<< mkScreenCompositedChangedCallback wrapped
    where wrapped = screenCompositedChangedCallbackWrapper cb

screenCompositedChangedCallbackWrapper ::
    ScreenCompositedChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
screenCompositedChangedCallbackWrapper _cb _ _ = do
    _cb 

onScreenCompositedChanged :: (GObject a, MonadIO m) => a -> ScreenCompositedChangedCallback -> m SignalHandlerId
onScreenCompositedChanged obj cb = liftIO $ connectScreenCompositedChanged obj cb SignalConnectBefore
afterScreenCompositedChanged :: (GObject a, MonadIO m) => a -> ScreenCompositedChangedCallback -> m SignalHandlerId
afterScreenCompositedChanged obj cb = connectScreenCompositedChanged obj cb SignalConnectAfter

connectScreenCompositedChanged :: (GObject a, MonadIO m) =>
                                  a -> ScreenCompositedChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectScreenCompositedChanged obj cb after = liftIO $ do
    cb' <- mkScreenCompositedChangedCallback (screenCompositedChangedCallbackWrapper cb)
    connectSignalFunPtr obj "composited-changed" cb' after

-- signal Screen::monitors-changed
type ScreenMonitorsChangedCallback =
    IO ()

noScreenMonitorsChangedCallback :: Maybe ScreenMonitorsChangedCallback
noScreenMonitorsChangedCallback = Nothing

type ScreenMonitorsChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScreenMonitorsChangedCallback :: ScreenMonitorsChangedCallbackC -> IO (FunPtr ScreenMonitorsChangedCallbackC)

screenMonitorsChangedClosure :: ScreenMonitorsChangedCallback -> IO Closure
screenMonitorsChangedClosure cb = newCClosure =<< mkScreenMonitorsChangedCallback wrapped
    where wrapped = screenMonitorsChangedCallbackWrapper cb

screenMonitorsChangedCallbackWrapper ::
    ScreenMonitorsChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
screenMonitorsChangedCallbackWrapper _cb _ _ = do
    _cb 

onScreenMonitorsChanged :: (GObject a, MonadIO m) => a -> ScreenMonitorsChangedCallback -> m SignalHandlerId
onScreenMonitorsChanged obj cb = liftIO $ connectScreenMonitorsChanged obj cb SignalConnectBefore
afterScreenMonitorsChanged :: (GObject a, MonadIO m) => a -> ScreenMonitorsChangedCallback -> m SignalHandlerId
afterScreenMonitorsChanged obj cb = connectScreenMonitorsChanged obj cb SignalConnectAfter

connectScreenMonitorsChanged :: (GObject a, MonadIO m) =>
                                a -> ScreenMonitorsChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectScreenMonitorsChanged obj cb after = liftIO $ do
    cb' <- mkScreenMonitorsChangedCallback (screenMonitorsChangedCallbackWrapper cb)
    connectSignalFunPtr obj "monitors-changed" cb' after

-- signal Screen::size-changed
type ScreenSizeChangedCallback =
    IO ()

noScreenSizeChangedCallback :: Maybe ScreenSizeChangedCallback
noScreenSizeChangedCallback = Nothing

type ScreenSizeChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScreenSizeChangedCallback :: ScreenSizeChangedCallbackC -> IO (FunPtr ScreenSizeChangedCallbackC)

screenSizeChangedClosure :: ScreenSizeChangedCallback -> IO Closure
screenSizeChangedClosure cb = newCClosure =<< mkScreenSizeChangedCallback wrapped
    where wrapped = screenSizeChangedCallbackWrapper cb

screenSizeChangedCallbackWrapper ::
    ScreenSizeChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
screenSizeChangedCallbackWrapper _cb _ _ = do
    _cb 

onScreenSizeChanged :: (GObject a, MonadIO m) => a -> ScreenSizeChangedCallback -> m SignalHandlerId
onScreenSizeChanged obj cb = liftIO $ connectScreenSizeChanged obj cb SignalConnectBefore
afterScreenSizeChanged :: (GObject a, MonadIO m) => a -> ScreenSizeChangedCallback -> m SignalHandlerId
afterScreenSizeChanged obj cb = connectScreenSizeChanged obj cb SignalConnectAfter

connectScreenSizeChanged :: (GObject a, MonadIO m) =>
                            a -> ScreenSizeChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectScreenSizeChanged obj cb after = liftIO $ do
    cb' <- mkScreenSizeChangedCallback (screenSizeChangedCallbackWrapper cb)
    connectSignalFunPtr obj "size-changed" cb' after

-- VVV Prop "font-options"
   -- Type: TBasicType TVoid
   -- Flags: [PropertyReadable,PropertyWritable]

getScreenFontOptions :: (MonadIO m, ScreenK o) => o -> m (Ptr ())
getScreenFontOptions obj = liftIO $ getObjectPropertyPtr obj "font-options"

setScreenFontOptions :: (MonadIO m, ScreenK o) => o -> (Ptr ()) -> m ()
setScreenFontOptions obj val = liftIO $ setObjectPropertyPtr obj "font-options" val

constructScreenFontOptions :: (Ptr ()) -> IO ([Char], GValue)
constructScreenFontOptions val = constructObjectPropertyPtr "font-options" val

data ScreenFontOptionsPropertyInfo
instance AttrInfo ScreenFontOptionsPropertyInfo where
    type AttrAllowedOps ScreenFontOptionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScreenFontOptionsPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint ScreenFontOptionsPropertyInfo = ScreenK
    type AttrGetType ScreenFontOptionsPropertyInfo = (Ptr ())
    type AttrLabel ScreenFontOptionsPropertyInfo = "Screen::font-options"
    attrGet _ = getScreenFontOptions
    attrSet _ = setScreenFontOptions
    attrConstruct _ = constructScreenFontOptions

-- VVV Prop "resolution"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]

getScreenResolution :: (MonadIO m, ScreenK o) => o -> m Double
getScreenResolution obj = liftIO $ getObjectPropertyDouble obj "resolution"

setScreenResolution :: (MonadIO m, ScreenK o) => o -> Double -> m ()
setScreenResolution obj val = liftIO $ setObjectPropertyDouble obj "resolution" val

constructScreenResolution :: Double -> IO ([Char], GValue)
constructScreenResolution val = constructObjectPropertyDouble "resolution" val

data ScreenResolutionPropertyInfo
instance AttrInfo ScreenResolutionPropertyInfo where
    type AttrAllowedOps ScreenResolutionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScreenResolutionPropertyInfo = (~) Double
    type AttrBaseTypeConstraint ScreenResolutionPropertyInfo = ScreenK
    type AttrGetType ScreenResolutionPropertyInfo = Double
    type AttrLabel ScreenResolutionPropertyInfo = "Screen::resolution"
    attrGet _ = getScreenResolution
    attrSet _ = setScreenResolution
    attrConstruct _ = constructScreenResolution

type instance AttributeList Screen = ScreenAttributeList
type ScreenAttributeList = ('[ '("font-options", ScreenFontOptionsPropertyInfo), '("resolution", ScreenResolutionPropertyInfo)] :: [(Symbol, *)])

data ScreenCompositedChangedSignalInfo
instance SignalInfo ScreenCompositedChangedSignalInfo where
    type HaskellCallbackType ScreenCompositedChangedSignalInfo = ScreenCompositedChangedCallback
    connectSignal _ = connectScreenCompositedChanged

data ScreenMonitorsChangedSignalInfo
instance SignalInfo ScreenMonitorsChangedSignalInfo where
    type HaskellCallbackType ScreenMonitorsChangedSignalInfo = ScreenMonitorsChangedCallback
    connectSignal _ = connectScreenMonitorsChanged

data ScreenSizeChangedSignalInfo
instance SignalInfo ScreenSizeChangedSignalInfo where
    type HaskellCallbackType ScreenSizeChangedSignalInfo = ScreenSizeChangedCallback
    connectSignal _ = connectScreenSizeChanged

type instance SignalList Screen = ScreenSignalList
type ScreenSignalList = ('[ '("composited-changed", ScreenCompositedChangedSignalInfo), '("monitors-changed", ScreenMonitorsChangedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("size-changed", ScreenSizeChangedSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Screen::get_active_window
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_active_window" gdk_screen_get_active_window :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Window)


screenGetActiveWindow ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Window
screenGetActiveWindow _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_active_window _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_active_window" result
    result' <- (wrapObject Window) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_display
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Display"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_display" gdk_screen_get_display :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Display)


screenGetDisplay ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Display
screenGetDisplay _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_display _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_display" result
    result' <- (newObject Display) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_font_options
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "cairo" "FontOptions"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_font_options" gdk_screen_get_font_options :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Cairo.FontOptions)


screenGetFontOptions ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Cairo.FontOptions
screenGetFontOptions _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_font_options _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_font_options" result
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    result' <- (\x -> Cairo.FontOptions <$> newForeignPtr_ x) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_height
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_height" gdk_screen_get_height :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetHeight ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetHeight _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_height _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_height_mm
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_height_mm" gdk_screen_get_height_mm :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetHeightMm ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetHeightMm _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_height_mm _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_monitor_at_point
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_at_point" gdk_screen_get_monitor_at_point :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- x : TBasicType TInt32
    Int32 ->                                -- y : TBasicType TInt32
    IO Int32


screenGetMonitorAtPoint ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- x
    Int32 ->                                -- y
    m Int32
screenGetMonitorAtPoint _obj x y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_monitor_at_point _obj' x y
    touchManagedPtr _obj
    return result

-- method Screen::get_monitor_at_window
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "window", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "window", argType = TInterface "Gdk" "Window", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_at_window" gdk_screen_get_monitor_at_window :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Ptr Window ->                           -- window : TInterface "Gdk" "Window"
    IO Int32


screenGetMonitorAtWindow ::
    (MonadIO m, ScreenK a, WindowK b) =>
    a ->                                    -- _obj
    b ->                                    -- window
    m Int32
screenGetMonitorAtWindow _obj window = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let window' = unsafeManagedPtrCastPtr window
    result <- gdk_screen_get_monitor_at_window _obj' window'
    touchManagedPtr _obj
    touchManagedPtr window
    return result

-- method Screen::get_monitor_geometry
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TInterface "Gdk" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_geometry" gdk_screen_get_monitor_geometry :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    Ptr Rectangle ->                        -- dest : TInterface "Gdk" "Rectangle"
    IO ()


screenGetMonitorGeometry ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m (Rectangle)
screenGetMonitorGeometry _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    dest <- callocBoxedBytes 16 :: IO (Ptr Rectangle)
    gdk_screen_get_monitor_geometry _obj' monitor_num dest
    dest' <- (wrapBoxed Rectangle) dest
    touchManagedPtr _obj
    return dest'

-- method Screen::get_monitor_height_mm
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_height_mm" gdk_screen_get_monitor_height_mm :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    IO Int32


screenGetMonitorHeightMm ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m Int32
screenGetMonitorHeightMm _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_monitor_height_mm _obj' monitor_num
    touchManagedPtr _obj
    return result

-- method Screen::get_monitor_plug_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_plug_name" gdk_screen_get_monitor_plug_name :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    IO CString


screenGetMonitorPlugName ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m T.Text
screenGetMonitorPlugName _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_monitor_plug_name _obj' monitor_num
    checkUnexpectedReturnNULL "gdk_screen_get_monitor_plug_name" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method Screen::get_monitor_scale_factor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_scale_factor" gdk_screen_get_monitor_scale_factor :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    IO Int32


screenGetMonitorScaleFactor ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m Int32
screenGetMonitorScaleFactor _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_monitor_scale_factor _obj' monitor_num
    touchManagedPtr _obj
    return result

-- method Screen::get_monitor_width_mm
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_width_mm" gdk_screen_get_monitor_width_mm :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    IO Int32


screenGetMonitorWidthMm ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m Int32
screenGetMonitorWidthMm _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_monitor_width_mm _obj' monitor_num
    touchManagedPtr _obj
    return result

-- method Screen::get_monitor_workarea
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest", argType = TInterface "Gdk" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "monitor_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_monitor_workarea" gdk_screen_get_monitor_workarea :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Int32 ->                                -- monitor_num : TBasicType TInt32
    Ptr Rectangle ->                        -- dest : TInterface "Gdk" "Rectangle"
    IO ()


screenGetMonitorWorkarea ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- monitor_num
    m (Rectangle)
screenGetMonitorWorkarea _obj monitor_num = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    dest <- callocBoxedBytes 16 :: IO (Ptr Rectangle)
    gdk_screen_get_monitor_workarea _obj' monitor_num dest
    dest' <- (wrapBoxed Rectangle) dest
    touchManagedPtr _obj
    return dest'

-- method Screen::get_n_monitors
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_n_monitors" gdk_screen_get_n_monitors :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetNMonitors ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetNMonitors _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_n_monitors _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_number
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_number" gdk_screen_get_number :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetNumber ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetNumber _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_number _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_primary_monitor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_primary_monitor" gdk_screen_get_primary_monitor :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetPrimaryMonitor ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetPrimaryMonitor _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_primary_monitor _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_resolution
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TDouble
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_resolution" gdk_screen_get_resolution :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO CDouble


screenGetResolution ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Double
screenGetResolution _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_resolution _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method Screen::get_rgba_visual
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Visual"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_rgba_visual" gdk_screen_get_rgba_visual :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Visual)


screenGetRgbaVisual ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Visual
screenGetRgbaVisual _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_rgba_visual _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_rgba_visual" result
    result' <- (newObject Visual) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_root_window
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Window"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_root_window" gdk_screen_get_root_window :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Window)


screenGetRootWindow ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Window
screenGetRootWindow _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_root_window _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_root_window" result
    result' <- (newObject Window) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_setting
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_setting" gdk_screen_get_setting :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    CString ->                              -- name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TInterface "GObject" "Value"
    IO CInt


screenGetSetting ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- name
    GValue ->                               -- value
    m Bool
screenGetSetting _obj name value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    name' <- textToCString name
    let value' = unsafeManagedPtrGetPtr value
    result <- gdk_screen_get_setting _obj' name' value'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr value
    freeMem name'
    return result'

-- method Screen::get_system_visual
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gdk" "Visual"
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_system_visual" gdk_screen_get_system_visual :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr Visual)


screenGetSystemVisual ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Visual
screenGetSystemVisual _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_system_visual _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_system_visual" result
    result' <- (newObject Visual) result
    touchManagedPtr _obj
    return result'

-- method Screen::get_toplevel_windows
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Window")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_toplevel_windows" gdk_screen_get_toplevel_windows :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr (GList (Ptr Window)))


screenGetToplevelWindows ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m [Window]
screenGetToplevelWindows _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_toplevel_windows _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_toplevel_windows" result
    result' <- unpackGList result
    result'' <- mapM (newObject Window) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method Screen::get_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_width" gdk_screen_get_width :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetWidth ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_width _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_width_mm
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_width_mm" gdk_screen_get_width_mm :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO Int32


screenGetWidthMm ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Int32
screenGetWidthMm _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_width_mm _obj'
    touchManagedPtr _obj
    return result

-- method Screen::get_window_stack
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Window")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_get_window_stack" gdk_screen_get_window_stack :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr (GList (Ptr Window)))


screenGetWindowStack ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m [Window]
screenGetWindowStack _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_get_window_stack _obj'
    checkUnexpectedReturnNULL "gdk_screen_get_window_stack" result
    result' <- unpackGList result
    result'' <- mapM (wrapObject Window) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method Screen::is_composited
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_is_composited" gdk_screen_is_composited :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO CInt


screenIsComposited ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m Bool
screenIsComposited _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_is_composited _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Screen::list_visuals
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gdk" "Visual")
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_list_visuals" gdk_screen_list_visuals :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO (Ptr (GList (Ptr Visual)))


screenListVisuals ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m [Visual]
screenListVisuals _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_list_visuals _obj'
    checkUnexpectedReturnNULL "gdk_screen_list_visuals" result
    result' <- unpackGList result
    result'' <- mapM (newObject Visual) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method Screen::make_display_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_make_display_name" gdk_screen_make_display_name :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    IO CString


screenMakeDisplayName ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    m T.Text
screenMakeDisplayName _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gdk_screen_make_display_name _obj'
    checkUnexpectedReturnNULL "gdk_screen_make_display_name" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method Screen::set_font_options
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "options", argType = TInterface "cairo" "FontOptions", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "options", argType = TInterface "cairo" "FontOptions", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_set_font_options" gdk_screen_set_font_options :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    Ptr Cairo.FontOptions ->                -- options : TInterface "cairo" "FontOptions"
    IO ()


screenSetFontOptions ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Maybe (Cairo.FontOptions) ->            -- options
    m ()
screenSetFontOptions _obj options = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeOptions <- case options of
        Nothing -> return nullPtr
        Just jOptions -> do
            let jOptions' = unsafeManagedPtrGetPtr jOptions
            return jOptions'
    gdk_screen_set_font_options _obj' maybeOptions
    touchManagedPtr _obj
    whenJust options touchManagedPtr
    return ()

-- method Screen::set_resolution
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dpi", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gdk" "Screen", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dpi", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_set_resolution" gdk_screen_set_resolution :: 
    Ptr Screen ->                           -- _obj : TInterface "Gdk" "Screen"
    CDouble ->                              -- dpi : TBasicType TDouble
    IO ()


screenSetResolution ::
    (MonadIO m, ScreenK a) =>
    a ->                                    -- _obj
    Double ->                               -- dpi
    m ()
screenSetResolution _obj dpi = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let dpi' = realToFrac dpi
    gdk_screen_set_resolution _obj' dpi'
    touchManagedPtr _obj
    return ()

-- method Screen::get_default
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gdk" "Screen"
-- throws : False
-- Skip return : False

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


screenGetDefault ::
    (MonadIO m) =>
    m Screen
screenGetDefault  = liftIO $ do
    result <- gdk_screen_get_default
    checkUnexpectedReturnNULL "gdk_screen_get_default" result
    result' <- (newObject Screen) result
    return result'

-- method Screen::height
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_height" gdk_screen_height :: 
    IO Int32


screenHeight ::
    (MonadIO m) =>
    m Int32
screenHeight  = liftIO $ do
    result <- gdk_screen_height
    return result

-- method Screen::height_mm
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_height_mm" gdk_screen_height_mm :: 
    IO Int32


screenHeightMm ::
    (MonadIO m) =>
    m Int32
screenHeightMm  = liftIO $ do
    result <- gdk_screen_height_mm
    return result

-- method Screen::width
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_width" gdk_screen_width :: 
    IO Int32


screenWidth ::
    (MonadIO m) =>
    m Int32
screenWidth  = liftIO $ do
    result <- gdk_screen_width
    return result

-- method Screen::width_mm
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gdk_screen_width_mm" gdk_screen_width_mm :: 
    IO Int32


screenWidthMm ::
    (MonadIO m) =>
    m Int32
screenWidthMm  = liftIO $ do
    result <- gdk_screen_width_mm
    return result