{-# 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
showList :: [XRRScreenSize] -> ShowS
$cshowList :: [XRRScreenSize] -> ShowS
show :: XRRScreenSize -> String
$cshow :: XRRScreenSize -> String
showsPrec :: Int -> XRRScreenSize -> ShowS
$cshowsPrec :: Int -> XRRScreenSize -> ShowS
Show)

-- | Representation of the XRRModeInfo struct
data XRRModeInfo = XRRModeInfo
    { XRRModeInfo -> RRMode
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 -> RRMode
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
/= :: XRRModeInfo -> XRRModeInfo -> Bool
$c/= :: XRRModeInfo -> XRRModeInfo -> Bool
== :: XRRModeInfo -> XRRModeInfo -> Bool
$c== :: 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
showList :: [XRRModeInfo] -> ShowS
$cshowList :: [XRRModeInfo] -> ShowS
show :: XRRModeInfo -> String
$cshow :: XRRModeInfo -> String
showsPrec :: Int -> XRRModeInfo -> ShowS
$cshowsPrec :: Int -> XRRModeInfo -> ShowS
Show)

-- | Representation of the XRRScreenResources struct
data XRRScreenResources = XRRScreenResources
    { XRRScreenResources -> RRMode
xrr_sr_timestamp       :: !Time
    , XRRScreenResources -> RRMode
xrr_sr_configTimestamp :: !Time
    , XRRScreenResources -> [RRMode]
xrr_sr_crtcs           :: [RRCrtc]
    , XRRScreenResources -> [RRMode]
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
/= :: XRRScreenResources -> XRRScreenResources -> Bool
$c/= :: XRRScreenResources -> XRRScreenResources -> Bool
== :: XRRScreenResources -> XRRScreenResources -> Bool
$c== :: 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
showList :: [XRRScreenResources] -> ShowS
$cshowList :: [XRRScreenResources] -> ShowS
show :: XRRScreenResources -> String
$cshow :: XRRScreenResources -> String
showsPrec :: Int -> XRRScreenResources -> ShowS
$cshowsPrec :: Int -> XRRScreenResources -> ShowS
Show)

-- | Representation of the XRROutputInfo struct
data XRROutputInfo = XRROutputInfo
    { XRROutputInfo -> RRMode
xrr_oi_timestamp      :: !Time
    , XRROutputInfo -> RRMode
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 -> Connection
xrr_oi_connection     :: !Connection
    , XRROutputInfo -> Connection
xrr_oi_subpixel_order :: !SubpixelOrder
    , XRROutputInfo -> [RRMode]
xrr_oi_crtcs          :: [RRCrtc]
    , XRROutputInfo -> [RRMode]
xrr_oi_clones         :: [RROutput]
    , XRROutputInfo -> CInt
xrr_oi_npreferred     :: !CInt
    , XRROutputInfo -> [RRMode]
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
/= :: XRROutputInfo -> XRROutputInfo -> Bool
$c/= :: XRROutputInfo -> XRROutputInfo -> Bool
== :: XRROutputInfo -> XRROutputInfo -> Bool
$c== :: 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
showList :: [XRROutputInfo] -> ShowS
$cshowList :: [XRROutputInfo] -> ShowS
show :: XRROutputInfo -> String
$cshow :: XRROutputInfo -> String
showsPrec :: Int -> XRROutputInfo -> ShowS
$cshowsPrec :: Int -> XRROutputInfo -> ShowS
Show)

-- | Representation of the XRRCrtcInfo struct
data XRRCrtcInfo = XRRCrtcInfo
    { XRRCrtcInfo -> RRMode
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 -> RRMode
xrr_ci_mode         :: !RRMode
    , XRRCrtcInfo -> Connection
xrr_ci_rotation     :: !Rotation
    , XRRCrtcInfo -> [RRMode]
xrr_ci_outputs      :: [RROutput]
    , XRRCrtcInfo -> Connection
xrr_ci_rotations    :: !Rotation
    , XRRCrtcInfo -> [RRMode]
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
/= :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
$c/= :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
== :: XRRCrtcInfo -> XRRCrtcInfo -> Bool
$c== :: 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
showList :: [XRRCrtcInfo] -> ShowS
$cshowList :: [XRRCrtcInfo] -> ShowS
show :: XRRCrtcInfo -> String
$cshow :: XRRCrtcInfo -> String
showsPrec :: Int -> XRRCrtcInfo -> ShowS
$cshowsPrec :: Int -> 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
/= :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
$c/= :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
== :: XRRPropertyInfo -> XRRPropertyInfo -> Bool
$c== :: 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
showList :: [XRRPropertyInfo] -> ShowS
$cshowList :: [XRRPropertyInfo] -> ShowS
show :: XRRPropertyInfo -> String
$cshow :: XRRPropertyInfo -> String
showsPrec :: Int -> XRRPropertyInfo -> ShowS
$cshowsPrec :: Int -> XRRPropertyInfo -> ShowS
Show)

