{-# LINE 1 "Graphics/X11/Xrandr.hsc" #-}
{-# LANGUAGE DeriveDataTypeable #-}
--------------------------------------------------------------------
-- |
-- Module    : Graphics.X11.Xrandr
-- Copyright : (c) Haskell.org, 2012
--             (c) Jochen Keil, 2012
-- License   : BSD3
--
-- Maintainer: Ben Boeckel <mathstuf@gmail.com>
--           , Jochen Keil <jochen dot keil at gmail dot com>
--
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
--
-- Interface to Xrandr API
--

module Graphics.X11.Xrandr (
  XRRScreenSize(..),
  XRRModeInfo(..),
  XRRScreenResources(..),
  XRROutputInfo(..),
  XRRCrtcInfo(..),
  XRRPropertyInfo(..),
  XRRMonitorInfo(..),
  compiledWithXrandr,
  Rotation,
  Reflection,
  SizeID,
  XRRScreenConfiguration,
  xrrQueryExtension,
  xrrQueryVersion,
  xrrGetScreenInfo,
  xrrFreeScreenConfigInfo,
  xrrSetScreenConfig,
  xrrSetScreenConfigAndRate,
  xrrConfigRotations,
  xrrConfigTimes,
  xrrConfigSizes,
  xrrConfigRates,
  xrrConfigCurrentConfiguration,
  xrrConfigCurrentRate,
  xrrRootToScreen,
  xrrSelectInput,
  xrrUpdateConfiguration,
  xrrRotations,
  xrrSizes,
  xrrRates,
  xrrTimes,
  xrrGetScreenResources,
  xrrGetOutputInfo,
  xrrGetCrtcInfo,
  xrrGetScreenResourcesCurrent,
  xrrSetOutputPrimary,
  xrrGetOutputPrimary,
  xrrListOutputProperties,
  xrrQueryOutputProperty,
  xrrConfigureOutputProperty,
  xrrChangeOutputProperty,
  xrrGetOutputProperty,
  xrrDeleteOutputProperty,
  xrrGetMonitors,
  ) where

import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Monad

import Graphics.X11.Xlib.Event
import Graphics.X11.Xlib.Internal
import Graphics.X11.Xlib.Types
import Graphics.X11.Types


{-# LINE 78 "Graphics/X11/Xrandr.hsc" #-}
import Data.Data

{-# LINE 80 "Graphics/X11/Xrandr.hsc" #-}

-- | Representation of the XRRScreenSize struct
data XRRScreenSize = XRRScreenSize
                     { XRRScreenSize -> CInt
xrr_ss_width   :: !CInt,
                       XRRScreenSize -> CInt
xrr_ss_height  :: !CInt,
                       XRRScreenSize -> CInt
xrr_ss_mwidth  :: !CInt,
                       XRRScreenSize -> CInt
xrr_ss_mheight :: !CInt }
                       deriving (Int -> XRRScreenSize -> ShowS
[XRRScreenSize] -> ShowS
XRRScreenSize -> String
(Int -> XRRScreenSize -> ShowS)
-> (XRRScreenSize -> String)
-> ([XRRScreenSize] -> ShowS)
-> Show XRRScreenSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRScreenSize -> ShowS
showsPrec :: Int -> XRRScreenSize -> ShowS
$cshow :: XRRScreenSize -> String
show :: XRRScreenSize -> String
$cshowList :: [XRRScreenSize] -> ShowS
showList :: [XRRScreenSize] -> ShowS
Show)

-- | Representation of the XRRModeInfo struct
data XRRModeInfo = XRRModeInfo
    { XRRModeInfo -> Atom
xrr_mi_id         :: !RRMode
    , XRRModeInfo -> CUInt
xrr_mi_width      :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_height     :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_dotClock   :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_hSyncStart :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_hSyncEnd   :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_hTotal     :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_hSkew      :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_vSyncStart :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_vSyncEnd   :: !CUInt
    , XRRModeInfo -> CUInt
xrr_mi_vTotal     :: !CUInt
    , XRRModeInfo -> String
xrr_mi_name       :: !String
    , XRRModeInfo -> Atom
xrr_mi_modeFlags  :: !XRRModeFlags
    } deriving (XRRModeInfo -> XRRModeInfo -> Bool
(XRRModeInfo -> XRRModeInfo -> Bool)
-> (XRRModeInfo -> XRRModeInfo -> Bool) -> Eq XRRModeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRModeInfo -> XRRModeInfo -> Bool
== :: XRRModeInfo -> XRRModeInfo -> Bool
$c/= :: XRRModeInfo -> XRRModeInfo -> Bool
/= :: XRRModeInfo -> XRRModeInfo -> Bool
Eq, Int -> XRRModeInfo -> ShowS
[XRRModeInfo] -> ShowS
XRRModeInfo -> String
(Int -> XRRModeInfo -> ShowS)
-> (XRRModeInfo -> String)
-> ([XRRModeInfo] -> ShowS)
-> Show XRRModeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRModeInfo -> ShowS
showsPrec :: Int -> XRRModeInfo -> ShowS
$cshow :: XRRModeInfo -> String
show :: XRRModeInfo -> String
$cshowList :: [XRRModeInfo] -> ShowS
showList :: [XRRModeInfo] -> ShowS
Show)

-- | Representation of the XRRScreenResources struct
data XRRScreenResources = XRRScreenResources
    { XRRScreenResources -> Atom
xrr_sr_timestamp       :: !Time
    , XRRScreenResources -> Atom
xrr_sr_configTimestamp :: !Time
    , XRRScreenResources -> [Atom]
xrr_sr_crtcs           :: [RRCrtc]
    , XRRScreenResources -> [Atom]
xrr_sr_outputs         :: [RROutput]
    , XRRScreenResources -> [XRRModeInfo]
xrr_sr_modes           :: [XRRModeInfo]
    } deriving (XRRScreenResources -> XRRScreenResources -> Bool
(XRRScreenResources -> XRRScreenResources -> Bool)
-> (XRRScreenResources -> XRRScreenResources -> Bool)
-> Eq XRRScreenResources
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRScreenResources -> XRRScreenResources -> Bool
== :: XRRScreenResources -> XRRScreenResources -> Bool
$c/= :: XRRScreenResources -> XRRScreenResources -> Bool
/= :: XRRScreenResources -> XRRScreenResources -> Bool
Eq, Int -> XRRScreenResources -> ShowS
[XRRScreenResources] -> ShowS
XRRScreenResources -> String
(Int -> XRRScreenResources -> ShowS)
-> (XRRScreenResources -> String)
-> ([XRRScreenResources] -> ShowS)
-> Show XRRScreenResources
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRScreenResources -> ShowS
showsPrec :: Int -> XRRScreenResources -> ShowS
$cshow :: XRRScreenResources -> String
show :: XRRScreenResources -> String
$cshowList :: [XRRScreenResources] -> ShowS
showList :: [XRRScreenResources] -> ShowS
Show)

-- | Representation of the XRROutputInfo struct
data XRROutputInfo = XRROutputInfo
    { XRROutputInfo -> Atom
xrr_oi_timestamp      :: !Time
    , XRROutputInfo -> Atom
xrr_oi_crtc           :: !RRCrtc
    , XRROutputInfo -> String
xrr_oi_name           :: !String
    , XRROutputInfo -> CULong
xrr_oi_mm_width       :: !CULong
    , XRROutputInfo -> CULong
xrr_oi_mm_height      :: !CULong
    , XRROutputInfo -> Word16
xrr_oi_connection     :: !Connection
    , XRROutputInfo -> Word16
xrr_oi_subpixel_order :: !SubpixelOrder
    , XRROutputInfo -> [Atom]
xrr_oi_crtcs          :: [RRCrtc]
    , XRROutputInfo -> [Atom]
xrr_oi_clones         :: [RROutput]
    , XRROutputInfo -> CInt
xrr_oi_npreferred     :: !CInt
    , XRROutputInfo -> [Atom]
xrr_oi_modes          :: [RRMode]
    } deriving (XRROutputInfo -> XRROutputInfo -> Bool
(XRROutputInfo -> XRROutputInfo -> Bool)
-> (XRROutputInfo -> XRROutputInfo -> Bool) -> Eq XRROutputInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRROutputInfo -> XRROutputInfo -> Bool
== :: XRROutputInfo -> XRROutputInfo -> Bool
$c/= :: XRROutputInfo -> XRROutputInfo -> Bool
/= :: XRROutputInfo -> XRROutputInfo -> Bool
Eq, Int -> XRROutputInfo -> ShowS
[XRROutputInfo] -> ShowS
XRROutputInfo -> String
(Int -> XRROutputInfo -> ShowS)
-> (XRROutputInfo -> String)
-> ([XRROutputInfo] -> ShowS)
-> Show XRROutputInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRROutputInfo -> ShowS
showsPrec :: Int -> XRROutputInfo -> ShowS
$cshow :: XRROutputInfo -> String
show :: XRROutputInfo -> String
$cshowList :: [XRROutputInfo] -> ShowS
showList :: [XRROutputInfo] -> ShowS
Show)

-- | Representation of the XRRCrtcInfo struct
data XRRCrtcInfo = XRRCrtcInfo
    { XRRCrtcInfo -> Atom
xrr_ci_timestamp    :: !Time
    , XRRCrtcInfo -> CInt
xrr_ci_x            :: !CInt
    , XRRCrtcInfo -> CInt
xrr_ci_y            :: !CInt
    , XRRCrtcInfo -> CUInt
xrr_ci_width        :: !CUInt
    , XRRCrtcInfo -> CUInt
xrr_ci_height       :: !CUInt
    , XRRCrtcInfo -> Atom
xrr_ci_mode         :: !RRMode
    , XRRCrtcInfo -> Word16
xrr_ci_rotation     :: !Rotation
    , XRRCrtcInfo -> [Atom]
xrr_ci_outputs      :: [RROutput]
    , XRRCrtcInfo -> Word16
xrr_ci_rotations    :: !Rotation
    , XRRCrtcInfo -> [Atom]
xrr_ci_possible     :: [RROutput]
    } deriving (XRRCrtcInfo -> XRRCrtcInfo -> Bool
(XRRCrtcInfo -> XRRCrtcInfo -> Bool)
-> (XRRCrtcInfo -> XRRCrtcInfo -> Bool) -> Eq XRRCrtcInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
== :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
$c/= :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
/= :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
Eq, Int -> XRRCrtcInfo -> ShowS
[XRRCrtcInfo] -> ShowS
XRRCrtcInfo -> String
(Int -> XRRCrtcInfo -> ShowS)
-> (XRRCrtcInfo -> String)
-> ([XRRCrtcInfo] -> ShowS)
-> Show XRRCrtcInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRCrtcInfo -> ShowS
showsPrec :: Int -> XRRCrtcInfo -> ShowS
$cshow :: XRRCrtcInfo -> String
show :: XRRCrtcInfo -> String
$cshowList :: [XRRCrtcInfo] -> ShowS
showList :: [XRRCrtcInfo] -> ShowS
Show)

-- | Representation of the XRRPropertyInfo struct
data XRRPropertyInfo = XRRPropertyInfo
    { XRRPropertyInfo -> Bool
xrr_pi_pending      :: !Bool
    , XRRPropertyInfo -> Bool
xrr_pi_range        :: !Bool
    , XRRPropertyInfo -> Bool
xrr_pi_immutable    :: !Bool
    , XRRPropertyInfo -> [CLong]
xrr_pi_values       :: [CLong]
    } deriving (XRRPropertyInfo -> XRRPropertyInfo -> Bool
(XRRPropertyInfo -> XRRPropertyInfo -> Bool)
-> (XRRPropertyInfo -> XRRPropertyInfo -> Bool)
-> Eq XRRPropertyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
== :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
$c/= :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
/= :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
Eq, Int -> XRRPropertyInfo -> ShowS
[XRRPropertyInfo] -> ShowS
XRRPropertyInfo -> String
(Int -> XRRPropertyInfo -> ShowS)
-> (XRRPropertyInfo -> String)
-> ([XRRPropertyInfo] -> ShowS)
-> Show XRRPropertyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRPropertyInfo -> ShowS
showsPrec :: Int -> XRRPropertyInfo -> ShowS
$cshow :: XRRPropertyInfo -> String
show :: XRRPropertyInfo -> String
$cshowList :: [XRRPropertyInfo] -> ShowS
showList :: [XRRPropertyInfo] -> ShowS
Show)

-- | Representation of the XRRMonitorInfo struct
data XRRMonitorInfo = XRRMonitorInfo
   { XRRMonitorInfo -> Atom
xrr_moninf_name      :: !Atom
   , XRRMonitorInfo -> Bool
xrr_moninf_primary   :: !Bool
   , XRRMonitorInfo -> Bool
xrr_moninf_automatic :: !Bool
   , XRRMonitorInfo -> CInt
xrr_moninf_x         :: !CInt
   , XRRMonitorInfo -> CInt
xrr_moninf_y         :: !CInt
   , XRRMonitorInfo -> CInt
xrr_moninf_width     :: !CInt
   , XRRMonitorInfo -> CInt
xrr_moninf_height    :: !CInt
   , XRRMonitorInfo -> CInt
xrr_moninf_mwidth    :: !CInt
   , XRRMonitorInfo -> CInt
xrr_moninf_mheight   :: !CInt
   , XRRMonitorInfo -> [Atom]
xrr_moninf_outputs   :: [RROutput]
   } deriving (XRRMonitorInfo -> XRRMonitorInfo -> Bool
(XRRMonitorInfo -> XRRMonitorInfo -> Bool)
-> (XRRMonitorInfo -> XRRMonitorInfo -> Bool) -> Eq XRRMonitorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
== :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
$c/= :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
/= :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
Eq, Int -> XRRMonitorInfo -> ShowS
[XRRMonitorInfo] -> ShowS
XRRMonitorInfo -> String
(Int -> XRRMonitorInfo -> ShowS)
-> (XRRMonitorInfo -> String)
-> ([XRRMonitorInfo] -> ShowS)
-> Show XRRMonitorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRMonitorInfo -> ShowS
showsPrec :: Int -> XRRMonitorInfo -> ShowS
$cshow :: XRRMonitorInfo -> String
show :: XRRMonitorInfo -> String
$cshowList :: [XRRMonitorInfo] -> ShowS
showList :: [XRRMonitorInfo] -> ShowS
Show)

-- We have Xrandr, so the library will actually work
compiledWithXrandr :: Bool
compiledWithXrandr :: Bool
compiledWithXrandr = Bool
True



newtype XRRScreenConfiguration = XRRScreenConfiguration (Ptr XRRScreenConfiguration)

{-# LINE 174 "Graphics/X11/Xrandr.hsc" #-}
        deriving (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
(XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> Eq XRRScreenConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
== :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c/= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
/= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
Eq, Eq XRRScreenConfiguration
Eq XRRScreenConfiguration =>
(XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering)
-> (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> (XRRScreenConfiguration -> XRRScreenConfiguration -> Bool)
-> (XRRScreenConfiguration
    -> XRRScreenConfiguration -> XRRScreenConfiguration)
-> (XRRScreenConfiguration
    -> XRRScreenConfiguration -> XRRScreenConfiguration)
-> Ord XRRScreenConfiguration
XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering
XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering
compare :: XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering
$c< :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
< :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c<= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
<= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c> :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
> :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c>= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
>= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$cmax :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
max :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
$cmin :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
min :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
Ord, Int -> XRRScreenConfiguration -> ShowS
[XRRScreenConfiguration] -> ShowS
XRRScreenConfiguration -> String
(Int -> XRRScreenConfiguration -> ShowS)
-> (XRRScreenConfiguration -> String)
-> ([XRRScreenConfiguration] -> ShowS)
-> Show XRRScreenConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRRScreenConfiguration -> ShowS
showsPrec :: Int -> XRRScreenConfiguration -> ShowS
$cshow :: XRRScreenConfiguration -> String
show :: XRRScreenConfiguration -> String
$cshowList :: [XRRScreenConfiguration] -> ShowS
showList :: [XRRScreenConfiguration] -> ShowS
Show, Typeable, Typeable XRRScreenConfiguration
Typeable XRRScreenConfiguration =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> XRRScreenConfiguration
 -> c XRRScreenConfiguration)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration)
-> (XRRScreenConfiguration -> Constr)
-> (XRRScreenConfiguration -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c XRRScreenConfiguration))
-> ((forall b. Data b => b -> b)
    -> XRRScreenConfiguration -> XRRScreenConfiguration)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> XRRScreenConfiguration
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> XRRScreenConfiguration
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> XRRScreenConfiguration -> m XRRScreenConfiguration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XRRScreenConfiguration -> m XRRScreenConfiguration)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XRRScreenConfiguration -> m XRRScreenConfiguration)
-> Data XRRScreenConfiguration
XRRScreenConfiguration -> Constr
XRRScreenConfiguration -> DataType
(forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u
forall u.
(forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XRRScreenConfiguration)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration
$ctoConstr :: XRRScreenConfiguration -> Constr
toConstr :: XRRScreenConfiguration -> Constr
$cdataTypeOf :: XRRScreenConfiguration -> DataType
dataTypeOf :: XRRScreenConfiguration -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XRRScreenConfiguration)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XRRScreenConfiguration)
$cgmapT :: (forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
gmapT :: (forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
Data)

{-# LINE 178 "Graphics/X11/Xrandr.hsc" #-}

instance Storable XRRScreenSize where
    sizeOf :: XRRScreenSize -> Int
sizeOf XRRScreenSize
_ = (Int
16)
{-# LINE 181 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRScreenSize -> Int
alignment XRRScreenSize
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRScreenSize -> XRRScreenSize -> IO ()
poke Ptr XRRScreenSize
p XRRScreenSize
xrr_ss = do
        (\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenSize
hsc_ptr Int
0) Ptr XRRScreenSize
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenSize -> CInt
xrr_ss_width XRRScreenSize
xrr_ss
{-# LINE 186 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenSize
hsc_ptr Int
4) Ptr XRRScreenSize
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenSize -> CInt
xrr_ss_height XRRScreenSize
xrr_ss
{-# LINE 187 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenSize
hsc_ptr Int
8) Ptr XRRScreenSize
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenSize -> CInt
xrr_ss_mwidth XRRScreenSize
xrr_ss
{-# LINE 188 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenSize
hsc_ptr Int
12) Ptr XRRScreenSize
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenSize -> CInt
xrr_ss_mheight XRRScreenSize
xrr_ss
{-# LINE 189 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRScreenSize -> IO XRRScreenSize
peek Ptr XRRScreenSize
p = (CInt -> CInt -> CInt -> CInt -> XRRScreenSize)
-> IO (CInt -> CInt -> CInt -> CInt -> XRRScreenSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt -> CInt -> CInt -> CInt -> XRRScreenSize
XRRScreenSize
        IO (CInt -> CInt -> CInt -> CInt -> XRRScreenSize)
-> IO CInt -> IO (CInt -> CInt -> CInt -> XRRScreenSize)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenSize
hsc_ptr Int
0) Ptr XRRScreenSize
p)
{-# LINE 192 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> CInt -> CInt -> XRRScreenSize)
-> IO CInt -> IO (CInt -> CInt -> XRRScreenSize)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenSize
hsc_ptr Int
4) Ptr XRRScreenSize
p)
{-# LINE 193 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> CInt -> XRRScreenSize)
-> IO CInt -> IO (CInt -> XRRScreenSize)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenSize
hsc_ptr Int
8) Ptr XRRScreenSize
p)
{-# LINE 194 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> XRRScreenSize) -> IO CInt -> IO XRRScreenSize
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XRRScreenSize
hsc_ptr -> Ptr XRRScreenSize -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenSize
hsc_ptr Int
12) Ptr XRRScreenSize
p)
{-# LINE 195 "Graphics/X11/Xrandr.hsc" #-}

instance Storable XRRModeInfo where
    sizeOf :: XRRModeInfo -> Int
sizeOf XRRModeInfo
_ = (Int
80)
{-# LINE 198 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRModeInfo -> Int
alignment XRRModeInfo
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRModeInfo -> XRRModeInfo -> IO ()
poke Ptr XRRModeInfo
p XRRModeInfo
xrr_mi = do
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
0) Ptr XRRModeInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> Atom
xrr_mi_id         XRRModeInfo
xrr_mi
{-# LINE 203 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
8) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_width      XRRModeInfo
xrr_mi
{-# LINE 204 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
12) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_height     XRRModeInfo
xrr_mi
{-# LINE 205 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
16) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_dotClock   XRRModeInfo
xrr_mi
{-# LINE 206 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
24) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_hSyncStart XRRModeInfo
xrr_mi
{-# LINE 207 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
28) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_hSyncEnd   XRRModeInfo
xrr_mi
{-# LINE 208 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
32) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_hTotal     XRRModeInfo
xrr_mi
{-# LINE 209 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
36) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_hSkew      XRRModeInfo
xrr_mi
{-# LINE 210 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
40) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_vSyncStart XRRModeInfo
xrr_mi
{-# LINE 211 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
44) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_vSyncEnd   XRRModeInfo
xrr_mi
{-# LINE 212 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
48) Ptr XRRModeInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> CUInt
xrr_mi_vTotal     XRRModeInfo
xrr_mi
{-# LINE 213 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
72) Ptr XRRModeInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> Atom
xrr_mi_modeFlags  XRRModeInfo
xrr_mi
{-# LINE 214 "Graphics/X11/Xrandr.hsc" #-}
        -- see comment in Storable XRRScreenResources about dynamic resource allocation
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
64) Ptr XRRModeInfo
p ( CInt
0 :: CInt )
{-# LINE 216 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
56) Ptr XRRModeInfo
p ( Ptr CChar
forall a. Ptr a
nullPtr :: Ptr CChar )
{-# LINE 217 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRModeInfo -> IO XRRModeInfo
peek Ptr XRRModeInfo
p = (Atom
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> String
 -> Atom
 -> XRRModeInfo)
-> IO
     (Atom
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> String
-> Atom
-> XRRModeInfo
XRRModeInfo
        IO
  (Atom
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO Atom
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
0) Ptr XRRModeInfo
p )
{-# LINE 220 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
8) Ptr XRRModeInfo
p )
{-# LINE 221 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
12) Ptr XRRModeInfo
p )
{-# LINE 222 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
16) Ptr XRRModeInfo
p )
{-# LINE 223 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
24) Ptr XRRModeInfo
p )
{-# LINE 224 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> Atom
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
28) Ptr XRRModeInfo
p )
{-# LINE 225 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> Atom
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt -> CUInt -> CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
32) Ptr XRRModeInfo
p )
{-# LINE 226 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt -> CUInt -> CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
-> IO CUInt
-> IO (CUInt -> CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
36) Ptr XRRModeInfo
p )
{-# LINE 227 "Graphics/X11/Xrandr.hsc" #-}
        IO (CUInt -> CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
-> IO CUInt -> IO (CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
40) Ptr XRRModeInfo
p )
{-# LINE 228 "Graphics/X11/Xrandr.hsc" #-}
        IO (CUInt -> CUInt -> String -> Atom -> XRRModeInfo)
-> IO CUInt -> IO (CUInt -> String -> Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
44) Ptr XRRModeInfo
p )
{-# LINE 229 "Graphics/X11/Xrandr.hsc" #-}
        IO (CUInt -> String -> Atom -> XRRModeInfo)
-> IO CUInt -> IO (String -> Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
48) Ptr XRRModeInfo
p )
{-# LINE 230 "Graphics/X11/Xrandr.hsc" #-}
        IO (String -> Atom -> XRRModeInfo)
-> IO String -> IO (Atom -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr CChar) -> IO String
peekCStringLenIO ((\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
64) Ptr XRRModeInfo
p)
{-# LINE 231 "Graphics/X11/Xrandr.hsc" #-}
                              ((\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
56) Ptr XRRModeInfo
p)
{-# LINE 232 "Graphics/X11/Xrandr.hsc" #-}
        IO (Atom -> XRRModeInfo) -> IO Atom -> IO XRRModeInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRModeInfo
hsc_ptr Int
72) Ptr XRRModeInfo
p )
{-# LINE 233 "Graphics/X11/Xrandr.hsc" #-}

instance Storable XRRMonitorInfo where
    sizeOf :: XRRMonitorInfo -> Int
sizeOf XRRMonitorInfo
_ = (Int
56)
{-# LINE 236 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRMonitorInfo -> Int
alignment XRRMonitorInfo
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRMonitorInfo -> XRRMonitorInfo -> IO ()
poke Ptr XRRMonitorInfo
p XRRMonitorInfo
xrr_moninf = do
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
0) Ptr XRRMonitorInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> Atom
xrr_moninf_name      XRRMonitorInfo
xrr_moninf
{-# LINE 241 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> Bool -> IO ()
forall b. Ptr b -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
8) Ptr XRRMonitorInfo
p (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> Bool
xrr_moninf_primary   XRRMonitorInfo
xrr_moninf
{-# LINE 242 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> Bool -> IO ()
forall b. Ptr b -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
12) Ptr XRRMonitorInfo
p (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> Bool
xrr_moninf_automatic XRRMonitorInfo
xrr_moninf
{-# LINE 243 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
20) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_x         XRRMonitorInfo
xrr_moninf
{-# LINE 244 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
24) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_y         XRRMonitorInfo
xrr_moninf
{-# LINE 245 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
28) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_width     XRRMonitorInfo
xrr_moninf
{-# LINE 246 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
32) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_height    XRRMonitorInfo
xrr_moninf
{-# LINE 247 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
36) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_mwidth    XRRMonitorInfo
xrr_moninf
{-# LINE 248 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
40) Ptr XRRMonitorInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> CInt
xrr_moninf_mheight   XRRMonitorInfo
xrr_moninf
{-# LINE 249 "Graphics/X11/Xrandr.hsc" #-}
        -- see comment in Storable XRRScreenResources about dynamic resource allocation
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
16) Ptr XRRMonitorInfo
p ( CInt
0 :: CInt )
{-# LINE 251 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
48) Ptr XRRMonitorInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 252 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRMonitorInfo -> IO XRRMonitorInfo
peek Ptr XRRMonitorInfo
p = (Atom
 -> Bool
 -> Bool
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> [Atom]
 -> XRRMonitorInfo)
-> IO
     (Atom
      -> Bool
      -> Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [Atom]
      -> XRRMonitorInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
-> Bool
-> Bool
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> [Atom]
-> XRRMonitorInfo
XRRMonitorInfo
        IO
  (Atom
   -> Bool
   -> Bool
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> [Atom]
   -> XRRMonitorInfo)
-> IO Atom
-> IO
     (Bool
      -> Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [Atom]
      -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
0) Ptr XRRMonitorInfo
p )
{-# LINE 255 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (Bool
   -> Bool
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> [Atom]
   -> XRRMonitorInfo)
-> IO Bool
-> IO
     (Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [Atom]
      -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
8) Ptr XRRMonitorInfo
p )
{-# LINE 256 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (Bool
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> [Atom]
   -> XRRMonitorInfo)
-> IO Bool
-> IO
     (CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [Atom]
      -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
12) Ptr XRRMonitorInfo
p )
{-# LINE 257 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> [Atom]
   -> XRRMonitorInfo)
-> IO CInt
-> IO
     (CInt -> CInt -> CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
20) Ptr XRRMonitorInfo
p )
{-# LINE 258 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CInt -> CInt -> CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
-> IO CInt
-> IO (CInt -> CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
24) Ptr XRRMonitorInfo
p )
{-# LINE 259 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
-> IO CInt -> IO (CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
28) Ptr XRRMonitorInfo
p )
{-# LINE 260 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> CInt -> CInt -> [Atom] -> XRRMonitorInfo)
-> IO CInt -> IO (CInt -> CInt -> [Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
32) Ptr XRRMonitorInfo
p )
{-# LINE 261 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> CInt -> [Atom] -> XRRMonitorInfo)
-> IO CInt -> IO (CInt -> [Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
36) Ptr XRRMonitorInfo
p )
{-# LINE 262 "Graphics/X11/Xrandr.hsc" #-}
        IO (CInt -> [Atom] -> XRRMonitorInfo)
-> IO CInt -> IO ([Atom] -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
40) Ptr XRRMonitorInfo
p )
{-# LINE 263 "Graphics/X11/Xrandr.hsc" #-}
        IO ([Atom] -> XRRMonitorInfo) -> IO [Atom] -> IO XRRMonitorInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
16) Ptr XRRMonitorInfo
p)
{-# LINE 264 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRMonitorInfo
hsc_ptr Int
48) Ptr XRRMonitorInfo
p)
{-# LINE 265 "Graphics/X11/Xrandr.hsc" #-}


instance Storable XRRScreenResources where
    sizeOf :: XRRScreenResources -> Int
sizeOf XRRScreenResources
_ = (Int
64)
{-# LINE 269 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRScreenResources -> Int
alignment XRRScreenResources
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRScreenResources -> XRRScreenResources -> IO ()
poke Ptr XRRScreenResources
p XRRScreenResources
xrr_sr = do
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
0) Ptr XRRScreenResources
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> Atom
xrr_sr_timestamp       XRRScreenResources
xrr_sr
{-# LINE 274 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
8) Ptr XRRScreenResources
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> Atom
xrr_sr_configTimestamp XRRScreenResources
xrr_sr
{-# LINE 275 "Graphics/X11/Xrandr.hsc" #-}
        -- there is no simple way to handle ptrs to arrays or struct through ffi
        -- Using plain malloc will result in a memory leak, unless the poking
        -- function will free the memory manually
        -- Unfortunately a ForeignPtr with a Finalizer is not going to work
        -- either, because the Finalizer will be run after poke returns, making
        -- the allocated memory unusable.
        -- The safest option is therefore probably to have the calling function
        -- handle this issue for itself
        -- e.g.
        -- #{poke XRRScreenResources, ncrtc} p ( fromIntegral $ length $ xrr_sr_crtcs xrr_sr :: CInt )
        -- crtcp <- mallocArray $ length $ xrr_sr_crtcs xrr_sr
        -- pokeArray crtcp $ xrr_sr_crtcs xrr_sr
        -- #{poke XRRScreenResources, crtcs} p crtcp
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
16) Ptr XRRScreenResources
p ( CInt
0 :: CInt )
{-# LINE 289 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
32) Ptr XRRScreenResources
p ( CInt
0 :: CInt )
{-# LINE 290 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
48) Ptr XRRScreenResources
p ( CInt
0 :: CInt )
{-# LINE 291 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
24) Ptr XRRScreenResources
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RRCrtc      )
{-# LINE 292 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
40) Ptr XRRScreenResources
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RROutput    )
{-# LINE 293 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Ptr XRRModeInfo -> IO ()
forall b. Ptr b -> Int -> Ptr XRRModeInfo -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
56) Ptr XRRScreenResources
p ( Ptr XRRModeInfo
forall a. Ptr a
nullPtr :: Ptr XRRModeInfo )
{-# LINE 294 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRScreenResources -> IO XRRScreenResources
peek Ptr XRRScreenResources
p = (Atom
 -> Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
-> IO
     (Atom
      -> Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
-> Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources
XRRScreenResources
        IO
  (Atom
   -> Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
-> IO Atom
-> IO
     (Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
0) Ptr XRRScreenResources
p )
{-# LINE 297 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (Atom -> [Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
-> IO Atom
-> IO ([Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
8) Ptr XRRScreenResources
p )
{-# LINE 298 "Graphics/X11/Xrandr.hsc" #-}
        IO ([Atom] -> [Atom] -> [XRRModeInfo] -> XRRScreenResources)
-> IO [Atom] -> IO ([Atom] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
16) Ptr XRRScreenResources
p)
{-# LINE 299 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
24) Ptr XRRScreenResources
p)
{-# LINE 300 "Graphics/X11/Xrandr.hsc" #-}
        IO ([Atom] -> [XRRModeInfo] -> XRRScreenResources)
-> IO [Atom] -> IO ([XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
32) Ptr XRRScreenResources
p)
{-# LINE 301 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
40) Ptr XRRScreenResources
p)
{-# LINE 302 "Graphics/X11/Xrandr.hsc" #-}
        IO ([XRRModeInfo] -> XRRScreenResources)
-> IO [XRRModeInfo] -> IO XRRScreenResources
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr XRRModeInfo) -> IO [XRRModeInfo]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
48) Ptr XRRScreenResources
p)
{-# LINE 303 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO (Ptr XRRModeInfo)
forall b. Ptr b -> Int -> IO (Ptr XRRModeInfo)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRScreenResources
hsc_ptr Int
56) Ptr XRRScreenResources
p)
{-# LINE 304 "Graphics/X11/Xrandr.hsc" #-}


instance Storable XRROutputInfo where
    sizeOf :: XRROutputInfo -> Int
sizeOf XRROutputInfo
_ = (Int
96)
{-# LINE 308 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRROutputInfo -> Int
alignment XRROutputInfo
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRROutputInfo -> XRROutputInfo -> IO ()
poke Ptr XRROutputInfo
p XRROutputInfo
xrr_oi = do
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
0) Ptr XRROutputInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Atom
xrr_oi_timestamp      XRROutputInfo
xrr_oi
{-# LINE 313 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
8) Ptr XRROutputInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Atom
xrr_oi_crtc           XRROutputInfo
xrr_oi
{-# LINE 314 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CULong -> IO ()
forall b. Ptr b -> Int -> CULong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
32) Ptr XRROutputInfo
p (CULong -> IO ()) -> CULong -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> CULong
xrr_oi_mm_width       XRROutputInfo
xrr_oi
{-# LINE 315 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CULong -> IO ()
forall b. Ptr b -> Int -> CULong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
40) Ptr XRROutputInfo
p (CULong -> IO ()) -> CULong -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> CULong
xrr_oi_mm_height      XRROutputInfo
xrr_oi
{-# LINE 316 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
48) Ptr XRROutputInfo
p (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Word16
xrr_oi_connection     XRROutputInfo
xrr_oi
{-# LINE 317 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
50) Ptr XRROutputInfo
p (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Word16
xrr_oi_subpixel_order XRROutputInfo
xrr_oi
{-# LINE 318 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
84) Ptr XRROutputInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> CInt
xrr_oi_npreferred     XRROutputInfo
xrr_oi
{-# LINE 319 "Graphics/X11/Xrandr.hsc" #-}
        -- see comment in Storable XRRScreenResources about dynamic resource allocation
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
24) Ptr XRROutputInfo
p ( CInt
0 :: CInt )
{-# LINE 321 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
52) Ptr XRROutputInfo
p ( CInt
0 :: CInt )
{-# LINE 322 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
64) Ptr XRROutputInfo
p ( CInt
0 :: CInt )
{-# LINE 323 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
80) Ptr XRROutputInfo
p ( CInt
0 :: CInt )
{-# LINE 324 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
16) Ptr XRROutputInfo
p ( Ptr CChar
forall a. Ptr a
nullPtr :: Ptr CChar    )
{-# LINE 325 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
56) Ptr XRROutputInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RRCrtc   )
{-# LINE 326 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
72) Ptr XRROutputInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 327 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
88) Ptr XRROutputInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RRMode   )
{-# LINE 328 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRROutputInfo -> IO XRROutputInfo
peek Ptr XRROutputInfo
p = (Atom
 -> Atom
 -> String
 -> CULong
 -> CULong
 -> Word16
 -> Word16
 -> [Atom]
 -> [Atom]
 -> CInt
 -> [Atom]
 -> XRROutputInfo)
-> IO
     (Atom
      -> Atom
      -> String
      -> CULong
      -> CULong
      -> Word16
      -> Word16
      -> [Atom]
      -> [Atom]
      -> CInt
      -> [Atom]
      -> XRROutputInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
-> Atom
-> String
-> CULong
-> CULong
-> Word16
-> Word16
-> [Atom]
-> [Atom]
-> CInt
-> [Atom]
-> XRROutputInfo
XRROutputInfo
            IO
  (Atom
   -> Atom
   -> String
   -> CULong
   -> CULong
   -> Word16
   -> Word16
   -> [Atom]
   -> [Atom]
   -> CInt
   -> [Atom]
   -> XRROutputInfo)
-> IO Atom
-> IO
     (Atom
      -> String
      -> CULong
      -> CULong
      -> Word16
      -> Word16
      -> [Atom]
      -> [Atom]
      -> CInt
      -> [Atom]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
0) Ptr XRROutputInfo
p )
{-# LINE 331 "Graphics/X11/Xrandr.hsc" #-}
            IO
  (Atom
   -> String
   -> CULong
   -> CULong
   -> Word16
   -> Word16
   -> [Atom]
   -> [Atom]
   -> CInt
   -> [Atom]
   -> XRROutputInfo)
-> IO Atom
-> IO
     (String
      -> CULong
      -> CULong
      -> Word16
      -> Word16
      -> [Atom]
      -> [Atom]
      -> CInt
      -> [Atom]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
8) Ptr XRROutputInfo
p )
{-# LINE 332 "Graphics/X11/Xrandr.hsc" #-}
            IO
  (String
   -> CULong
   -> CULong
   -> Word16
   -> Word16
   -> [Atom]
   -> [Atom]
   -> CInt
   -> [Atom]
   -> XRROutputInfo)
-> IO String
-> IO
     (CULong
      -> CULong
      -> Word16
      -> Word16
      -> [Atom]
      -> [Atom]
      -> CInt
      -> [Atom]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr CChar) -> IO String
peekCStringLenIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
24) Ptr XRROutputInfo
p)
{-# LINE 333 "Graphics/X11/Xrandr.hsc" #-}
                                  ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
16) Ptr XRROutputInfo
p)
{-# LINE 334 "Graphics/X11/Xrandr.hsc" #-}
            IO
  (CULong
   -> CULong
   -> Word16
   -> Word16
   -> [Atom]
   -> [Atom]
   -> CInt
   -> [Atom]
   -> XRROutputInfo)
-> IO CULong
-> IO
     (CULong
      -> Word16
      -> Word16
      -> [Atom]
      -> [Atom]
      -> CInt
      -> [Atom]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
32) Ptr XRROutputInfo
p )
{-# LINE 335 "Graphics/X11/Xrandr.hsc" #-}
            IO
  (CULong
   -> Word16
   -> Word16
   -> [Atom]
   -> [Atom]
   -> CInt
   -> [Atom]
   -> XRROutputInfo)
-> IO CULong
-> IO
     (Word16
      -> Word16 -> [Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
40) Ptr XRROutputInfo
p )
{-# LINE 336 "Graphics/X11/Xrandr.hsc" #-}
            IO
  (Word16
   -> Word16 -> [Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
-> IO Word16
-> IO
     (Word16 -> [Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
48) Ptr XRROutputInfo
p )
{-# LINE 337 "Graphics/X11/Xrandr.hsc" #-}
            IO (Word16 -> [Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
-> IO Word16
-> IO ([Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
50) Ptr XRROutputInfo
p )
{-# LINE 338 "Graphics/X11/Xrandr.hsc" #-}
            IO ([Atom] -> [Atom] -> CInt -> [Atom] -> XRROutputInfo)
-> IO [Atom] -> IO ([Atom] -> CInt -> [Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
52) Ptr XRROutputInfo
p)
{-# LINE 339 "Graphics/X11/Xrandr.hsc" #-}
                              ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
56) Ptr XRROutputInfo
p)
{-# LINE 340 "Graphics/X11/Xrandr.hsc" #-}
            IO ([Atom] -> CInt -> [Atom] -> XRROutputInfo)
-> IO [Atom] -> IO (CInt -> [Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
64) Ptr XRROutputInfo
p)
{-# LINE 341 "Graphics/X11/Xrandr.hsc" #-}
                              ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
72) Ptr XRROutputInfo
p)
{-# LINE 342 "Graphics/X11/Xrandr.hsc" #-}
            IO (CInt -> [Atom] -> XRROutputInfo)
-> IO CInt -> IO ([Atom] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
84) Ptr XRROutputInfo
p )
{-# LINE 343 "Graphics/X11/Xrandr.hsc" #-}
            IO ([Atom] -> XRROutputInfo) -> IO [Atom] -> IO XRROutputInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
80) Ptr XRROutputInfo
p)
{-# LINE 344 "Graphics/X11/Xrandr.hsc" #-}
                              ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRROutputInfo
hsc_ptr Int
88) Ptr XRROutputInfo
p)
{-# LINE 345 "Graphics/X11/Xrandr.hsc" #-}


instance Storable XRRCrtcInfo where
    sizeOf :: XRRCrtcInfo -> Int
sizeOf XRRCrtcInfo
_ = (Int
64)
{-# LINE 349 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRCrtcInfo -> Int
alignment XRRCrtcInfo
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRCrtcInfo -> XRRCrtcInfo -> IO ()
poke Ptr XRRCrtcInfo
p XRRCrtcInfo
xrr_ci = do
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
0) Ptr XRRCrtcInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Atom
xrr_ci_timestamp XRRCrtcInfo
xrr_ci
{-# LINE 354 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
8) Ptr XRRCrtcInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> CInt
xrr_ci_x         XRRCrtcInfo
xrr_ci
{-# LINE 355 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
12) Ptr XRRCrtcInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> CInt
xrr_ci_y         XRRCrtcInfo
xrr_ci
{-# LINE 356 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
16) Ptr XRRCrtcInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> CUInt
xrr_ci_width     XRRCrtcInfo
xrr_ci
{-# LINE 357 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
20) Ptr XRRCrtcInfo
p (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> CUInt
xrr_ci_height    XRRCrtcInfo
xrr_ci
{-# LINE 358 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Atom -> IO ()
forall b. Ptr b -> Int -> Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
24) Ptr XRRCrtcInfo
p (Atom -> IO ()) -> Atom -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Atom
xrr_ci_mode      XRRCrtcInfo
xrr_ci
{-# LINE 359 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
32) Ptr XRRCrtcInfo
p (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Word16
xrr_ci_rotation  XRRCrtcInfo
xrr_ci
{-# LINE 360 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
48) Ptr XRRCrtcInfo
p (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Word16
xrr_ci_rotations XRRCrtcInfo
xrr_ci
{-# LINE 361 "Graphics/X11/Xrandr.hsc" #-}
        -- see comment in Storable XRRScreenResources about dynamic resource allocation
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
36) Ptr XRRCrtcInfo
p ( CInt
0 :: CInt )
{-# LINE 363 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
52) Ptr XRRCrtcInfo
p ( CInt
0 :: CInt )
{-# LINE 364 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
40) Ptr XRRCrtcInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 365 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Ptr Atom -> IO ()
forall b. Ptr b -> Int -> Ptr Atom -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
56) Ptr XRRCrtcInfo
p ( Ptr Atom
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 366 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRCrtcInfo -> IO XRRCrtcInfo
peek Ptr XRRCrtcInfo
p = (Atom
 -> CInt
 -> CInt
 -> CUInt
 -> CUInt
 -> Atom
 -> Word16
 -> [Atom]
 -> Word16
 -> [Atom]
 -> XRRCrtcInfo)
-> IO
     (Atom
      -> CInt
      -> CInt
      -> CUInt
      -> CUInt
      -> Atom
      -> Word16
      -> [Atom]
      -> Word16
      -> [Atom]
      -> XRRCrtcInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
-> CInt
-> CInt
-> CUInt
-> CUInt
-> Atom
-> Word16
-> [Atom]
-> Word16
-> [Atom]
-> XRRCrtcInfo
XRRCrtcInfo
        IO
  (Atom
   -> CInt
   -> CInt
   -> CUInt
   -> CUInt
   -> Atom
   -> Word16
   -> [Atom]
   -> Word16
   -> [Atom]
   -> XRRCrtcInfo)
-> IO Atom
-> IO
     (CInt
      -> CInt
      -> CUInt
      -> CUInt
      -> Atom
      -> Word16
      -> [Atom]
      -> Word16
      -> [Atom]
      -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
0) Ptr XRRCrtcInfo
p )
{-# LINE 369 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CInt
   -> CInt
   -> CUInt
   -> CUInt
   -> Atom
   -> Word16
   -> [Atom]
   -> Word16
   -> [Atom]
   -> XRRCrtcInfo)
-> IO CInt
-> IO
     (CInt
      -> CUInt
      -> CUInt
      -> Atom
      -> Word16
      -> [Atom]
      -> Word16
      -> [Atom]
      -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
8) Ptr XRRCrtcInfo
p )
{-# LINE 370 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CInt
   -> CUInt
   -> CUInt
   -> Atom
   -> Word16
   -> [Atom]
   -> Word16
   -> [Atom]
   -> XRRCrtcInfo)
-> IO CInt
-> IO
     (CUInt
      -> CUInt
      -> Atom
      -> Word16
      -> [Atom]
      -> Word16
      -> [Atom]
      -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
12) Ptr XRRCrtcInfo
p )
{-# LINE 371 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> CUInt
   -> Atom
   -> Word16
   -> [Atom]
   -> Word16
   -> [Atom]
   -> XRRCrtcInfo)
-> IO CUInt
-> IO
     (CUInt
      -> Atom -> Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
16) Ptr XRRCrtcInfo
p )
{-# LINE 372 "Graphics/X11/Xrandr.hsc" #-}
        IO
  (CUInt
   -> Atom -> Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
-> IO CUInt
-> IO (Atom -> Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
20) Ptr XRRCrtcInfo
p )
{-# LINE 373 "Graphics/X11/Xrandr.hsc" #-}
        IO (Atom -> Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
-> IO Atom
-> IO (Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Atom
forall b. Ptr b -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
24) Ptr XRRCrtcInfo
p )
{-# LINE 374 "Graphics/X11/Xrandr.hsc" #-}
        IO (Word16 -> [Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
-> IO Word16 -> IO ([Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
32) Ptr XRRCrtcInfo
p )
{-# LINE 375 "Graphics/X11/Xrandr.hsc" #-}
        IO ([Atom] -> Word16 -> [Atom] -> XRRCrtcInfo)
-> IO [Atom] -> IO (Word16 -> [Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
36) Ptr XRRCrtcInfo
p)
{-# LINE 376 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
40) Ptr XRRCrtcInfo
p)
{-# LINE 377 "Graphics/X11/Xrandr.hsc" #-}
        IO (Word16 -> [Atom] -> XRRCrtcInfo)
-> IO Word16 -> IO ([Atom] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
48) Ptr XRRCrtcInfo
p )
{-# LINE 378 "Graphics/X11/Xrandr.hsc" #-}
        IO ([Atom] -> XRRCrtcInfo) -> IO [Atom] -> IO XRRCrtcInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr Atom) -> IO [Atom]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
52) Ptr XRRCrtcInfo
p)
{-# LINE 379 "Graphics/X11/Xrandr.hsc" #-}
                          ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO (Ptr Atom)
forall b. Ptr b -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRCrtcInfo
hsc_ptr Int
56) Ptr XRRCrtcInfo
p)
{-# LINE 380 "Graphics/X11/Xrandr.hsc" #-}


instance Storable XRRPropertyInfo where
    sizeOf :: XRRPropertyInfo -> Int
sizeOf XRRPropertyInfo
_ = (Int
24)
{-# LINE 384 "Graphics/X11/Xrandr.hsc" #-}
    -- FIXME: Is this right?
    alignment :: XRRPropertyInfo -> Int
alignment XRRPropertyInfo
_ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)

    poke :: Ptr XRRPropertyInfo -> XRRPropertyInfo -> IO ()
poke Ptr XRRPropertyInfo
p XRRPropertyInfo
xrr_pi = do
        (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> Bool -> IO ()
forall b. Ptr b -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRPropertyInfo
hsc_ptr Int
0) Ptr XRRPropertyInfo
p (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRPropertyInfo -> Bool
xrr_pi_pending   XRRPropertyInfo
xrr_pi
{-# LINE 389 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> Bool -> IO ()
forall b. Ptr b -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRPropertyInfo
hsc_ptr Int
4) Ptr XRRPropertyInfo
p (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRPropertyInfo -> Bool
xrr_pi_range     XRRPropertyInfo
xrr_pi
{-# LINE 390 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> Bool -> IO ()
forall b. Ptr b -> Int -> Bool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRPropertyInfo
hsc_ptr Int
8) Ptr XRRPropertyInfo
p (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRPropertyInfo -> Bool
xrr_pi_immutable XRRPropertyInfo
xrr_pi
{-# LINE 391 "Graphics/X11/Xrandr.hsc" #-}
        -- see comment in Storable XRRScreenResources about dynamic resource allocation
        (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRPropertyInfo
hsc_ptr Int
12) Ptr XRRPropertyInfo
p ( CInt
0 :: CInt )
{-# LINE 393 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> Ptr CLong -> IO ()
forall b. Ptr b -> Int -> Ptr CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRPropertyInfo
hsc_ptr Int
16) Ptr XRRPropertyInfo
p ( Ptr CLong
forall a. Ptr a
nullPtr :: Ptr CLong )
{-# LINE 394 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRPropertyInfo -> IO XRRPropertyInfo
peek Ptr XRRPropertyInfo
p = (Bool -> Bool -> Bool -> [CLong] -> XRRPropertyInfo)
-> IO (Bool -> Bool -> Bool -> [CLong] -> XRRPropertyInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool -> Bool -> Bool -> [CLong] -> XRRPropertyInfo
XRRPropertyInfo
        IO (Bool -> Bool -> Bool -> [CLong] -> XRRPropertyInfo)
-> IO Bool -> IO (Bool -> Bool -> [CLong] -> XRRPropertyInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRPropertyInfo
hsc_ptr Int
0) Ptr XRRPropertyInfo
p )
{-# LINE 397 "Graphics/X11/Xrandr.hsc" #-}
        IO (Bool -> Bool -> [CLong] -> XRRPropertyInfo)
-> IO Bool -> IO (Bool -> [CLong] -> XRRPropertyInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRPropertyInfo
hsc_ptr Int
4) Ptr XRRPropertyInfo
p )
{-# LINE 398 "Graphics/X11/Xrandr.hsc" #-}
        IO (Bool -> [CLong] -> XRRPropertyInfo)
-> IO Bool -> IO ([CLong] -> XRRPropertyInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRPropertyInfo
hsc_ptr Int
8) Ptr XRRPropertyInfo
p )
{-# LINE 399 "Graphics/X11/Xrandr.hsc" #-}
        IO ([CLong] -> XRRPropertyInfo) -> IO [CLong] -> IO XRRPropertyInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr CLong) -> IO [CLong]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ( (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRPropertyInfo
hsc_ptr Int
12) Ptr XRRPropertyInfo
p)
{-# LINE 400 "Graphics/X11/Xrandr.hsc" #-}
                          ( (\Ptr XRRPropertyInfo
hsc_ptr -> Ptr XRRPropertyInfo -> Int -> IO (Ptr CLong)
forall b. Ptr b -> Int -> IO (Ptr CLong)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XRRPropertyInfo
hsc_ptr Int
16) Ptr XRRPropertyInfo
p)
{-# LINE 401 "Graphics/X11/Xrandr.hsc" #-}


xrrQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xrrQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xrrQueryExtension Display
dpy = (Ptr CInt -> Ptr CInt -> IO Bool)
-> (Bool -> CInt -> CInt -> Maybe (CInt, CInt))
-> IO (Maybe (CInt, CInt))
forall a b c d.
(Storable a, Storable b) =>
(Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 (Display -> Ptr CInt -> Ptr CInt -> IO Bool
cXRRQueryExtension Display
dpy) Bool -> CInt -> CInt -> Maybe (CInt, CInt)
forall {a} {a} {a} {b}.
(Integral a, Integral a, Num a, Num b) =>
Bool -> a -> a -> Maybe (a, b)
go
  where go :: Bool -> a -> a -> Maybe (a, b)
go Bool
False a
_ a
_                = Maybe (a, b)
forall a. Maybe a
Nothing
        go Bool
True a
eventbase a
errorbase = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
eventbase, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
errorbase)
foreign import ccall "XRRQueryExtension"
  cXRRQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool

xrrQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xrrQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xrrQueryVersion Display
dpy = (Ptr CInt -> Ptr CInt -> IO Bool)
-> (Bool -> CInt -> CInt -> Maybe (CInt, CInt))
-> IO (Maybe (CInt, CInt))
forall a b c d.
(Storable a, Storable b) =>
(Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 (Display -> Ptr CInt -> Ptr CInt -> IO Bool
cXRRQueryVersion Display
dpy) Bool -> CInt -> CInt -> Maybe (CInt, CInt)
forall {a} {a} {a} {b}.
(Integral a, Integral a, Num a, Num b) =>
Bool -> a -> a -> Maybe (a, b)
go
  where go :: Bool -> a -> a -> Maybe (a, b)
go Bool
False a
_ a
_        = Maybe (a, b)
forall a. Maybe a
Nothing
        go Bool
True a
major a
minor = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
major, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
minor)
foreign import ccall "XRRQueryVersion"
  cXRRQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool

xrrGetScreenInfo :: Display -> Drawable -> IO (Maybe XRRScreenConfiguration)
xrrGetScreenInfo :: Display -> Atom -> IO (Maybe XRRScreenConfiguration)
xrrGetScreenInfo Display
dpy Atom
draw = do
  p <- Display -> Atom -> IO (Ptr XRRScreenConfiguration)
cXRRGetScreenInfo Display
dpy Atom
draw
  if p == nullPtr
     then return Nothing
     else return (Just (XRRScreenConfiguration p))
foreign import ccall "XRRGetScreenInfo"
  cXRRGetScreenInfo :: Display -> Drawable -> IO (Ptr XRRScreenConfiguration)

xrrFreeScreenConfigInfo :: XRRScreenConfiguration -> IO ()
xrrFreeScreenConfigInfo :: XRRScreenConfiguration -> IO ()
xrrFreeScreenConfigInfo = XRRScreenConfiguration -> IO ()
cXRRFreeScreenConfigInfo
foreign import ccall "XRRFreeScreenConfigInfo"
  cXRRFreeScreenConfigInfo :: XRRScreenConfiguration -> IO ()

xrrSetScreenConfig :: Display -> XRRScreenConfiguration -> Drawable -> CInt -> Rotation -> Time -> IO Status
xrrSetScreenConfig :: Display
-> XRRScreenConfiguration
-> Atom
-> CInt
-> Word16
-> Atom
-> IO CInt
xrrSetScreenConfig = Display
-> XRRScreenConfiguration
-> Atom
-> CInt
-> Word16
-> Atom
-> IO CInt
cXRRSetScreenConfig
foreign import ccall "XRRSetScreenConfig"
  cXRRSetScreenConfig :: Display -> XRRScreenConfiguration -> Drawable -> CInt -> Rotation -> Time -> IO Status

xrrSetScreenConfigAndRate :: Display -> XRRScreenConfiguration -> Drawable -> CInt -> Rotation -> CShort -> Time -> IO Status
xrrSetScreenConfigAndRate :: Display
-> XRRScreenConfiguration
-> Atom
-> CInt
-> Word16
-> CShort
-> Atom
-> IO CInt
xrrSetScreenConfigAndRate = Display
-> XRRScreenConfiguration
-> Atom
-> CInt
-> Word16
-> CShort
-> Atom
-> IO CInt
cXRRSetScreenConfigAndRate
foreign import ccall "XRRSetScreenConfigAndRate"
  cXRRSetScreenConfigAndRate :: Display -> XRRScreenConfiguration -> Drawable -> CInt -> Rotation -> CShort -> Time -> IO Status

xrrConfigRotations :: XRRScreenConfiguration -> IO (Rotation, Rotation)
xrrConfigRotations :: XRRScreenConfiguration -> IO (Word16, Word16)
xrrConfigRotations XRRScreenConfiguration
config =
  (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Word16, Word16)) -> IO (Word16, Word16))
-> (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do rptr <- Pool -> IO (Ptr Word16)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         rotations <- cXRRConfigRotations config rptr
                         cur_rotation <- peek rptr
                         return (rotations, cur_rotation)
foreign import ccall "XRRConfigRotations"
  cXRRConfigRotations :: XRRScreenConfiguration -> Ptr Rotation -> IO Rotation

xrrConfigTimes :: XRRScreenConfiguration -> IO (Time, Time)
xrrConfigTimes :: XRRScreenConfiguration -> IO (Atom, Atom)
xrrConfigTimes XRRScreenConfiguration
config =
  (Pool -> IO (Atom, Atom)) -> IO (Atom, Atom)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Atom, Atom)) -> IO (Atom, Atom))
-> (Pool -> IO (Atom, Atom)) -> IO (Atom, Atom)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do tptr <- Pool -> IO (Ptr Atom)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         time <- cXRRConfigTimes config tptr
                         cur_time <- peek tptr
                         return (time, cur_time)
foreign import ccall "XRRConfigTimes"
  cXRRConfigTimes :: XRRScreenConfiguration -> Ptr Time -> IO Time

xrrConfigSizes :: XRRScreenConfiguration -> IO (Maybe [XRRScreenSize])
xrrConfigSizes :: XRRScreenConfiguration -> IO (Maybe [XRRScreenSize])
xrrConfigSizes XRRScreenConfiguration
config =
  (Pool -> IO (Maybe [XRRScreenSize])) -> IO (Maybe [XRRScreenSize])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [XRRScreenSize]))
 -> IO (Maybe [XRRScreenSize]))
-> (Pool -> IO (Maybe [XRRScreenSize]))
-> IO (Maybe [XRRScreenSize])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         p <- cXRRConfigSizes config intp
                         if p == nullPtr
                            then return Nothing
                            else do nsizes <- peek intp
                                    sizes <- if nsizes == 0
                                                then return Nothing
                                                else peekArray (fromIntegral nsizes) p >>= return . Just
                                    return sizes
foreign import ccall "XRRConfigSizes"
  cXRRConfigSizes :: XRRScreenConfiguration -> Ptr CInt -> IO (Ptr XRRScreenSize)

xrrConfigRates :: XRRScreenConfiguration -> CInt -> IO (Maybe [CShort])
xrrConfigRates :: XRRScreenConfiguration -> CInt -> IO (Maybe [CShort])
xrrConfigRates XRRScreenConfiguration
config CInt
size_index =
  (Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort]))
-> (Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         p <- cXRRConfigRates config size_index intp
                         if p == nullPtr
                            then return Nothing
                            else do nrates <- peek intp
                                    rates <- if nrates == 0
                                                then return Nothing
                                                else peekArray (fromIntegral nrates) p >>= return . Just
                                    return rates
foreign import ccall "XRRConfigRates"
  cXRRConfigRates :: XRRScreenConfiguration -> CInt -> Ptr CInt -> IO (Ptr CShort)

xrrConfigCurrentConfiguration :: XRRScreenConfiguration -> IO (Rotation, SizeID)
xrrConfigCurrentConfiguration :: XRRScreenConfiguration -> IO (Word16, Word16)
xrrConfigCurrentConfiguration XRRScreenConfiguration
config =
  (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Word16, Word16)) -> IO (Word16, Word16))
-> (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do rptr <- Pool -> IO (Ptr Word16)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         sizeid <- cXRRConfigCurrentConfiguration config rptr
                         rotation <- peek rptr
                         return (rotation, sizeid)
foreign import ccall "XRRConfigCurrentConfiguration"
  cXRRConfigCurrentConfiguration :: XRRScreenConfiguration -> Ptr Rotation -> IO SizeID

xrrConfigCurrentRate :: XRRScreenConfiguration -> IO CShort
xrrConfigCurrentRate :: XRRScreenConfiguration -> IO CShort
xrrConfigCurrentRate = XRRScreenConfiguration -> IO CShort
cXRRConfigCurrentRate
foreign import ccall "XRRConfigCurrentRate"
  cXRRConfigCurrentRate :: XRRScreenConfiguration -> IO CShort

xrrRootToScreen :: Display -> Window -> IO CInt
xrrRootToScreen :: Display -> Atom -> IO CInt
xrrRootToScreen = Display -> Atom -> IO CInt
cXRRRootToScreen
foreign import ccall "XRRRootToScreen"
  cXRRRootToScreen :: Display -> Window -> IO CInt

xrrSelectInput :: Display -> Window -> EventMask -> IO ()
xrrSelectInput :: Display -> Atom -> Atom -> IO ()
xrrSelectInput Display
dpy Atom
window Atom
mask = Display -> Atom -> CInt -> IO ()
cXRRSelectInput Display
dpy Atom
window (Atom -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
mask)
foreign import ccall "XRRSelectInput"
  cXRRSelectInput :: Display -> Window -> CInt -> IO ()

xrrUpdateConfiguration :: XEventPtr -> IO CInt
xrrUpdateConfiguration :: XEventPtr -> IO CInt
xrrUpdateConfiguration = XEventPtr -> IO CInt
cXRRUpdateConfiguration
foreign import ccall "XRRUpdateConfiguration"
  cXRRUpdateConfiguration :: XEventPtr -> IO CInt

xrrRotations :: Display -> CInt -> IO (Rotation, Rotation)
xrrRotations :: Display -> CInt -> IO (Word16, Word16)
xrrRotations Display
dpy CInt
screen =
  (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Word16, Word16)) -> IO (Word16, Word16))
-> (Pool -> IO (Word16, Word16)) -> IO (Word16, Word16)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do rptr <- Pool -> IO (Ptr Word16)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         rotations <- cXRRRotations dpy screen rptr
                         cur_rotation <- peek rptr
                         return (rotations, cur_rotation)
foreign import ccall "XRRRotations"
  cXRRRotations :: Display -> CInt -> Ptr Rotation -> IO Rotation

xrrSizes :: Display -> CInt -> IO (Maybe [XRRScreenSize])
xrrSizes :: Display -> CInt -> IO (Maybe [XRRScreenSize])
xrrSizes Display
dpy CInt
screen =
  (Pool -> IO (Maybe [XRRScreenSize])) -> IO (Maybe [XRRScreenSize])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [XRRScreenSize]))
 -> IO (Maybe [XRRScreenSize]))
-> (Pool -> IO (Maybe [XRRScreenSize]))
-> IO (Maybe [XRRScreenSize])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         p <- cXRRSizes dpy screen intp
                         if p == nullPtr
                            then return Nothing
                            else do nsizes <- peek intp
                                    sizes <- if nsizes == 0
                                                then return Nothing
                                                else peekArray (fromIntegral nsizes) p >>= return . Just
                                    return sizes
foreign import ccall "XRRSizes"
  cXRRSizes :: Display -> CInt -> Ptr CInt -> IO (Ptr XRRScreenSize)

xrrRates :: Display -> CInt -> CInt -> IO (Maybe [CShort])
xrrRates :: Display -> CInt -> CInt -> IO (Maybe [CShort])
xrrRates Display
dpy CInt
screen CInt
size_index =
  (Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort]))
