{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GdkMonitor objects represent the individual outputs that are
-- associated with a t'GI.Gdk.Objects.Display.Display'. GdkDisplay has APIs to enumerate
-- monitors with 'GI.Gdk.Objects.Display.displayGetNMonitors' and 'GI.Gdk.Objects.Display.displayGetMonitor', and
-- to find particular monitors with 'GI.Gdk.Objects.Display.displayGetPrimaryMonitor' or
-- 'GI.Gdk.Objects.Display.displayGetMonitorAtWindow'.
-- 
-- GdkMonitor was introduced in GTK+ 3.22 and supersedes earlier
-- APIs in GdkScreen to obtain monitor-related information.

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

module GI.Gdk.Objects.Monitor
    ( 

-- * Exported types
    Monitor(..)                             ,
    IsMonitor                               ,
    toMonitor                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMonitorMethod                    ,
#endif


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    MonitorGetDisplayMethodInfo             ,
#endif
    monitorGetDisplay                       ,


-- ** getGeometry #method:getGeometry#

#if defined(ENABLE_OVERLOADING)
    MonitorGetGeometryMethodInfo            ,
#endif
    monitorGetGeometry                      ,


-- ** getHeightMm #method:getHeightMm#

#if defined(ENABLE_OVERLOADING)
    MonitorGetHeightMmMethodInfo            ,
#endif
    monitorGetHeightMm                      ,


-- ** getManufacturer #method:getManufacturer#

#if defined(ENABLE_OVERLOADING)
    MonitorGetManufacturerMethodInfo        ,
#endif
    monitorGetManufacturer                  ,


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    MonitorGetModelMethodInfo               ,
#endif
    monitorGetModel                         ,


-- ** getRefreshRate #method:getRefreshRate#

#if defined(ENABLE_OVERLOADING)
    MonitorGetRefreshRateMethodInfo         ,
#endif
    monitorGetRefreshRate                   ,


-- ** getScaleFactor #method:getScaleFactor#

#if defined(ENABLE_OVERLOADING)
    MonitorGetScaleFactorMethodInfo         ,
#endif
    monitorGetScaleFactor                   ,


-- ** getSubpixelLayout #method:getSubpixelLayout#

#if defined(ENABLE_OVERLOADING)
    MonitorGetSubpixelLayoutMethodInfo      ,
#endif
    monitorGetSubpixelLayout                ,


-- ** getWidthMm #method:getWidthMm#

#if defined(ENABLE_OVERLOADING)
    MonitorGetWidthMmMethodInfo             ,
#endif
    monitorGetWidthMm                       ,


-- ** getWorkarea #method:getWorkarea#

#if defined(ENABLE_OVERLOADING)
    MonitorGetWorkareaMethodInfo            ,
#endif
    monitorGetWorkarea                      ,


-- ** isPrimary #method:isPrimary#

#if defined(ENABLE_OVERLOADING)
    MonitorIsPrimaryMethodInfo              ,
#endif
    monitorIsPrimary                        ,




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

#if defined(ENABLE_OVERLOADING)
    MonitorDisplayPropertyInfo              ,
#endif
    constructMonitorDisplay                 ,
    getMonitorDisplay                       ,
#if defined(ENABLE_OVERLOADING)
    monitorDisplay                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorGeometryPropertyInfo             ,
#endif
    getMonitorGeometry                      ,
#if defined(ENABLE_OVERLOADING)
    monitorGeometry                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorHeightMmPropertyInfo             ,
#endif
    getMonitorHeightMm                      ,
#if defined(ENABLE_OVERLOADING)
    monitorHeightMm                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorManufacturerPropertyInfo         ,
#endif
    getMonitorManufacturer                  ,
#if defined(ENABLE_OVERLOADING)
    monitorManufacturer                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorModelPropertyInfo                ,
#endif
    getMonitorModel                         ,
#if defined(ENABLE_OVERLOADING)
    monitorModel                            ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorRefreshRatePropertyInfo          ,
#endif
    getMonitorRefreshRate                   ,
#if defined(ENABLE_OVERLOADING)
    monitorRefreshRate                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorScaleFactorPropertyInfo          ,
#endif
    getMonitorScaleFactor                   ,
#if defined(ENABLE_OVERLOADING)
    monitorScaleFactor                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorSubpixelLayoutPropertyInfo       ,
#endif
    getMonitorSubpixelLayout                ,
#if defined(ENABLE_OVERLOADING)
    monitorSubpixelLayout                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorWidthMmPropertyInfo              ,
#endif
    getMonitorWidthMm                       ,
#if defined(ENABLE_OVERLOADING)
    monitorWidthMm                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    MonitorWorkareaPropertyInfo             ,
#endif
    getMonitorWorkarea                      ,
#if defined(ENABLE_OVERLOADING)
    monitorWorkarea                         ,
#endif




 -- * Signals
-- ** invalidate #signal:invalidate#

    C_MonitorInvalidateCallback             ,
    MonitorInvalidateCallback               ,
#if defined(ENABLE_OVERLOADING)
    MonitorInvalidateSignalInfo             ,
#endif
    afterMonitorInvalidate                  ,
    genClosure_MonitorInvalidate            ,
    mk_MonitorInvalidateCallback            ,
    noMonitorInvalidateCallback             ,
    onMonitorInvalidate                     ,
    wrap_MonitorInvalidateCallback          ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle

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

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

foreign import ccall "gdk_monitor_get_type"
    c_gdk_monitor_get_type :: IO B.Types.GType

instance B.Types.TypedObject Monitor where
    glibType :: IO GType
glibType = IO GType
c_gdk_monitor_get_type

instance B.Types.GObject Monitor

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMonitorMethod (t :: Symbol) (o :: *) :: * where
    ResolveMonitorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMonitorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMonitorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMonitorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMonitorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMonitorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMonitorMethod "isPrimary" o = MonitorIsPrimaryMethodInfo
    ResolveMonitorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMonitorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMonitorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMonitorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMonitorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMonitorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMonitorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMonitorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMonitorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMonitorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMonitorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMonitorMethod "getDisplay" o = MonitorGetDisplayMethodInfo
    ResolveMonitorMethod "getGeometry" o = MonitorGetGeometryMethodInfo
    ResolveMonitorMethod "getHeightMm" o = MonitorGetHeightMmMethodInfo
    ResolveMonitorMethod "getManufacturer" o = MonitorGetManufacturerMethodInfo
    ResolveMonitorMethod "getModel" o = MonitorGetModelMethodInfo
    ResolveMonitorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMonitorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMonitorMethod "getRefreshRate" o = MonitorGetRefreshRateMethodInfo
    ResolveMonitorMethod "getScaleFactor" o = MonitorGetScaleFactorMethodInfo
    ResolveMonitorMethod "getSubpixelLayout" o = MonitorGetSubpixelLayoutMethodInfo
    ResolveMonitorMethod "getWidthMm" o = MonitorGetWidthMmMethodInfo
    ResolveMonitorMethod "getWorkarea" o = MonitorGetWorkareaMethodInfo
    ResolveMonitorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMonitorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMonitorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMonitorMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Monitor::invalidate
-- | /No description available in the introspection data./
type MonitorInvalidateCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_MonitorInvalidate :: MonadIO m => MonitorInvalidateCallback -> m (GClosure C_MonitorInvalidateCallback)
genClosure_MonitorInvalidate :: IO () -> m (GClosure C_MonitorInvalidateCallback)
genClosure_MonitorInvalidate IO ()
cb = IO (GClosure C_MonitorInvalidateCallback)
-> m (GClosure C_MonitorInvalidateCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MonitorInvalidateCallback)
 -> m (GClosure C_MonitorInvalidateCallback))
-> IO (GClosure C_MonitorInvalidateCallback)
-> m (GClosure C_MonitorInvalidateCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_MonitorInvalidateCallback
cb' = IO () -> C_MonitorInvalidateCallback
wrap_MonitorInvalidateCallback IO ()
cb
    C_MonitorInvalidateCallback
-> IO (FunPtr C_MonitorInvalidateCallback)
mk_MonitorInvalidateCallback C_MonitorInvalidateCallback
cb' IO (FunPtr C_MonitorInvalidateCallback)
-> (FunPtr C_MonitorInvalidateCallback
    -> IO (GClosure C_MonitorInvalidateCallback))
-> IO (GClosure C_MonitorInvalidateCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MonitorInvalidateCallback
-> IO (GClosure C_MonitorInvalidateCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MonitorInvalidateCallback` into a `C_MonitorInvalidateCallback`.
wrap_MonitorInvalidateCallback ::
    MonitorInvalidateCallback ->
    C_MonitorInvalidateCallback
wrap_MonitorInvalidateCallback :: IO () -> C_MonitorInvalidateCallback
wrap_MonitorInvalidateCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [invalidate](#signal:invalidate) 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' monitor #invalidate callback
-- @
-- 
-- 
onMonitorInvalidate :: (IsMonitor a, MonadIO m) => a -> MonitorInvalidateCallback -> m SignalHandlerId
onMonitorInvalidate :: a -> IO () -> m SignalHandlerId
onMonitorInvalidate 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_MonitorInvalidateCallback
cb' = IO () -> C_MonitorInvalidateCallback
wrap_MonitorInvalidateCallback IO ()
cb
    FunPtr C_MonitorInvalidateCallback
cb'' <- C_MonitorInvalidateCallback
-> IO (FunPtr C_MonitorInvalidateCallback)
mk_MonitorInvalidateCallback C_MonitorInvalidateCallback
cb'
    a
-> Text
-> FunPtr C_MonitorInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate" FunPtr C_MonitorInvalidateCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [invalidate](#signal:invalidate) 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' monitor #invalidate callback
-- @
-- 
-- 
afterMonitorInvalidate :: (IsMonitor a, MonadIO m) => a -> MonitorInvalidateCallback -> m SignalHandlerId
afterMonitorInvalidate :: a -> IO () -> m SignalHandlerId
afterMonitorInvalidate 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_MonitorInvalidateCallback
cb' = IO () -> C_MonitorInvalidateCallback
wrap_MonitorInvalidateCallback IO ()
cb
    FunPtr C_MonitorInvalidateCallback
cb'' <- C_MonitorInvalidateCallback
-> IO (FunPtr C_MonitorInvalidateCallback)
mk_MonitorInvalidateCallback C_MonitorInvalidateCallback
cb'
    a
-> Text
-> FunPtr C_MonitorInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate" FunPtr C_MonitorInvalidateCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MonitorInvalidateSignalInfo
instance SignalInfo MonitorInvalidateSignalInfo where
    type HaskellCallbackType MonitorInvalidateSignalInfo = MonitorInvalidateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MonitorInvalidateCallback cb
        cb'' <- mk_MonitorInvalidateCallback cb'
        connectSignalFunPtr obj "invalidate" cb'' connectMode detail

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorDisplayPropertyInfo
instance AttrInfo MonitorDisplayPropertyInfo where
    type AttrAllowedOps MonitorDisplayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MonitorDisplayPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint MonitorDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType MonitorDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType MonitorDisplayPropertyInfo = Gdk.Display.Display
    type AttrLabel MonitorDisplayPropertyInfo = "display"
    type AttrOrigin MonitorDisplayPropertyInfo = Monitor
    attrGet = getMonitorDisplay
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructMonitorDisplay
    attrClear = undefined
#endif

-- VVV Prop "geometry"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Rectangle"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data MonitorGeometryPropertyInfo
instance AttrInfo MonitorGeometryPropertyInfo where
    type AttrAllowedOps MonitorGeometryPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MonitorGeometryPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorGeometryPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorGeometryPropertyInfo = (~) ()
    type AttrTransferType MonitorGeometryPropertyInfo = ()
    type AttrGetType MonitorGeometryPropertyInfo = (Maybe Gdk.Rectangle.Rectangle)
    type AttrLabel MonitorGeometryPropertyInfo = "geometry"
    type AttrOrigin MonitorGeometryPropertyInfo = Monitor
    attrGet = getMonitorGeometry
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorHeightMmPropertyInfo
instance AttrInfo MonitorHeightMmPropertyInfo where
    type AttrAllowedOps MonitorHeightMmPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MonitorHeightMmPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorHeightMmPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorHeightMmPropertyInfo = (~) ()
    type AttrTransferType MonitorHeightMmPropertyInfo = ()
    type AttrGetType MonitorHeightMmPropertyInfo = Int32
    type AttrLabel MonitorHeightMmPropertyInfo = "height-mm"
    type AttrOrigin MonitorHeightMmPropertyInfo = Monitor
    attrGet = getMonitorHeightMm
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorManufacturerPropertyInfo
instance AttrInfo MonitorManufacturerPropertyInfo where
    type AttrAllowedOps MonitorManufacturerPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MonitorManufacturerPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorManufacturerPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorManufacturerPropertyInfo = (~) ()
    type AttrTransferType MonitorManufacturerPropertyInfo = ()
    type AttrGetType MonitorManufacturerPropertyInfo = (Maybe T.Text)
    type AttrLabel MonitorManufacturerPropertyInfo = "manufacturer"
    type AttrOrigin MonitorManufacturerPropertyInfo = Monitor
    attrGet = getMonitorManufacturer
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorModelPropertyInfo
instance AttrInfo MonitorModelPropertyInfo where
    type AttrAllowedOps MonitorModelPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MonitorModelPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorModelPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorModelPropertyInfo = (~) ()
    type AttrTransferType MonitorModelPropertyInfo = ()
    type AttrGetType MonitorModelPropertyInfo = (Maybe T.Text)
    type AttrLabel MonitorModelPropertyInfo = "model"
    type AttrOrigin MonitorModelPropertyInfo = Monitor
    attrGet = getMonitorModel
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorRefreshRatePropertyInfo
instance AttrInfo MonitorRefreshRatePropertyInfo where
    type AttrAllowedOps MonitorRefreshRatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MonitorRefreshRatePropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorRefreshRatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorRefreshRatePropertyInfo = (~) ()
    type AttrTransferType MonitorRefreshRatePropertyInfo = ()
    type AttrGetType MonitorRefreshRatePropertyInfo = Int32
    type AttrLabel MonitorRefreshRatePropertyInfo = "refresh-rate"
    type AttrOrigin MonitorRefreshRatePropertyInfo = Monitor
    attrGet = getMonitorRefreshRate
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorScaleFactorPropertyInfo
instance AttrInfo MonitorScaleFactorPropertyInfo where
    type AttrAllowedOps MonitorScaleFactorPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MonitorScaleFactorPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorScaleFactorPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorScaleFactorPropertyInfo = (~) ()
    type AttrTransferType MonitorScaleFactorPropertyInfo = ()
    type AttrGetType MonitorScaleFactorPropertyInfo = Int32
    type AttrLabel MonitorScaleFactorPropertyInfo = "scale-factor"
    type AttrOrigin MonitorScaleFactorPropertyInfo = Monitor
    attrGet = getMonitorScaleFactor
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "subpixel-layout"
   -- Type: TInterface (Name {namespace = "Gdk", name = "SubpixelLayout"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@subpixel-layout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' monitor #subpixelLayout
-- @
getMonitorSubpixelLayout :: (MonadIO m, IsMonitor o) => o -> m Gdk.Enums.SubpixelLayout
getMonitorSubpixelLayout :: o -> m SubpixelLayout
getMonitorSubpixelLayout o
obj = IO SubpixelLayout -> m SubpixelLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubpixelLayout -> m SubpixelLayout)
-> IO SubpixelLayout -> m SubpixelLayout
forall a b. (a -> b) -> a -> b
$ o -> String -> IO SubpixelLayout
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"subpixel-layout"

#if defined(ENABLE_OVERLOADING)
data MonitorSubpixelLayoutPropertyInfo
instance AttrInfo MonitorSubpixelLayoutPropertyInfo where
    type AttrAllowedOps MonitorSubpixelLayoutPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MonitorSubpixelLayoutPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorSubpixelLayoutPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorSubpixelLayoutPropertyInfo = (~) ()
    type AttrTransferType MonitorSubpixelLayoutPropertyInfo = ()
    type AttrGetType MonitorSubpixelLayoutPropertyInfo = Gdk.Enums.SubpixelLayout
    type AttrLabel MonitorSubpixelLayoutPropertyInfo = "subpixel-layout"
    type AttrOrigin MonitorSubpixelLayoutPropertyInfo = Monitor
    attrGet = getMonitorSubpixelLayout
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data MonitorWidthMmPropertyInfo
instance AttrInfo MonitorWidthMmPropertyInfo where
    type AttrAllowedOps MonitorWidthMmPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint MonitorWidthMmPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorWidthMmPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorWidthMmPropertyInfo = (~) ()
    type AttrTransferType MonitorWidthMmPropertyInfo = ()
    type AttrGetType MonitorWidthMmPropertyInfo = Int32
    type AttrLabel MonitorWidthMmPropertyInfo = "width-mm"
    type AttrOrigin MonitorWidthMmPropertyInfo = Monitor
    attrGet = getMonitorWidthMm
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "workarea"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Rectangle"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data MonitorWorkareaPropertyInfo
instance AttrInfo MonitorWorkareaPropertyInfo where
    type AttrAllowedOps MonitorWorkareaPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint MonitorWorkareaPropertyInfo = IsMonitor
    type AttrSetTypeConstraint MonitorWorkareaPropertyInfo = (~) ()
    type AttrTransferTypeConstraint MonitorWorkareaPropertyInfo = (~) ()
    type AttrTransferType MonitorWorkareaPropertyInfo = ()
    type AttrGetType MonitorWorkareaPropertyInfo = (Maybe Gdk.Rectangle.Rectangle)
    type AttrLabel MonitorWorkareaPropertyInfo = "workarea"
    type AttrOrigin MonitorWorkareaPropertyInfo = Monitor
    attrGet = getMonitorWorkarea
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Monitor
type instance O.AttributeList Monitor = MonitorAttributeList
type MonitorAttributeList = ('[ '("display", MonitorDisplayPropertyInfo), '("geometry", MonitorGeometryPropertyInfo), '("heightMm", MonitorHeightMmPropertyInfo), '("manufacturer", MonitorManufacturerPropertyInfo), '("model", MonitorModelPropertyInfo), '("refreshRate", MonitorRefreshRatePropertyInfo), '("scaleFactor", MonitorScaleFactorPropertyInfo), '("subpixelLayout", MonitorSubpixelLayoutPropertyInfo), '("widthMm", MonitorWidthMmPropertyInfo), '("workarea", MonitorWorkareaPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
monitorDisplay :: AttrLabelProxy "display"
monitorDisplay = AttrLabelProxy

monitorGeometry :: AttrLabelProxy "geometry"
monitorGeometry = AttrLabelProxy

monitorHeightMm :: AttrLabelProxy "heightMm"
monitorHeightMm = AttrLabelProxy

monitorManufacturer :: AttrLabelProxy "manufacturer"
monitorManufacturer = AttrLabelProxy

monitorModel :: AttrLabelProxy "model"
monitorModel = AttrLabelProxy

monitorRefreshRate :: AttrLabelProxy "refreshRate"
monitorRefreshRate = AttrLabelProxy

monitorScaleFactor :: AttrLabelProxy "scaleFactor"
monitorScaleFactor = AttrLabelProxy

monitorSubpixelLayout :: AttrLabelProxy "subpixelLayout"
monitorSubpixelLayout = AttrLabelProxy

monitorWidthMm :: AttrLabelProxy "widthMm"
monitorWidthMm = AttrLabelProxy

monitorWorkarea :: AttrLabelProxy "workarea"
monitorWorkarea = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Monitor = MonitorSignalList
type MonitorSignalList = ('[ '("invalidate", MonitorInvalidateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Monitor::get_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_display" gdk_monitor_get_display :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the display that this monitor belongs to.
-- 
-- /Since: 3.22/
monitorGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Gdk.Display.Display
    -- ^ __Returns:__ the display
monitorGetDisplay :: a -> m Display
monitorGetDisplay a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Ptr Display
result <- Ptr Monitor -> IO (Ptr Display)
gdk_monitor_get_display Ptr Monitor
monitor'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"monitorGetDisplay" 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
monitor
    Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data MonitorGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetDisplayMethodInfo a signature where
    overloadedMethod = monitorGetDisplay

#endif

-- method Monitor::get_geometry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "geometry"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GdkRectangle to be filled with 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_monitor_get_geometry" gdk_monitor_get_geometry :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    Ptr Gdk.Rectangle.Rectangle ->          -- geometry : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | Retrieves the size and position of an individual monitor within the
-- display coordinate space. The returned geometry is in  ”application pixels”,
-- not in ”device pixels” (see 'GI.Gdk.Objects.Monitor.monitorGetScaleFactor').
-- 
-- /Since: 3.22/
monitorGetGeometry ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m (Gdk.Rectangle.Rectangle)
monitorGetGeometry :: a -> m Rectangle
monitorGetGeometry a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Ptr Rectangle
geometry <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Monitor -> Ptr Rectangle -> IO ()
gdk_monitor_get_geometry Ptr Monitor
monitor' Ptr Rectangle
geometry
    Rectangle
geometry' <- ((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
geometry
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
geometry'

#if defined(ENABLE_OVERLOADING)
data MonitorGetGeometryMethodInfo
instance (signature ~ (m (Gdk.Rectangle.Rectangle)), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetGeometryMethodInfo a signature where
    overloadedMethod = monitorGetGeometry

#endif

-- method Monitor::get_height_mm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_height_mm" gdk_monitor_get_height_mm :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO Int32

-- | Gets the height in millimeters of the monitor.
-- 
-- /Since: 3.22/
monitorGetHeightMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Int32
    -- ^ __Returns:__ the physical height of the monitor
monitorGetHeightMm :: a -> m Int32
monitorGetHeightMm a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Int32
result <- Ptr Monitor -> IO Int32
gdk_monitor_get_height_mm Ptr Monitor
monitor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MonitorGetHeightMmMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetHeightMmMethodInfo a signature where
    overloadedMethod = monitorGetHeightMm

#endif

-- method Monitor::get_manufacturer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_manufacturer" gdk_monitor_get_manufacturer :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO CString

-- | Gets the name or PNP ID of the monitor\'s manufacturer, if available.
-- 
-- Note that this value might also vary depending on actual
-- display backend.
-- 
-- PNP ID registry is located at https:\/\/uefi.org\/pnp_id_list
monitorGetManufacturer ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the manufacturer, or 'P.Nothing'
monitorGetManufacturer :: a -> m (Maybe Text)
monitorGetManufacturer a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    CString
result <- Ptr Monitor -> IO CString
gdk_monitor_get_manufacturer Ptr Monitor
monitor'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data MonitorGetManufacturerMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetManufacturerMethodInfo a signature where
    overloadedMethod = monitorGetManufacturer

#endif

-- method Monitor::get_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_model" gdk_monitor_get_model :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO CString

-- | Gets the a string identifying the monitor model, if available.
monitorGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the monitor model, or 'P.Nothing'
monitorGetModel :: a -> m (Maybe Text)
monitorGetModel a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    CString
result <- Ptr Monitor -> IO CString
gdk_monitor_get_model Ptr Monitor
monitor'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data MonitorGetModelMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetModelMethodInfo a signature where
    overloadedMethod = monitorGetModel

#endif

-- method Monitor::get_refresh_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_refresh_rate" gdk_monitor_get_refresh_rate :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO Int32

-- | Gets the refresh rate of the monitor, if available.
-- 
-- The value is in milli-Hertz, so a refresh rate of 60Hz
-- is returned as 60000.
-- 
-- /Since: 3.22/
monitorGetRefreshRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Int32
    -- ^ __Returns:__ the refresh rate in milli-Hertz, or 0
monitorGetRefreshRate :: a -> m Int32
monitorGetRefreshRate a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Int32
result <- Ptr Monitor -> IO Int32
gdk_monitor_get_refresh_rate Ptr Monitor
monitor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MonitorGetRefreshRateMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetRefreshRateMethodInfo a signature where
    overloadedMethod = monitorGetRefreshRate

#endif

-- method Monitor::get_scale_factor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_scale_factor" gdk_monitor_get_scale_factor :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO Int32

-- | Gets 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.22/
monitorGetScaleFactor ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Int32
    -- ^ __Returns:__ the scale factor
monitorGetScaleFactor :: a -> m Int32
monitorGetScaleFactor a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Int32
result <- Ptr Monitor -> IO Int32
gdk_monitor_get_scale_factor Ptr Monitor
monitor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MonitorGetScaleFactorMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetScaleFactorMethodInfo a signature where
    overloadedMethod = monitorGetScaleFactor

#endif

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

foreign import ccall "gdk_monitor_get_subpixel_layout" gdk_monitor_get_subpixel_layout :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO CUInt

-- | Gets information about the layout of red, green and blue
-- primaries for each pixel in this monitor, if available.
-- 
-- /Since: 3.22/
monitorGetSubpixelLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Gdk.Enums.SubpixelLayout
    -- ^ __Returns:__ the subpixel layout
monitorGetSubpixelLayout :: a -> m SubpixelLayout
monitorGetSubpixelLayout a
monitor = IO SubpixelLayout -> m SubpixelLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubpixelLayout -> m SubpixelLayout)
-> IO SubpixelLayout -> m SubpixelLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    CUInt
result <- Ptr Monitor -> IO CUInt
gdk_monitor_get_subpixel_layout Ptr Monitor
monitor'
    let result' :: SubpixelLayout
result' = (Int -> SubpixelLayout
forall a. Enum a => Int -> a
toEnum (Int -> SubpixelLayout)
-> (CUInt -> Int) -> CUInt -> SubpixelLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    SubpixelLayout -> IO SubpixelLayout
forall (m :: * -> *) a. Monad m => a -> m a
return SubpixelLayout
result'

#if defined(ENABLE_OVERLOADING)
data MonitorGetSubpixelLayoutMethodInfo
instance (signature ~ (m Gdk.Enums.SubpixelLayout), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetSubpixelLayoutMethodInfo a signature where
    overloadedMethod = monitorGetSubpixelLayout

#endif

-- method Monitor::get_width_mm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_get_width_mm" gdk_monitor_get_width_mm :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO Int32

-- | Gets the width in millimeters of the monitor.
-- 
-- /Since: 3.22/
monitorGetWidthMm ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Int32
    -- ^ __Returns:__ the physical width of the monitor
monitorGetWidthMm :: a -> m Int32
monitorGetWidthMm a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Int32
result <- Ptr Monitor -> IO Int32
gdk_monitor_get_width_mm Ptr Monitor
monitor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MonitorGetWidthMmMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetWidthMmMethodInfo a signature where
    overloadedMethod = monitorGetWidthMm

#endif

-- method Monitor::get_workarea
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "workarea"
--           , 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_monitor_get_workarea" gdk_monitor_get_workarea :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    Ptr Gdk.Rectangle.Rectangle ->          -- workarea : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | Retrieves the size and position of the “work area” on a monitor
-- within the display coordinate space. The returned geometry is in
-- ”application pixels”, not in ”device pixels” (see
-- 'GI.Gdk.Objects.Monitor.monitorGetScaleFactor').
-- 
-- 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.
-- 
-- /Since: 3.22/
monitorGetWorkarea ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m (Gdk.Rectangle.Rectangle)
monitorGetWorkarea :: a -> m Rectangle
monitorGetWorkarea a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    Ptr Rectangle
workarea <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Monitor -> Ptr Rectangle -> IO ()
gdk_monitor_get_workarea Ptr Monitor
monitor' Ptr Rectangle
workarea
    Rectangle
workarea' <- ((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
workarea
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
workarea'

#if defined(ENABLE_OVERLOADING)
data MonitorGetWorkareaMethodInfo
instance (signature ~ (m (Gdk.Rectangle.Rectangle)), MonadIO m, IsMonitor a) => O.MethodInfo MonitorGetWorkareaMethodInfo a signature where
    overloadedMethod = monitorGetWorkarea

#endif

-- method Monitor::is_primary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkMonitor" , 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_monitor_is_primary" gdk_monitor_is_primary :: 
    Ptr Monitor ->                          -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    IO CInt

-- | Gets whether this monitor should be considered primary
-- (see 'GI.Gdk.Objects.Display.displayGetPrimaryMonitor').
-- 
-- /Since: 3.22/
monitorIsPrimary ::
    (B.CallStack.HasCallStack, MonadIO m, IsMonitor a) =>
    a
    -- ^ /@monitor@/: a t'GI.Gdk.Objects.Monitor.Monitor'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@monitor@/ is primary
monitorIsPrimary :: a -> m Bool
monitorIsPrimary a
monitor = 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 Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    CInt
result <- Ptr Monitor -> IO CInt
gdk_monitor_is_primary Ptr Monitor
monitor'
    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
monitor
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MonitorIsPrimaryMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMonitor a) => O.MethodInfo MonitorIsPrimaryMethodInfo a signature where
    overloadedMethod = monitorIsPrimary

#endif