-- | Representation of the XRRMonitorInfo struct
data XRRMonitorInfo = XRRMonitorInfo
   { XRRMonitorInfo -> RRMode
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 -> [RRMode]
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
/= :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
$c/= :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
== :: XRRMonitorInfo -> XRRMonitorInfo -> Bool
$c== :: 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
showList :: [XRRMonitorInfo] -> ShowS
$cshowList :: [XRRMonitorInfo] -> ShowS
show :: XRRMonitorInfo -> String
$cshow :: XRRMonitorInfo -> String
showsPrec :: Int -> XRRMonitorInfo -> ShowS
$cshowsPrec :: Int -> 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
/= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c/= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
== :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$c== :: 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
min :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
$cmin :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
max :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
$cmax :: XRRScreenConfiguration
-> XRRScreenConfiguration -> XRRScreenConfiguration
>= :: XRRScreenConfiguration -> XRRScreenConfiguration -> Bool
$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
compare :: XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering
$ccompare :: XRRScreenConfiguration -> XRRScreenConfiguration -> Ordering
$cp1Ord :: Eq 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
showList :: [XRRScreenConfiguration] -> ShowS
$cshowList :: [XRRScreenConfiguration] -> ShowS
show :: XRRScreenConfiguration -> String
$cshow :: XRRScreenConfiguration -> String
showsPrec :: Int -> XRRScreenConfiguration -> ShowS
$cshowsPrec :: Int -> XRRScreenConfiguration -> ShowS
Show, Typeable, Typeable XRRScreenConfiguration
DataType
Constr
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 -> DataType
XRRScreenConfiguration -> Constr
(forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cXRRScreenConfiguration :: Constr
$tXRRScreenConfiguration :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XRRScreenConfiguration -> m XRRScreenConfiguration
gmapQi :: Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XRRScreenConfiguration -> u
gmapQ :: (forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> XRRScreenConfiguration -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> XRRScreenConfiguration
-> r
gmapT :: (forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
$cgmapT :: (forall b. Data b => b -> b)
-> XRRScreenConfiguration -> XRRScreenConfiguration
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XRRScreenConfiguration)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XRRScreenConfiguration)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XRRScreenConfiguration)
dataTypeOf :: XRRScreenConfiguration -> DataType
$cdataTypeOf :: XRRScreenConfiguration -> DataType
toConstr :: XRRScreenConfiguration -> Constr
$ctoConstr :: XRRScreenConfiguration -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XRRScreenConfiguration
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> XRRScreenConfiguration
-> c XRRScreenConfiguration
$cp1Data :: Typeable 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 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 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 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 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 (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 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 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 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 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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
0) Ptr XRRModeInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> RRMode
xrr_mi_id         XRRModeInfo
xrr_mi
{-# LINE 203 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> 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 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 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 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 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 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 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 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 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 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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRModeInfo
hsc_ptr Int
72) Ptr XRRModeInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRModeInfo -> RRMode
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 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 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 = (RRMode
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> CUInt
 -> String
 -> RRMode
 -> XRRModeInfo)
-> IO
     (RRMode
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> XRRModeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return RRMode
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> CUInt
-> String
-> RRMode
-> XRRModeInfo
XRRModeInfo
        IO
  (RRMode
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> CUInt
   -> String
   -> RRMode
   -> XRRModeInfo)
-> IO RRMode
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> XRRModeInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO RRMode
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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> 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 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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> 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 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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> 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 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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> 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 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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> CUInt
      -> String
      -> RRMode
      -> 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 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
   -> RRMode
   -> XRRModeInfo)
-> IO CUInt
-> IO
     (CUInt
      -> CUInt -> CUInt -> CUInt -> String -> RRMode -> 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 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 -> RRMode -> XRRModeInfo)
-> IO CUInt
-> IO (CUInt -> CUInt -> CUInt -> String -> RRMode -> 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 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 -> RRMode -> XRRModeInfo)
-> IO CUInt
-> IO (CUInt -> CUInt -> String -> RRMode -> 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 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 -> RRMode -> XRRModeInfo)
-> IO CUInt -> IO (CUInt -> String -> RRMode -> 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 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 -> RRMode -> XRRModeInfo)
-> IO CUInt -> IO (String -> RRMode -> 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 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 -> RRMode -> XRRModeInfo)
-> IO String -> IO (RRMode -> 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 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 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 (RRMode -> XRRModeInfo) -> IO RRMode -> IO XRRModeInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRModeInfo
hsc_ptr -> Ptr XRRModeInfo -> Int -> IO RRMode
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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
0) Ptr XRRMonitorInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRMonitorInfo -> RRMode
xrr_moninf_name      XRRMonitorInfo
xrr_moninf
{-# LINE 241 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> 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 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 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 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 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 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 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 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 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 RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRMonitorInfo
hsc_ptr Int
48) Ptr XRRMonitorInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 252 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRMonitorInfo -> IO XRRMonitorInfo
peek Ptr XRRMonitorInfo
p = (RRMode
 -> Bool
 -> Bool
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> [RRMode]
 -> XRRMonitorInfo)
-> IO
     (RRMode
      -> Bool
      -> Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [RRMode]
      -> XRRMonitorInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return RRMode
-> Bool
-> Bool
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> [RRMode]
-> XRRMonitorInfo
XRRMonitorInfo
        IO
  (RRMode
   -> Bool
   -> Bool
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> CInt
   -> [RRMode]
   -> XRRMonitorInfo)
-> IO RRMode
-> IO
     (Bool
      -> Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [RRMode]
      -> XRRMonitorInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> Int -> IO RRMode
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
   -> [RRMode]
   -> XRRMonitorInfo)
-> IO Bool
-> IO
     (Bool
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [RRMode]
      -> 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 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
   -> [RRMode]
   -> XRRMonitorInfo)
-> IO Bool
-> IO
     (CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> CInt
      -> [RRMode]
      -> 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 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
   -> [RRMode]
   -> XRRMonitorInfo)
-> IO CInt
-> IO
     (CInt
      -> CInt -> CInt -> CInt -> CInt -> [RRMode] -> 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 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 -> [RRMode] -> XRRMonitorInfo)
-> IO CInt
-> IO (CInt -> CInt -> CInt -> CInt -> [RRMode] -> 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 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 -> [RRMode] -> XRRMonitorInfo)
-> IO CInt
-> IO (CInt -> CInt -> CInt -> [RRMode] -> 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 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 -> [RRMode] -> XRRMonitorInfo)
-> IO CInt -> IO (CInt -> CInt -> [RRMode] -> 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 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 -> [RRMode] -> XRRMonitorInfo)
-> IO CInt -> IO (CInt -> [RRMode] -> 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 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 -> [RRMode] -> XRRMonitorInfo)
-> IO CInt -> IO ([RRMode] -> 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 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 ([RRMode] -> XRRMonitorInfo) -> IO [RRMode] -> IO XRRMonitorInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRMonitorInfo
hsc_ptr -> Ptr XRRMonitorInfo -> 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 RRMode)
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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
0) Ptr XRRScreenResources
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> RRMode
xrr_sr_timestamp       XRRScreenResources
xrr_sr
{-# LINE 274 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
8) Ptr XRRScreenResources
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> RRMode
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 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 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 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 RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
24) Ptr XRRScreenResources
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RRCrtc      )
{-# LINE 292 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> Ptr RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRScreenResources
hsc_ptr Int
40) Ptr XRRScreenResources
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RROutput    )
{-# LINE 293 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> 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 = (RRMode
 -> RRMode
 -> [RRMode]
 -> [RRMode]
 -> [XRRModeInfo]
 -> XRRScreenResources)