-> (Pool -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         p <- cXRRRates dpy screen size_index intp
                         if p == nullPtr
                            then return Nothing
                            else do nrates <- peek intp
                                    rates <- if nrates == 0
                                                then return Nothing
                                                else peekArray (fromIntegral nrates) p >>= return . Just
                                    return rates
foreign import ccall "XRRRates"
  cXRRRates :: Display -> CInt -> CInt -> Ptr CInt -> IO (Ptr CShort)

xrrTimes :: Display -> CInt -> IO (Time, Time)
xrrTimes :: Display -> CInt -> IO (Atom, Atom)
xrrTimes Display
dpy CInt
screen =
  (Pool -> IO (Atom, Atom)) -> IO (Atom, Atom)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Atom, Atom)) -> IO (Atom, Atom))
-> (Pool -> IO (Atom, Atom)) -> IO (Atom, Atom)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do tptr <- Pool -> IO (Ptr Atom)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         time <- cXRRTimes dpy screen tptr
                         config_time <- peek tptr
                         return (time, config_time)
foreign import ccall "XRRTimes"
  cXRRTimes :: Display -> CInt -> Ptr Time -> IO Time

xrrGetScreenResources :: Display -> Window -> IO (Maybe XRRScreenResources)
xrrGetScreenResources :: Display -> Atom -> IO (Maybe XRRScreenResources)
xrrGetScreenResources Display
dpy Atom
win = do
    srp <- Display -> Atom -> IO (Ptr XRRScreenResources)
cXRRGetScreenResources Display
dpy Atom
win
    if srp == nullPtr
        then return Nothing
        else do
            res <- peek srp
            cXRRFreeScreenResources srp
            return $ Just res

foreign import ccall "XRRGetScreenResources"
    cXRRGetScreenResources :: Display -> Window -> IO (Ptr XRRScreenResources)

foreign import ccall "XRRFreeScreenResources"
    cXRRFreeScreenResources :: Ptr XRRScreenResources -> IO ()

xrrGetOutputInfo :: Display -> XRRScreenResources -> RROutput -> IO (Maybe XRROutputInfo)
xrrGetOutputInfo :: Display -> XRRScreenResources -> Atom -> IO (Maybe XRROutputInfo)
xrrGetOutputInfo Display
dpy XRRScreenResources
xrr_sr Atom
rro = (Pool -> IO (Maybe XRROutputInfo)) -> IO (Maybe XRROutputInfo)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe XRROutputInfo)) -> IO (Maybe XRROutputInfo))
-> (Pool -> IO (Maybe XRROutputInfo)) -> IO (Maybe XRROutputInfo)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    -- XRRGetOutputInfo only uses the timestamp field from the
    -- XRRScreenResources struct, so it's probably ok to pass the incomplete
    -- structure here (see also the poke implementation for the Storable
    -- instance of XRRScreenResources)
    -- Alternative version below; This is extremely slow, though!
    {- xrrGetOutputInfo :: Display -> Window -> RROutput -> IO (Maybe XRROutputInfo)
       xrrGetOutputInfo dpy win rro = do
           srp <- cXRRGetScreenResources dpy win
           oip <- cXRRGetOutputInfo dpy srp rro
           cXRRFreeScreenResources srp
    -}
    oip <- Pool -> IO (Ptr XRRScreenResources)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool IO (Ptr XRRScreenResources)