-> IO
     (RRMode
      -> RRMode
      -> [RRMode]
      -> [RRMode]
      -> [XRRModeInfo]
      -> XRRScreenResources)
forall (m :: * -> *) a. Monad m => a -> m a
return RRMode
-> RRMode
-> [RRMode]
-> [RRMode]
-> [XRRModeInfo]
-> XRRScreenResources
XRRScreenResources
        IO
  (RRMode
   -> RRMode
   -> [RRMode]
   -> [RRMode]
   -> [XRRModeInfo]
   -> XRRScreenResources)
-> IO RRMode
-> IO
     (RRMode
      -> [RRMode] -> [RRMode] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO RRMode
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
  (RRMode
   -> [RRMode] -> [RRMode] -> [XRRModeInfo] -> XRRScreenResources)
-> IO RRMode
-> IO ([RRMode] -> [RRMode] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> Int -> IO RRMode
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 ([RRMode] -> [RRMode] -> [XRRModeInfo] -> XRRScreenResources)
-> IO [RRMode]
-> IO ([RRMode] -> [XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> 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 RRMode)
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 ([RRMode] -> [XRRModeInfo] -> XRRScreenResources)
-> IO [RRMode] -> IO ([XRRModeInfo] -> XRRScreenResources)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRScreenResources
hsc_ptr -> Ptr XRRScreenResources -> 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 RRMode)
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 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 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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
0) Ptr XRROutputInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> RRMode
xrr_oi_timestamp      XRROutputInfo
xrr_oi
{-# LINE 313 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
8) Ptr XRROutputInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> RRMode
xrr_oi_crtc           XRROutputInfo
xrr_oi
{-# LINE 314 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> 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 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 -> Connection -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
48) Ptr XRROutputInfo
p (Connection -> IO ()) -> Connection -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Connection
xrr_oi_connection     XRROutputInfo
xrr_oi
{-# LINE 317 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Connection -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
50) Ptr XRROutputInfo
p (Connection -> IO ()) -> Connection -> IO ()
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Connection
xrr_oi_subpixel_order XRROutputInfo
xrr_oi
{-# LINE 318 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> 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 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 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 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 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 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 RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
56) Ptr XRROutputInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RRCrtc   )
{-# LINE 326 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
72) Ptr XRROutputInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 327 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> Ptr RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRROutputInfo
hsc_ptr Int
88) Ptr XRROutputInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RRMode   )
{-# LINE 328 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRROutputInfo -> IO XRROutputInfo
peek Ptr XRROutputInfo
p = (RRMode
 -> RRMode
 -> String
 -> CULong
 -> CULong
 -> Connection
 -> Connection
 -> [RRMode]
 -> [RRMode]
 -> CInt
 -> [RRMode]
 -> XRROutputInfo)
-> IO
     (RRMode
      -> RRMode
      -> String
      -> CULong
      -> CULong
      -> Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> XRROutputInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return RRMode
-> RRMode
-> String
-> CULong
-> CULong
-> Connection
-> Connection
-> [RRMode]
-> [RRMode]
-> CInt
-> [RRMode]
-> XRROutputInfo
XRROutputInfo
            IO
  (RRMode
   -> RRMode
   -> String
   -> CULong
   -> CULong
   -> Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO RRMode
-> IO
     (RRMode
      -> String
      -> CULong
      -> CULong
      -> Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO RRMode
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
  (RRMode
   -> String
   -> CULong
   -> CULong
   -> Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO RRMode
-> IO
     (String
      -> CULong
      -> CULong
      -> Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO RRMode
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
   -> Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO String
-> IO
     (CULong
      -> CULong
      -> Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> 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 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 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
   -> Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO CULong
-> IO
     (CULong
      -> Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> 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 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
   -> Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO CULong
-> IO
     (Connection
      -> Connection
      -> [RRMode]
      -> [RRMode]
      -> CInt
      -> [RRMode]
      -> 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 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
  (Connection
   -> Connection
   -> [RRMode]
   -> [RRMode]
   -> CInt
   -> [RRMode]
   -> XRROutputInfo)
-> IO Connection
-> IO
     (Connection
      -> [RRMode] -> [RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Connection
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
  (Connection
   -> [RRMode] -> [RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
-> IO Connection
-> IO ([RRMode] -> [RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> Int -> IO Connection
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 ([RRMode] -> [RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
-> IO [RRMode]
-> IO ([RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> 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 RRMode)
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 ([RRMode] -> CInt -> [RRMode] -> XRROutputInfo)
-> IO [RRMode] -> IO (CInt -> [RRMode] -> XRROutputInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> 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 RRMode)
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 -> [RRMode] -> XRROutputInfo)
-> IO CInt -> IO ([RRMode] -> 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 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 ([RRMode] -> XRROutputInfo) -> IO [RRMode] -> IO XRROutputInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRROutputInfo
hsc_ptr -> Ptr XRROutputInfo -> 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 RRMode)
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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
0) Ptr XRRCrtcInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> RRMode
xrr_ci_timestamp XRRCrtcInfo
xrr_ci
{-# LINE 354 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> 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 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 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 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 -> RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
24) Ptr XRRCrtcInfo
p (RRMode -> IO ()) -> RRMode -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> RRMode
xrr_ci_mode      XRRCrtcInfo
xrr_ci
{-# LINE 359 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Connection -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
32) Ptr XRRCrtcInfo
p (Connection -> IO ()) -> Connection -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Connection
xrr_ci_rotation  XRRCrtcInfo
xrr_ci
{-# LINE 360 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Connection -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
48) Ptr XRRCrtcInfo
p (Connection -> IO ()) -> Connection -> IO ()
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Connection
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 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 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 RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
40) Ptr XRRCrtcInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 365 "Graphics/X11/Xrandr.hsc" #-}
        (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> Ptr RRMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XRRCrtcInfo
hsc_ptr Int
56) Ptr XRRCrtcInfo
p ( Ptr RRMode
forall a. Ptr a
nullPtr :: Ptr RROutput )
{-# LINE 366 "Graphics/X11/Xrandr.hsc" #-}

    peek :: Ptr XRRCrtcInfo -> IO XRRCrtcInfo
peek Ptr XRRCrtcInfo
p = (RRMode
 -> CInt
 -> CInt
 -> CUInt
 -> CUInt
 -> RRMode
 -> Connection
 -> [RRMode]
 -> Connection
 -> [RRMode]
 -> XRRCrtcInfo)
-> IO
     (RRMode
      -> CInt
      -> CInt
      -> CUInt
      -> CUInt
      -> RRMode
      -> Connection
      -> [RRMode]
      -> Connection
      -> [RRMode]
      -> XRRCrtcInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return RRMode
-> CInt
-> CInt
-> CUInt
-> CUInt
-> RRMode
-> Connection
-> [RRMode]
-> Connection
-> [RRMode]
-> XRRCrtcInfo
XRRCrtcInfo
        IO
  (RRMode
   -> CInt
   -> CInt
   -> CUInt
   -> CUInt
   -> RRMode
   -> Connection
   -> [RRMode]
   -> Connection
   -> [RRMode]
   -> XRRCrtcInfo)
-> IO RRMode
-> IO
     (CInt
      -> CInt
      -> CUInt
      -> CUInt
      -> RRMode
      -> Connection
      -> [RRMode]
      -> Connection
      -> [RRMode]
      -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO RRMode
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
   -> RRMode
   -> Connection
   -> [RRMode]
   -> Connection
   -> [RRMode]
   -> XRRCrtcInfo)
-> IO CInt
-> IO
     (CInt
      -> CUInt
      -> CUInt
      -> RRMode
      -> Connection
      -> [RRMode]
      -> Connection
      -> [RRMode]
      -> 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 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
   -> RRMode
   -> Connection
   -> [RRMode]
   -> Connection
   -> [RRMode]
   -> XRRCrtcInfo)
-> IO CInt
-> IO
     (CUInt
      -> CUInt
      -> RRMode
      -> Connection
      -> [RRMode]
      -> Connection
      -> [RRMode]
      -> 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 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
   -> RRMode
   -> Connection
   -> [RRMode]
   -> Connection
   -> [RRMode]
   -> XRRCrtcInfo)
-> IO CUInt
-> IO
     (CUInt
      -> RRMode
      -> Connection
      -> [RRMode]
      -> Connection
      -> [RRMode]
      -> 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 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
   -> RRMode
   -> Connection
   -> [RRMode]
   -> Connection
   -> [RRMode]
   -> XRRCrtcInfo)
-> IO CUInt
-> IO
     (RRMode
      -> Connection -> [RRMode] -> Connection -> [RRMode] -> 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 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
  (RRMode
   -> Connection -> [RRMode] -> Connection -> [RRMode] -> XRRCrtcInfo)
-> IO RRMode
-> IO
     (Connection -> [RRMode] -> Connection -> [RRMode] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO RRMode
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
  (Connection -> [RRMode] -> Connection -> [RRMode] -> XRRCrtcInfo)
-> IO Connection
-> IO ([RRMode] -> Connection -> [RRMode] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Connection
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 ([RRMode] -> Connection -> [RRMode] -> XRRCrtcInfo)
-> IO [RRMode] -> IO (Connection -> [RRMode] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> 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 RRMode)
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 (Connection -> [RRMode] -> XRRCrtcInfo)
-> IO Connection -> IO ([RRMode] -> XRRCrtcInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ( (\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> Int -> IO Connection
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 ([RRMode] -> XRRCrtcInfo) -> IO [RRMode] -> IO XRRCrtcInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` IO CInt -> IO (Ptr RRMode) -> IO [RRMode]
forall a. Storable a => IO CInt -> IO (Ptr a) -> IO [a]
peekCArrayIO ((\Ptr XRRCrtcInfo
hsc_ptr -> Ptr XRRCrtcInfo -> 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 RRMode)
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 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 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 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 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 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 (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 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 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 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 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 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 -> RRMode -> IO (Maybe XRRScreenConfiguration)
xrrGetScreenInfo Display
dpy RRMode
draw = do
  Ptr XRRScreenConfiguration
p <- Display -> RRMode -> IO (Ptr XRRScreenConfiguration)
cXRRGetScreenInfo Display
dpy RRMode
draw
  if Ptr XRRScreenConfiguration
p Ptr XRRScreenConfiguration -> Ptr XRRScreenConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRScreenConfiguration
forall a. Ptr a
nullPtr
     then Maybe XRRScreenConfiguration -> IO (Maybe XRRScreenConfiguration)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRRScreenConfiguration
forall a. Maybe a
Nothing
     else Maybe XRRScreenConfiguration -> IO (Maybe XRRScreenConfiguration)
forall (m :: * -> *) a. Monad m => a -> m a
return (XRRScreenConfiguration -> Maybe XRRScreenConfiguration
forall a. a -> Maybe a
Just (Ptr XRRScreenConfiguration -> XRRScreenConfiguration
XRRScreenConfiguration Ptr 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
-> RRMode
-> CInt
-> Connection
-> RRMode
-> IO CInt
xrrSetScreenConfig = Display
-> XRRScreenConfiguration
-> RRMode
-> CInt
-> Connection
-> RRMode
-> 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
-> RRMode
-> CInt
-> Connection
-> CShort
-> RRMode
-> IO CInt
xrrSetScreenConfigAndRate = Display
-> XRRScreenConfiguration
-> RRMode
-> CInt
-> Connection
-> CShort
-> RRMode
-> 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 (Connection, Connection)
xrrConfigRotations XRRScreenConfiguration
config =
  (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Connection, Connection))
 -> IO (Connection, Connection))
-> (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do Ptr Connection
rptr <- Pool -> IO (Ptr Connection)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Connection
rotations <- XRRScreenConfiguration -> Ptr Connection -> IO Connection
cXRRConfigRotations XRRScreenConfiguration
config Ptr Connection
rptr
                         Connection
cur_rotation <- Ptr Connection -> IO Connection
forall a. Storable a => Ptr a -> IO a
peek Ptr Connection
rptr
                         (Connection, Connection) -> IO (Connection, Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection
rotations, Connection
cur_rotation)
foreign import ccall "XRRConfigRotations"
  cXRRConfigRotations :: XRRScreenConfiguration -> Ptr Rotation -> IO Rotation

xrrConfigTimes :: XRRScreenConfiguration -> IO (Time, Time)
xrrConfigTimes :: XRRScreenConfiguration -> IO (RRMode, RRMode)
xrrConfigTimes XRRScreenConfiguration
config =
  (Pool -> IO (RRMode, RRMode)) -> IO (RRMode, RRMode)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (RRMode, RRMode)) -> IO (RRMode, RRMode))
-> (Pool -> IO (RRMode, RRMode)) -> IO (RRMode, RRMode)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do Ptr RRMode
tptr <- Pool -> IO (Ptr RRMode)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         RRMode
time <- XRRScreenConfiguration -> Ptr RRMode -> IO RRMode
cXRRConfigTimes XRRScreenConfiguration
config Ptr RRMode
tptr
                         RRMode
cur_time <- Ptr RRMode -> IO RRMode
forall a. Storable a => Ptr a -> IO a
peek Ptr RRMode
tptr
                         (RRMode, RRMode) -> IO (RRMode, RRMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (RRMode
time, RRMode
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 Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr XRRScreenSize
p <- XRRScreenConfiguration -> Ptr CInt -> IO (Ptr XRRScreenSize)
cXRRConfigSizes XRRScreenConfiguration
config Ptr CInt
intp
                         if Ptr XRRScreenSize
p Ptr XRRScreenSize -> Ptr XRRScreenSize -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRScreenSize
forall a. Ptr a
nullPtr
                            then Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
forall a. Maybe a
Nothing
                            else do CInt
nsizes <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
                                    Maybe [XRRScreenSize]
sizes <- if CInt
nsizes CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                                                then Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
forall a. Maybe a
Nothing
                                                else Int -> Ptr XRRScreenSize -> IO [XRRScreenSize]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nsizes) Ptr XRRScreenSize
p IO [XRRScreenSize]
-> ([XRRScreenSize] -> IO (Maybe [XRRScreenSize]))
-> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize]))
-> ([XRRScreenSize] -> Maybe [XRRScreenSize])
-> [XRRScreenSize]
-> IO (Maybe [XRRScreenSize])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XRRScreenSize] -> Maybe [XRRScreenSize]
forall a. a -> Maybe a
Just
                                    Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
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 Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr CShort
p <- XRRScreenConfiguration -> CInt -> Ptr CInt -> IO (Ptr CShort)
cXRRConfigRates XRRScreenConfiguration
config CInt
size_index Ptr CInt
intp
                         if Ptr CShort
p Ptr CShort -> Ptr CShort -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CShort
forall a. Ptr a
nullPtr
                            then Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
forall a. Maybe a
Nothing
                            else do CInt
nrates <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
                                    Maybe [CShort]
rates <- if CInt
nrates CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                                                then Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
forall a. Maybe a
Nothing
                                                else Int -> Ptr CShort -> IO [CShort]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nrates) Ptr CShort
p IO [CShort]
-> ([CShort] -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [CShort] -> IO (Maybe [CShort]))
-> ([CShort] -> Maybe [CShort]) -> [CShort] -> IO (Maybe [CShort])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CShort] -> Maybe [CShort]
forall a. a -> Maybe a
Just
                                    Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
rates
foreign import ccall "XRRConfigRates"
  cXRRConfigRates :: XRRScreenConfiguration -> CInt -> Ptr CInt -> IO (Ptr CShort)

xrrConfigCurrentConfiguration :: XRRScreenConfiguration -> IO (Rotation, SizeID)
xrrConfigCurrentConfiguration :: XRRScreenConfiguration -> IO (Connection, Connection)
xrrConfigCurrentConfiguration XRRScreenConfiguration
config =
  (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Connection, Connection))
 -> IO (Connection, Connection))
-> (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do Ptr Connection
rptr <- Pool -> IO (Ptr Connection)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Connection
sizeid <- XRRScreenConfiguration -> Ptr Connection -> IO Connection
cXRRConfigCurrentConfiguration XRRScreenConfiguration
config Ptr Connection
rptr
                         Connection
rotation <- Ptr Connection -> IO Connection
forall a. Storable a => Ptr a -> IO a
peek Ptr Connection
rptr
                         (Connection, Connection) -> IO (Connection, Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection
rotation, Connection
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 -> RRMode -> IO CInt
xrrRootToScreen = Display -> RRMode -> IO CInt
cXRRRootToScreen
foreign import ccall "XRRRootToScreen"
  cXRRRootToScreen :: Display -> Window -> IO CInt

xrrSelectInput :: Display -> Window -> EventMask -> IO ()
xrrSelectInput :: Display -> RRMode -> RRMode -> IO ()
xrrSelectInput Display
dpy RRMode
window RRMode
mask = Display -> RRMode -> CInt -> IO ()
cXRRSelectInput Display
dpy RRMode
window (RRMode -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral RRMode
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 (Connection, Connection)
xrrRotations Display
dpy CInt
screen =
  (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Connection, Connection))
 -> IO (Connection, Connection))
-> (Pool -> IO (Connection, Connection))
-> IO (Connection, Connection)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do Ptr Connection
rptr <- Pool -> IO (Ptr Connection)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Connection
rotations <- Display -> CInt -> Ptr Connection -> IO Connection
cXRRRotations Display
dpy CInt
screen Ptr Connection
rptr
                         Connection
cur_rotation <- Ptr Connection -> IO Connection
forall a. Storable a => Ptr a -> IO a
peek Ptr Connection
rptr
                         (Connection, Connection) -> IO (Connection, Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection
rotations, Connection
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 Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr XRRScreenSize
p <- Display -> CInt -> Ptr CInt -> IO (Ptr XRRScreenSize)
cXRRSizes Display
dpy CInt
screen Ptr CInt
intp
                         if Ptr XRRScreenSize
p Ptr XRRScreenSize -> Ptr XRRScreenSize -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRScreenSize
forall a. Ptr a
nullPtr
                            then Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
forall a. Maybe a
Nothing
                            else do CInt
nsizes <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
                                    Maybe [XRRScreenSize]
sizes <- if CInt
nsizes CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                                                then Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
forall a. Maybe a
Nothing
                                                else Int -> Ptr XRRScreenSize -> IO [XRRScreenSize]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nsizes) Ptr XRRScreenSize
p IO [XRRScreenSize]
-> ([XRRScreenSize] -> IO (Maybe [XRRScreenSize]))
-> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize]))
-> ([XRRScreenSize] -> Maybe [XRRScreenSize])
-> [XRRScreenSize]
-> IO (Maybe [XRRScreenSize])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XRRScreenSize] -> Maybe [XRRScreenSize]
forall a. a -> Maybe a
Just
                                    Maybe [XRRScreenSize] -> IO (Maybe [XRRScreenSize])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRScreenSize]
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 Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr CShort
p <- Display -> CInt -> CInt -> Ptr CInt -> IO (Ptr CShort)
cXRRRates Display
dpy CInt
screen CInt
size_index Ptr CInt
intp
                         if Ptr CShort
p Ptr CShort -> Ptr CShort -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CShort
forall a. Ptr a
nullPtr
                            then Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
forall a. Maybe a
Nothing
                            else do CInt
nrates <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
                                    Maybe [CShort]
rates <- if CInt
nrates CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                                                then Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
forall a. Maybe a
Nothing
                                                else Int -> Ptr CShort -> IO [CShort]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nrates) Ptr CShort
p IO [CShort]
-> ([CShort] -> IO (Maybe [CShort])) -> IO (Maybe [CShort])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [CShort] -> IO (Maybe [CShort]))
-> ([CShort] -> Maybe [CShort]) -> [CShort] -> IO (Maybe [CShort])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CShort] -> Maybe [CShort]
forall a. a -> Maybe a
Just
                                    Maybe [CShort] -> IO (Maybe [CShort])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CShort]
rates
foreign import ccall "XRRRates"
  cXRRRates :: Display -> CInt -> CInt -> Ptr CInt -> IO (Ptr CShort)

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

xrrGetScreenResources :: Display -> Window -> IO (Maybe XRRScreenResources)
xrrGetScreenResources :: Display -> RRMode -> IO (Maybe XRRScreenResources)
xrrGetScreenResources Display
dpy RRMode
win = do
    Ptr XRRScreenResources
srp <- Display -> RRMode -> IO (Ptr XRRScreenResources)
cXRRGetScreenResources Display
dpy RRMode
win
    if Ptr XRRScreenResources
srp Ptr XRRScreenResources -> Ptr XRRScreenResources -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRScreenResources
forall a. Ptr a
nullPtr
        then Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRRScreenResources
forall a. Maybe a
Nothing
        else do
            XRRScreenResources
res <- Ptr XRRScreenResources -> IO XRRScreenResources
forall a. Storable a => Ptr a -> IO a
peek Ptr XRRScreenResources
srp
            Ptr XRRScreenResources -> IO ()
cXRRFreeScreenResources Ptr XRRScreenResources
srp
            Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XRRScreenResources -> IO (Maybe XRRScreenResources))
-> Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> Maybe XRRScreenResources
forall a. a -> Maybe a
Just XRRScreenResources
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 -> RRMode -> IO (Maybe XRROutputInfo)
xrrGetOutputInfo Display
dpy XRRScreenResources
xrr_sr RRMode
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
    -}
    Ptr XRROutputInfo
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 (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 -> RRMode -> IO (Ptr XRROutputInfo)
cXRRGetOutputInfo Display
dpy Ptr XRRScreenResources
srp RRMode
rro -- no need to free srp, because pool mem

    if Ptr XRROutputInfo
oip Ptr XRROutputInfo -> Ptr XRROutputInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRROutputInfo
forall a. Ptr a
nullPtr
        then Maybe XRROutputInfo -> IO (Maybe XRROutputInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRROutputInfo
forall a. Maybe a
Nothing
        else do
            XRROutputInfo
oi <- Ptr XRROutputInfo -> IO XRROutputInfo
forall a. Storable a => Ptr a -> IO a
peek Ptr XRROutputInfo
oip
            ()
_ <- Ptr XRROutputInfo -> IO ()
cXRRFreeOutputInfo Ptr XRROutputInfo
oip
            Maybe XRROutputInfo -> IO (Maybe XRROutputInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XRROutputInfo -> IO (Maybe XRROutputInfo))
-> Maybe XRROutputInfo -> IO (Maybe XRROutputInfo)
forall a b. (a -> b) -> a -> b
$ XRROutputInfo -> Maybe XRROutputInfo
forall a. a -> Maybe a
Just XRROutputInfo
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 -> RRMode -> IO (Maybe XRRCrtcInfo)
xrrGetCrtcInfo Display
dpy XRRScreenResources
xrr_sr RRMode
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)
    Ptr XRRCrtcInfo
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 (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 -> RRMode -> IO (Ptr XRRCrtcInfo)
cXRRGetCrtcInfo Display
dpy Ptr XRRScreenResources
srp RRMode
crtc -- no need to free srp, because pool mem

    if Ptr XRRCrtcInfo
cip Ptr XRRCrtcInfo -> Ptr XRRCrtcInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRCrtcInfo
forall a. Ptr a
nullPtr
        then Maybe XRRCrtcInfo -> IO (Maybe XRRCrtcInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRRCrtcInfo
forall a. Maybe a
Nothing
        else do
            XRRCrtcInfo
ci <- Ptr XRRCrtcInfo -> IO XRRCrtcInfo
forall a. Storable a => Ptr a -> IO a
peek Ptr XRRCrtcInfo
cip
            Ptr XRRCrtcInfo -> IO ()
cXRRFreeCrtcInfo Ptr XRRCrtcInfo
cip
            Maybe XRRCrtcInfo -> IO (Maybe XRRCrtcInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XRRCrtcInfo -> IO (Maybe XRRCrtcInfo))
-> Maybe XRRCrtcInfo -> IO (Maybe XRRCrtcInfo)
forall a b. (a -> b) -> a -> b
$ XRRCrtcInfo -> Maybe XRRCrtcInfo
forall a. a -> Maybe a
Just XRRCrtcInfo
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 -> RRMode -> IO (Maybe XRRScreenResources)
xrrGetScreenResourcesCurrent Display
dpy RRMode
win = do
    Ptr XRRScreenResources
srcp <- Display -> RRMode -> IO (Ptr XRRScreenResources)
cXRRGetScreenResourcesCurrent Display
dpy RRMode
win
    if Ptr XRRScreenResources
srcp Ptr XRRScreenResources -> Ptr XRRScreenResources -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRScreenResources
forall a. Ptr a
nullPtr
        then Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRRScreenResources
forall a. Maybe a
Nothing
        else do
            XRRScreenResources
res <- Ptr XRRScreenResources -> IO XRRScreenResources
forall a. Storable a => Ptr a -> IO a
peek Ptr XRRScreenResources
srcp
            Ptr XRRScreenResources -> IO ()
cXRRFreeScreenResources Ptr XRRScreenResources
srcp
            Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XRRScreenResources -> IO (Maybe XRRScreenResources))
-> Maybe XRRScreenResources -> IO (Maybe XRRScreenResources)
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> Maybe XRRScreenResources
forall a. a -> Maybe a
Just XRRScreenResources
res

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

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

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

xrrQueryOutputProperty :: Display -> RROutput -> Atom -> IO (Maybe XRRPropertyInfo)
xrrQueryOutputProperty :: Display -> RRMode -> RRMode -> IO (Maybe XRRPropertyInfo)
xrrQueryOutputProperty Display
dpy RRMode
rro RRMode
prop = do
    Ptr XRRPropertyInfo
p <- Display -> RRMode -> RRMode -> IO (Ptr XRRPropertyInfo)
cXRRQueryOutputProperty Display
dpy RRMode
rro RRMode
prop
    if Ptr XRRPropertyInfo
p Ptr XRRPropertyInfo -> Ptr XRRPropertyInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRPropertyInfo
forall a. Ptr a
nullPtr
        then Maybe XRRPropertyInfo -> IO (Maybe XRRPropertyInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XRRPropertyInfo
forall a. Maybe a
Nothing
        else do
            XRRPropertyInfo
res <- Ptr XRRPropertyInfo -> IO XRRPropertyInfo
forall a. Storable a => Ptr a -> IO a
peek Ptr XRRPropertyInfo
p
            CInt
_ <- Ptr XRRPropertyInfo -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr XRRPropertyInfo
p
            Maybe XRRPropertyInfo -> IO (Maybe XRRPropertyInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XRRPropertyInfo -> IO (Maybe XRRPropertyInfo))
-> Maybe XRRPropertyInfo -> IO (Maybe XRRPropertyInfo)
forall a b. (a -> b) -> a -> b
$ XRRPropertyInfo -> Maybe XRRPropertyInfo
forall a. a -> Maybe a
Just XRRPropertyInfo
res

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

xrrConfigureOutputProperty :: Display -> RROutput -> Atom -> Bool -> Bool -> [CLong] -> IO ()
xrrConfigureOutputProperty :: Display -> RRMode -> RRMode -> Bool -> Bool -> [CLong] -> IO ()
xrrConfigureOutputProperty Display
dpy RRMode
rro RRMode
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
-> RRMode -> RRMode -> Bool -> Bool -> CInt -> Ptr CLong -> IO ()
cXRRConfigureOutputProperty Display
dpy RRMode
rro RRMode
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
-> RRMode -> RRMode -> RRMode -> CInt -> CInt -> [Word32] -> IO ()
xrrChangeOutputProperty Display
dpy RRMode
rro RRMode
prop RRMode
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 Word8
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 Connection -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr Connection -> Ptr Word8)
-> IO (Ptr Connection) -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pool -> [Connection] -> IO (Ptr Connection)
forall a. Storable a => Pool -> [a] -> IO (Ptr a)
pooledNewArray Pool
pool ((Word32 -> Connection) -> [Word32] -> [Connection]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Connection
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 (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"

    Display
-> RRMode
-> RRMode
-> RRMode
-> CInt
-> CInt
-> Ptr Word8
-> CInt
-> IO ()
cXRRChangeOutputProperty Display
dpy RRMode
rro RRMode
prop RRMode
typ CInt
format CInt
mode Ptr Word8
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Word32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
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
-> RRMode
-> RRMode
-> CLong
-> CLong
-> Bool
-> Bool
-> RRMode
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
xrrGetOutputProperty Display
dpy RRMode
rro RRMode
prop CLong
offset CLong
len Bool
delete Bool
preferPending RRMode
reqType = (Pool -> IO (Maybe (RRMode, Int, CULong, [Word32])))
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe (RRMode, Int, CULong, [Word32])))
 -> IO (Maybe (RRMode, Int, CULong, [Word32])))
-> (Pool -> IO (Maybe (RRMode, Int, CULong, [Word32])))
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do
    Ptr RRMode
actualTypep <- Pool -> IO (Ptr RRMode)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    Ptr CInt
actualFormatp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    Ptr CULong
nItemsp <- Pool -> IO (Ptr CULong)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    Ptr CULong
bytesAfterp <- Pool -> IO (Ptr CULong)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    Ptr (Ptr Word8)
datapp <- Pool -> IO (Ptr (Ptr Word8))
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    CInt
status <- Display
-> RRMode
-> RRMode
-> CLong
-> CLong
-> Bool
-> Bool
-> RRMode
-> Ptr RRMode
-> Ptr CInt
-> Ptr CULong
-> Ptr CULong
-> Ptr (Ptr Word8)
-> IO CInt
cXRRGetOutputProperty Display
dpy RRMode
rro RRMode
prop CLong
offset CLong
len
        Bool
delete Bool
preferPending RRMode
reqType
        Ptr RRMode
actualTypep Ptr CInt
actualFormatp Ptr CULong
nItemsp Ptr CULong
bytesAfterp Ptr (Ptr Word8)
datapp

    if CInt
status CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        then Maybe (RRMode, Int, CULong, [Word32])
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (RRMode, Int, CULong, [Word32])
forall a. Maybe a
Nothing
        else do
          Int
format <- (CInt -> Int) -> IO CInt -> IO Int
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 (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
actualFormatp)
          Int
nitems <- (CULong -> Int) -> IO CULong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CULong -> IO CULong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULong
nItemsp)
          Ptr Word8
ptr <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
datapp

          [Word32]
dat <- case Int
format of
            Int
0 -> [Word32] -> IO [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Int
8 -> ([Word8] -> [Word32]) -> IO [Word8] -> IO [Word32]
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 -> ([Connection] -> [Word32]) -> IO [Connection] -> IO [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Connection -> Word32) -> [Connection] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Connection -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO [Connection] -> IO [Word32]) -> IO [Connection] -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Connection -> IO [Connection]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nitems (Ptr Word8 -> Ptr Connection
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
")"

          CInt
_ <- if Int
format Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                  then Ptr Word8 -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr Word8
ptr
                  else CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0

          RRMode
typ <- Ptr RRMode -> IO RRMode
forall a. Storable a => Ptr a -> IO a
peek Ptr RRMode
actualTypep
          CULong
bytesAfter <- Ptr CULong -> IO CULong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULong
bytesAfterp
          Maybe (RRMode, Int, CULong, [Word32])
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (RRMode, Int, CULong, [Word32])
 -> IO (Maybe (RRMode, Int, CULong, [Word32])))
-> Maybe (RRMode, Int, CULong, [Word32])
-> IO (Maybe (RRMode, Int, CULong, [Word32]))
forall a b. (a -> b) -> a -> b
$ (RRMode, Int, CULong, [Word32])
-> Maybe (RRMode, Int, CULong, [Word32])
forall a. a -> Maybe a
Just (RRMode
typ, Int
format, CULong
bytesAfter, [Word32]
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 -> RRMode -> RRMode -> IO ()
xrrDeleteOutputProperty = Display -> RRMode -> RRMode -> IO ()
cXRRDeleteOutputProperty
foreign import ccall "XRRDeleteOutputProperty"
    cXRRDeleteOutputProperty :: Display -> RROutput -> Atom -> IO ()

xrrGetMonitors :: Display -> Drawable -> Bool -> IO (Maybe [XRRMonitorInfo])
xrrGetMonitors :: Display -> RRMode -> Bool -> IO (Maybe [XRRMonitorInfo])
xrrGetMonitors Display
dpy RRMode
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
    Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
    Ptr XRRMonitorInfo
p <- Display -> RRMode -> Bool -> Ptr CInt -> IO (Ptr XRRMonitorInfo)
cXRRGetMonitors Display
dpy RRMode
draw Bool
get_active Ptr CInt
intp
    if Ptr XRRMonitorInfo
p Ptr XRRMonitorInfo -> Ptr XRRMonitorInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XRRMonitorInfo
forall a. Ptr a
nullPtr
        then Maybe [XRRMonitorInfo] -> IO (Maybe [XRRMonitorInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRMonitorInfo]
forall a. Maybe a
Nothing
        else do
            CInt
nmonitors <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
            Maybe [XRRMonitorInfo]
res <- ([XRRMonitorInfo] -> Maybe [XRRMonitorInfo])
-> IO [XRRMonitorInfo] -> IO (Maybe [XRRMonitorInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [XRRMonitorInfo] -> Maybe [XRRMonitorInfo]
forall a. a -> Maybe a
Just (IO [XRRMonitorInfo] -> IO (Maybe [XRRMonitorInfo]))
-> IO [XRRMonitorInfo] -> IO (Maybe [XRRMonitorInfo])
forall a b. (a -> b) -> a -> b
$ CInt -> Ptr XRRMonitorInfo -> IO [XRRMonitorInfo]
forall a. Storable a => CInt -> Ptr a -> IO [a]
peekCArray CInt
nmonitors Ptr XRRMonitorInfo
p
            Ptr XRRMonitorInfo -> IO ()
cXRRFreeMonitors Ptr XRRMonitorInfo
p
            Maybe [XRRMonitorInfo] -> IO (Maybe [XRRMonitorInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XRRMonitorInfo]
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 :: (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 Ptr a
aptr <- Pool -> IO (Ptr a)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr b
bptr <- Pool -> IO (Ptr b)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         c
ret <- Ptr a -> Ptr b -> IO c
cfun Ptr a
aptr Ptr b
bptr
                         a
a <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
aptr
                         b
b <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
bptr
                         d -> IO d
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> a -> b -> d
f c
ret a
a b
b)

peekCArray :: Storable a => CInt -> Ptr a -> IO [a]
peekCArray :: 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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar, Int) -> IO String
peekCStringLen