-> (Ptr XRRScreenResources -> IO (Ptr XRROutputInfo))
-> IO (Ptr XRROutputInfo)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr XRRScreenResources
srp -> do
        Ptr XRRScreenResources -> XRRScreenResources -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr XRRScreenResources
srp XRRScreenResources
xrr_sr
        Display -> Ptr XRRScreenResources -> Atom -> IO (Ptr XRROutputInfo)
cXRRGetOutputInfo Display
dpy Ptr XRRScreenResources
srp Atom
rro -- no need to free srp, because pool mem

    if oip == nullPtr
        then return Nothing
        else do
            oi <- peek oip
            _ <- cXRRFreeOutputInfo oip
            return $ Just oi

foreign import ccall "XRRGetOutputInfo"
    cXRRGetOutputInfo :: Display -> Ptr XRRScreenResources -> RROutput -> IO (Ptr XRROutputInfo)

foreign import ccall "XRRFreeOutputInfo"
    cXRRFreeOutputInfo :: Ptr XRROutputInfo -> IO ()

xrrGetCrtcInfo :: Display -> XRRScreenResources -> RRCrtc -> IO (Maybe XRRCrtcInfo)
xrrGetCrtcInfo :: Display -> XRRScreenResources -> Atom -> IO (Maybe XRRCrtcInfo)
xrrGetCrtcInfo Display
dpy XRRScreenResources
xrr_sr Atom
crtc = (Pool -> IO (Maybe XRRCrtcInfo)) -> IO (Maybe XRRCrtcInfo)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe XRRCrtcInfo)) -> IO (Maybe XRRCrtcInfo))
-> (Pool -> IO (Maybe XRRCrtcInfo)) -> IO (Maybe XRRCrtcInfo)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    -- XRRGetCrtcInfo only uses the timestamp field from the
    -- XRRScreenResources struct, so it's probably ok to pass the incomplete
    -- structure here (see also the poke implementation for the Storable
    -- instance of XRRScreenResources)
    cip <- Pool -> IO (Ptr XRRScreenResources)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool IO (Ptr XRRScreenResources)
-> (Ptr XRRScreenResources -> IO (Ptr XRRCrtcInfo))
-> IO (Ptr XRRCrtcInfo)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr XRRScreenResources
srp -> do
        Ptr XRRScreenResources -> XRRScreenResources -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr XRRScreenResources
srp XRRScreenResources
xrr_sr
        Display -> Ptr XRRScreenResources -> Atom -> IO (Ptr XRRCrtcInfo)
cXRRGetCrtcInfo Display
dpy Ptr XRRScreenResources
srp Atom
crtc -- no need to free srp, because pool mem

    if cip == nullPtr
        then return Nothing
        else do
            ci <- peek cip
            cXRRFreeCrtcInfo cip
            return $ Just ci

foreign import ccall "XRRGetCrtcInfo"
    cXRRGetCrtcInfo :: Display -> Ptr XRRScreenResources -> RRCrtc -> IO (Ptr XRRCrtcInfo)

foreign import ccall "XRRFreeCrtcInfo"
    cXRRFreeCrtcInfo :: Ptr XRRCrtcInfo -> IO ()

foreign import ccall "XRRSetOutputPrimary"
    xrrSetOutputPrimary :: Display -> Window -> RROutput -> IO ()

foreign import ccall "XRRGetOutputPrimary"
    xrrGetOutputPrimary :: Display -> Window -> IO RROutput

xrrGetScreenResourcesCurrent :: Display -> Window -> IO (Maybe XRRScreenResources)
xrrGetScreenResourcesCurrent :: Display -> Atom -> IO (Maybe XRRScreenResources)
xrrGetScreenResourcesCurrent Display
dpy Atom
win = do
    srcp <- Display -> Atom -> IO (Ptr XRRScreenResources)
cXRRGetScreenResourcesCurrent Display
dpy Atom
win
    if srcp == nullPtr
        then return Nothing
        else do
            res <- peek srcp
            cXRRFreeScreenResources srcp
            return $ Just res

foreign import ccall "XRRGetScreenResourcesCurrent"
    cXRRGetScreenResourcesCurrent :: Display -> Window -> IO (Ptr XRRScreenResources)

xrrListOutputProperties :: Display -> RROutput -> IO (Maybe [Atom])
xrrListOutputProperties :: Display -> Atom -> IO (Maybe [Atom])
xrrListOutputProperties Display
dpy Atom
rro = (Pool -> IO (Maybe [Atom])) -> IO (Maybe [Atom])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [Atom])) -> IO (Maybe [Atom]))
-> (Pool -> IO (Maybe [Atom])) -> IO (Maybe [Atom])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    p <- cXRRListOutputProperties dpy rro intp
    if p == nullPtr
        then return Nothing
        else do
            nprop <- peek intp
            res <- fmap Just $ peekCArray nprop p
            _ <- xFree p
            return res

foreign import ccall "XRRListOutputProperties"
    cXRRListOutputProperties :: Display -> RROutput -> Ptr CInt -> IO (Ptr Atom)

xrrQueryOutputProperty :: Display -> RROutput -> Atom -> IO (Maybe XRRPropertyInfo)
xrrQueryOutputProperty :: Display -> Atom -> Atom -> IO (Maybe XRRPropertyInfo)
xrrQueryOutputProperty Display
dpy Atom
rro Atom
prop = do
    p <- Display -> Atom -> Atom -> IO (Ptr XRRPropertyInfo)
cXRRQueryOutputProperty Display
dpy Atom
rro Atom
prop
    if p == nullPtr
        then return Nothing
        else do
            res <- peek p
            _ <- xFree p
            return $ Just res

foreign import ccall "XRRQueryOutputProperty"
    cXRRQueryOutputProperty :: Display -> RROutput -> Atom -> IO (Ptr XRRPropertyInfo)

xrrConfigureOutputProperty :: Display -> RROutput -> Atom -> Bool -> Bool -> [CLong] -> IO ()
xrrConfigureOutputProperty :: Display -> Atom -> Atom -> Bool -> Bool -> [CLong] -> IO ()
xrrConfigureOutputProperty Display
dpy Atom
rro Atom
prop Bool
pend Bool
range [CLong]
xs = [CLong] -> (Int -> Ptr CLong -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [CLong]
xs ((Int -> Ptr CLong -> IO ()) -> IO ())
-> (Int -> Ptr CLong -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    Display
-> Atom -> Atom -> Bool -> Bool -> CInt -> Ptr CLong -> IO ()
cXRRConfigureOutputProperty Display
dpy Atom
rro Atom
prop Bool
pend Bool
range (CInt -> Ptr CLong -> IO ())
-> (Int -> CInt) -> Int -> Ptr CLong -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

foreign import ccall "XRRConfigureOutputProperty"
    cXRRConfigureOutputProperty :: Display -> RROutput -> Atom -> Bool -> Bool -> CInt ->  Ptr CLong -> IO ()

xrrChangeOutputProperty :: Display -> RROutput -> Atom -> Atom -> CInt -> CInt -> [Word32] -> IO ()
xrrChangeOutputProperty :: Display
-> Atom -> Atom -> Atom -> CInt -> CInt -> [Word32] -> IO ()
xrrChangeOutputProperty Display
dpy Atom
rro Atom
prop Atom
typ CInt
format CInt
mode [Word32]
xs = (Pool -> IO ()) -> IO ()
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO ()) -> IO ()) -> (Pool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    ptr <- case CInt
format of
        CInt
8 ->  Pool -> [Word8] -> IO (Ptr Word8)
forall a. Storable a => Pool -> [a] -> IO (Ptr a)
pooledNewArray Pool
pool ((Word32 -> Word8) -> [Word32] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word32]
xs :: [Word8])
        CInt
16 -> Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word16 -> Ptr Word8) -> IO (Ptr Word16) -> IO (Ptr Word8)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pool -> [Word16] -> IO (Ptr Word16)
forall a. Storable a => Pool -> [a] -> IO (Ptr a)
pooledNewArray Pool
pool ((Word32 -> Word16) -> [Word32] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word32]
xs :: [Word16])
        CInt
32 -> Ptr Word32 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word32 -> Ptr Word8) -> IO (Ptr Word32) -> IO (Ptr Word8)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pool -> [Word32] -> IO (Ptr Word32)
forall a. Storable a => Pool -> [a] -> IO (Ptr a)
pooledNewArray Pool
pool [Word32]
xs
        CInt
_  -> String -> IO (Ptr Word8)
forall a. HasCallStack => String -> a
error String
"invalid format"

    cXRRChangeOutputProperty dpy rro prop typ format mode ptr (fromIntegral $ length xs)

foreign import ccall "XRRChangeOutputProperty"
    cXRRChangeOutputProperty :: Display -> RROutput -> Atom -> Atom -> CInt -> CInt -> Ptr Word8 -> CInt -> IO ()

-- | @xrrGetOutputProperty display output property offset length delete pending propertyType@
-- | returns @Maybe (actualType, format, bytesAfter, data)@.
xrrGetOutputProperty ::
    Display -> RROutput -> Atom -> CLong -> CLong -> Bool -> Bool -> Atom ->
    IO (Maybe (Atom, Int, CULong, [Word32]))
xrrGetOutputProperty :: Display
-> Atom
-> Atom
-> CLong
-> CLong
-> Bool
-> Bool
-> Atom
-> IO (Maybe (Atom, Int, CULong, [Word32]))
xrrGetOutputProperty Display
dpy Atom
rro Atom
prop CLong
offset CLong
len Bool
delete Bool
preferPending Atom
reqType = (Pool -> IO (Maybe (Atom, Int, CULong, [Word32])))
-> IO (Maybe (Atom, Int, CULong, [Word32]))
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe (Atom, Int, CULong, [Word32])))
 -> IO (Maybe (Atom, Int, CULong, [Word32])))
-> (Pool -> IO (Maybe (Atom, Int, CULong, [Word32])))
-> IO (Maybe (Atom, Int, CULong, [Word32]))
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    actualTypep <- Pool -> IO (Ptr Atom)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    actualFormatp <- pooledMalloc pool
    nItemsp <- pooledMalloc pool
    bytesAfterp <- pooledMalloc pool
    datapp <- pooledMalloc pool
    status <- cXRRGetOutputProperty dpy rro prop offset len
        delete preferPending reqType
        actualTypep actualFormatp nItemsp bytesAfterp datapp

    if status /= 0
        then return Nothing
        else do
          format <- fmap fromIntegral (peek actualFormatp)
          nitems <- fmap fromIntegral (peek nItemsp)
          ptr <- peek datapp

          dat <- case format of
            Int
0 -> [Word32] -> IO [Word32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Int
8 -> ([Word8] -> [Word32]) -> IO [Word8] -> IO [Word32]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO [Word8] -> IO [Word32]) -> IO [Word8] -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nitems Ptr Word8
ptr
            Int
16 -> ([Word16] -> [Word32]) -> IO [Word16] -> IO [Word32]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word16 -> Word32) -> [Word16] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO [Word16] -> IO [Word32]) -> IO [Word16] -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nitems (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr :: Ptr Word16)
            Int
32 -> Int -> Ptr Word32 -> IO [Word32]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nitems (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr :: Ptr Word32)
            Int
_  -> String -> IO [Word32]
forall a. HasCallStack => String -> a
error (String -> IO [Word32]) -> String -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ String
"impossible happened: prop format is not in 0,8,16,32 (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
format String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

          _ <- if format /= 0
                  then xFree ptr
                  else return 0

          typ <- peek actualTypep
          bytesAfter <- peek bytesAfterp
          return $ Just (typ, format, bytesAfter, dat)

foreign import ccall "XRRGetOutputProperty"
    cXRRGetOutputProperty :: Display -> RROutput -> Atom -> CLong -> CLong -> Bool -> Bool
      -> Atom -> Ptr Atom -> Ptr CInt -> Ptr CULong -> Ptr CULong -> Ptr (Ptr Word8) -> IO CInt

xrrDeleteOutputProperty :: Display -> RROutput -> Atom -> IO ()
xrrDeleteOutputProperty :: Display -> Atom -> Atom -> IO ()
xrrDeleteOutputProperty = Display -> Atom -> Atom -> IO ()
cXRRDeleteOutputProperty
foreign import ccall "XRRDeleteOutputProperty"
    cXRRDeleteOutputProperty :: Display -> RROutput -> Atom -> IO ()

xrrGetMonitors :: Display -> Drawable -> Bool -> IO (Maybe [XRRMonitorInfo])
xrrGetMonitors :: Display -> Atom -> Bool -> IO (Maybe [XRRMonitorInfo])
xrrGetMonitors Display
dpy Atom
draw Bool
get_active = (Pool -> IO (Maybe [XRRMonitorInfo]))
-> IO (Maybe [XRRMonitorInfo])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [XRRMonitorInfo]))
 -> IO (Maybe [XRRMonitorInfo]))
-> (Pool -> IO (Maybe [XRRMonitorInfo]))
-> IO (Maybe [XRRMonitorInfo])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    p <- cXRRGetMonitors dpy draw get_active intp
    if p == nullPtr
        then return Nothing
        else do
            nmonitors <- peek intp
            res <- fmap Just $ peekCArray nmonitors p
            cXRRFreeMonitors p
            return res

foreign import ccall "XRRGetMonitors"
    cXRRGetMonitors :: Display -> Drawable -> Bool -> Ptr CInt -> IO (Ptr XRRMonitorInfo)

foreign import ccall "XRRFreeMonitors"
    cXRRFreeMonitors :: Ptr XRRMonitorInfo -> IO ()

wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 :: forall a b c d.
(Storable a, Storable b) =>
(Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 Ptr a -> Ptr b -> IO c
cfun c -> a -> b -> d
f =
  (Pool -> IO d) -> IO d
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO d) -> IO d) -> (Pool -> IO d) -> IO d
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do aptr <- Pool -> IO (Ptr a)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         bptr <- pooledMalloc pool
                         ret <- cfun aptr bptr
                         a <- peek aptr
                         b <- peek bptr
                         return (f ret a b)

peekCArray :: Storable a => CInt -> Ptr a -> IO [a]
peekCArray :: forall a. Storable a => CInt -> Ptr a -> IO [a]
peekCArray CInt
n = Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)

peekCArrayIO :: Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO :: forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO IO CInt
n = IO (IO [a]) -> IO [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO [a]) -> IO [a])
-> (IO (Ptr a) -> IO (IO [a])) -> IO (Ptr a) -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt -> Ptr a -> IO [a]) -> IO CInt -> IO (Ptr a) -> IO (IO [a])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 CInt -> Ptr a -> IO [a]
forall a. Storable a => CInt -> Ptr a -> IO [a]
peekCArray IO CInt
n

peekCStringLenIO :: IO CInt -> IO (Ptr CChar) -> IO String
peekCStringLenIO :: IO CInt -> IO (Ptr CChar) -> IO String
peekCStringLenIO IO CInt
n IO (Ptr CChar)
p = (Ptr CChar -> Int -> (Ptr CChar, Int))
-> IO (Ptr CChar) -> IO Int -> IO (Ptr CChar, Int)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) IO (Ptr CChar)
p ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral IO CInt
n) IO (Ptr CChar, Int) -> ((Ptr CChar, Int) -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar, Int) -> IO String
peekCStringLen